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# 231 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
58
59# 250 "/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# 569 "/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# 134 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
73
74# 296 "/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# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
90# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
91! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
92! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
93# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
94# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
95# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
96
97# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
98# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
99
100# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
101
102# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
103
104# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
105
106# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
107
108# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
109
110# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
111
112# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
113
114# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
115! New line at end of file is required for FYPP
116# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
117# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
118# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
119# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
120# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
121# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
122# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
123# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
124
125# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
126# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
127# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
128
129# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
130# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
131! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
132! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
133# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
134# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
135# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
136
137# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
138# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
139
140# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
141
142# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
143
144# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
145
146# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147
148# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149
150# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153
154# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155! New line at end of file is required for FYPP
156# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
157
158# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
159# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
161# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
163
164# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
165
166# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
167
168# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
169
170# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
171
172# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
173
174# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
175
176# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
177
178# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
179
180# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
181
182# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
183
184# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
185
186# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
187
188# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
189
190# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
191
192# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
193
194# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
195
196# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
197
198# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
199
200# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
201
202# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
203
204# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
205
206# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
207
208# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
209# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
210
211# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
212
213# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
214
215# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
216
217# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
218
219# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
220
221# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
222
223# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
224
225# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
226
227# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
228
229# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
230
231# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
232
233# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
234! New line at end of file is required for FYPP
235# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
236# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
237# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
238# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
239# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
240# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
241# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
242# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
243
244# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
245# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
246# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
247
248# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
249# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
250! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
251! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
252# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
253# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
254# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
255
256# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
257# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
258
259# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
260
261# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
262
263# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
264
265# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
266
267# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
268
269# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
270
271# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
272
273# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
274! New line at end of file is required for FYPP
275# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
276
277# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
278
279# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
280
281# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
282
283# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
284
285# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
286
287# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
288
289# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
290
291# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
292
293# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
294
295# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
296
297# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
298
299# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
300
301# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
302
303# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
304
305# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
306
307# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
308
309# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
310
311# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
312
313# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
314
315# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
316
317# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
318
319# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
320
321# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
322
323# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
324
325# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
326
327# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
328
329# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
330
331# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
332! New line at end of file is required for FYPP
333# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
334
335! GPU parallel region (scalar reductions, maxval/minval)
336# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
337
338! GPU parallel loop over threads (most common GPU macro)
339# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
340
341! Required closing for GPU_PARALLEL_LOOP
342# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
343
344! Mark routine for device compilation
345# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
346
347! Declare device-resident data
348# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
349
350! Inner loop within a GPU parallel region
351# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
352
353! Scoped GPU data region
354# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
355
356! Host code with device pointers (for MPI with GPU buffers)
357# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
358
359! Allocate device memory (unscoped)
360# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
361
362! Free device memory
363# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
364
365! Atomic operation on device
366# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
367
368! End atomic capture block
369# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
370
371! Copy data between host and device
372# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
373
374! Synchronization barrier
375# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
376
377! Import GPU library module (openacc or omp_lib)
378# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
379
380! Emit code only for AMD compiler
381# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
382
383! Emit code for non-Cray compilers
384# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
385
386! Emit code only for Cray compiler
387# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
388
389! Emit code for non-NVIDIA compilers
390# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
391
392# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
393# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
394! New line at end of file is required for FYPP
395# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
396
397# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
398
399! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
400! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
401! example see misc/nvidia_uvm/bind.sh.
402# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
403
404! Allocate and create GPU device memory
405# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
406
407! Free GPU device memory and deallocate
408# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
409
410! Cray-specific GPU pointer setup for vector fields
411# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
412
413! Cray-specific GPU pointer setup for scalar fields
414# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
415
416! Cray-specific GPU pointer setup for acoustic source spatials
417# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
418
419# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
420
421# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
422! New line at end of file is required for FYPP
423# 11 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
424
425!> @brief Constructs initial condition patch geometries (lines, circles, rectangles, spheres, etc.) on the grid
427
429 use m_model ! Subroutine(s) related to STL files
430 use m_derived_types ! Definitions of the derived types
434 use m_helper
435 use m_mpi_common
437 use m_mpi_common
439
440 implicit none
441
442 private; public :: s_apply_icpp_patches
443
447 real(wp) :: smooth_coeff !< Smoothing coefficient (mirrors ic_patch_parameters%smooth_coeff)
448 real(wp) :: eta !< Pseudo volume fraction for patch boundary smoothing
449 real(wp) :: cart_y, cart_z
450 type(bounds_info) :: x_boundary, y_boundary, z_boundary !< Patch boundary locations in x, y, z
451 character(len=5) :: istr !< string to store int to string result for error checking
452
453contains
454
455 !> Dispatch each initial condition patch to its geometry-specific initialization routine.
456 impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf)
457
458 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
459
460#ifdef MFC_MIXED_PRECISION
461 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
462#else
463 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
464#endif
465 integer :: i
466 ! Load STL/OBJ models once into the shared flat arrays if any patch is an STL/OBJ model (geometry 21)
467
468 do i = 1, num_patches
469 if (patch_icpp(i)%geometry == 21) then
471 exit
472 end if
473 end do
474 ! 3D Patch Geometries
475
476 if (p > 0) then
477 do i = 1, num_patches
478 if (proc_rank == 0) then
479 print *, 'Processing patch', i
480 end if
481
482 !> ICPP Patches
483 !> @{
484 ! Spherical patch
485 if (patch_icpp(i)%geometry == 8) then
486 call s_icpp_sphere(i, patch_id_fp, q_prim_vf)
487 ! Cuboidal patch
488 else if (patch_icpp(i)%geometry == 9) then
489 call s_icpp_cuboid(i, patch_id_fp, q_prim_vf)
490 ! Cylindrical patch
491 else if (patch_icpp(i)%geometry == 10) then
492 call s_icpp_cylinder(i, patch_id_fp, q_prim_vf)
493 ! Swept plane patch
494 else if (patch_icpp(i)%geometry == 11) then
495 call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf)
496 ! Ellipsoidal patch
497 else if (patch_icpp(i)%geometry == 12) then
498 call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf)
499 ! 3D spherical harmonic patch
500 else if (patch_icpp(i)%geometry == 14) then
501 call s_icpp_3d_spherical_harmonic(i, patch_id_fp, q_prim_vf)
502 ! 3D Modified circular patch
503 else if (patch_icpp(i)%geometry == 19) then
504 call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf)
505 ! 3D STL patch
506 else if (patch_icpp(i)%geometry == 21) then
507 call s_icpp_model(i, patch_id_fp, q_prim_vf)
508 end if
509 end do
510 !> @}
511
512 ! 2D Patch Geometries
513 else if (n > 0) then
514 do i = 1, num_patches
515 if (proc_rank == 0) then
516 print *, 'Processing patch', i
517 end if
518
519 !> ICPP Patches
520 !> @{
521 ! Circular patch
522 if (patch_icpp(i)%geometry == 2) then
523 call s_icpp_circle(i, patch_id_fp, q_prim_vf)
524 ! Rectangular patch
525 else if (patch_icpp(i)%geometry == 3) then
526 call s_icpp_rectangle(i, patch_id_fp, q_prim_vf)
527 ! Swept line patch
528 else if (patch_icpp(i)%geometry == 4) then
529 call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf)
530 ! Elliptical patch
531 else if (patch_icpp(i)%geometry == 5) then
532 call s_icpp_ellipse(i, patch_id_fp, q_prim_vf)
533 ! Unimplemented patch (formerly isentropic vortex)
534 else if (patch_icpp(i)%geometry == 6) then
535 call s_mpi_abort('This used to be the isentropic vortex patch, ' &
536 & // 'which no longer exists. See Examples. Exiting.')
537 ! 2D modal (Fourier) patch
538 else if (patch_icpp(i)%geometry == 13) then
539 call s_icpp_2d_modal(i, patch_id_fp, q_prim_vf)
540 ! Spiral patch
541 else if (patch_icpp(i)%geometry == 17) then
542 call s_icpp_spiral(i, patch_id_fp, q_prim_vf)
543 ! Modified circular patch
544 else if (patch_icpp(i)%geometry == 18) then
545 call s_icpp_varcircle(i, patch_id_fp, q_prim_vf)
546 ! TaylorGreen vortex patch
547 else if (patch_icpp(i)%geometry == 20) then
548 call s_icpp_2d_taylorgreen_vortex(i, patch_id_fp, q_prim_vf)
549 ! STL patch
550 else if (patch_icpp(i)%geometry == 21) then
551 call s_icpp_model(i, patch_id_fp, q_prim_vf)
552 end if
553 !> @}
554 end do
555
556 ! 1D Patch Geometries
557 else
558 do i = 1, num_patches
559 if (proc_rank == 0) then
560 print *, 'Processing patch', i
561 end if
562
563 ! Line segment patch
564 if (patch_icpp(i)%geometry == 1) then
565 call s_icpp_line_segment(i, patch_id_fp, q_prim_vf)
566 ! 1d analytical
567 else if (patch_icpp(i)%geometry == 16) then
568 call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf)
569 end if
570 end do
571 end if
572
573 end subroutine s_apply_icpp_patches
574
575 !> The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem. The geometry of the
576 !! patch is well-defined when its centroid and length in the x-coordinate direction are provided. Note that the line segment
577 !! patch DOES NOT allow for the smearing of its boundaries.
578 subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
579
580 integer, intent(in) :: patch_id
581
582#ifdef MFC_MIXED_PRECISION
583 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
584#else
585 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
586#endif
587 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
588
589 ! Generic loop iterators
590 integer :: i, j, k
591
592 ! Placeholders for the cell boundary values
593
594 integer :: xRows, yRows, nRows, iix, iiy, max_files
595# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
596 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
597# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
598 real(wp) :: x_step, y_step
599# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
600 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
601# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
602 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
603# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
604 real(wp) :: delta_x, delta_y
605# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
606 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
607# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
608 real(wp), allocatable :: stored_values(:,:,:)
609# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
610 real(wp), allocatable :: x_coords(:), y_coords(:)
611# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
612 logical :: files_loaded = .false.
613# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
614 real(wp) :: domain_xstart
615# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
616 character(len=20) :: file_num_str !< For storing the file number as a string
617# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
618 integer :: ios
619# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
620 integer :: ios2
621# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
622
623# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
624 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
625# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
626 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
627# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
628 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
629# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
630 ! y_coords/files_loaded above.
631# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
632 real(wp), allocatable, dimension(:,:,:) :: stored_values274
633# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
634 logical :: files_loaded274 = .false.
635# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
636 integer :: f274, ix274, iy274, unit274, ios274
637# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
638 integer :: local_ix_beg274, local_iy_beg274
639# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
640 character(len=300) :: fname274
641# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
642 character(len=20) :: file_num_str274
643# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
644 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
645# 181 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
646 real(wp) :: file_dx274, file_dy274, r_align274
647# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
648 ! Place any declaration of intermediate variables here
649# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
650 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
651# 183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
652
653 j = 0
654 k = 0
655
656 ! Transferring the line segment's centroid and length information
657 x_centroid = patch_icpp(patch_id)%x_centroid
658 length_x = patch_icpp(patch_id)%length_x
659
660 ! Computing the beginning and end x-coordinates of the line segment based on its centroid and length
661 x_boundary%beg = x_centroid - 0.5_wp*length_x
662 x_boundary%end = x_centroid + 0.5_wp*length_x
663
664 ! Set eta=1 (no smoothing for this patch type)
665 eta = 1._wp
666
667 ! Assign patch vars if cell is covered and patch has write permission
668 do i = 0, m
669 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, &
670 & 0, 0))) then
671 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
672
673
674# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
675
676 ! check if this should load a hardcoded patch
677 if (patch_icpp(patch_id)%hcid /= dflt_int) then
678 select case (patch_icpp(patch_id)%hcid)
679# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
680 case (150) ! 1D Smooth Alfven Case for MHD
681# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
682 ! velocity
683# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
684 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
685# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
686 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
687# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
688
689# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
690 ! magnetic field
691# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
692 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
693# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
694 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
695# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
696 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
697# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
698 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
699# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
700 ! SDtoolbox)
701# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
702 if (.not. files_loaded) then
703# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
704 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
705# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
706 do f = 1, max_files
707# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
708 write (file_num_str, '(I0)') f
709# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
710 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
711# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
712 end do
713# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
714
715# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
716 ! Common file reading setup
717# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
718 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
719# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
720 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
721# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
722
723# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
724 select case (num_dims)
725# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
726 case (1, 2) ! 1D and 2D cases are similar
727# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
728 ! Count lines
729# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
730 line_count = 0
731# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
732 do
733# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
734 read (unit2, *, iostat=ios2) dummy_x, dummy_y
735# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
736 if (ios2 /= 0) exit
737# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
738 line_count = line_count + 1
739# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
740 end do
741# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
742 close (unit2)
743# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
744
745# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
746 xrows = line_count
747# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
748 yrows = 1
749# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
750 index_x = 0
751# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
752 if (num_dims == 2) index_x = i
753# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
754#ifdef MFC_DEBUG
755# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
756 block
757# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
758 use iso_fortran_env, only: output_unit
759# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
760
761# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
762 print *, 'm_icpp_patches.fpp:208: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
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 call flush (output_unit)
767# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
768 end block
769# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
770#endif
771# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
772 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
773# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
774
775# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
776
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#if defined(MFC_OpenACC)
781# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
782!$acc enter data create(x_coords, stored_values)
783# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
784#elif defined(MFC_OpenMP)
785# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
786!$omp target enter data map(always,alloc:x_coords, stored_values)
787# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
788#endif
789# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
790
791# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
792 ! Read data from all files
793# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
794 do f = 1, max_files
795# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
796 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
797# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
798 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
799# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
800
801# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
802 do iter = 1, xrows
803# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
804 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
805# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
806 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
807# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
808 end do
809# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
810 close (unit)
811# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
812 end do
813# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
814
815# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
816 ! Calculate offsets
817# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
818 domain_xstart = x_coords(1)
819# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
820 x_step = x_cc(1) - x_cc(0)
821# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
822 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
823# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
824 global_offset_x = nint(abs(delta_x)/x_step)
825# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
826 case (3) ! 3D case - determine grid structure
827# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
828 ! Find yRows by counting rows with same x
829# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
830 read (unit2, *, iostat=ios2) x0, y0, dummy_z
831# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
832 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
833# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
834
835# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
836 yrows = 1
837# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
838 do
839# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
840 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
841# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
842 if (ios2 /= 0) exit
843# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
844 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
845# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
846 yrows = yrows + 1
847# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
848 else
849# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
850 exit
851# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
852 end if
853# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
854 end do
855# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
856 close (unit2)
857# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
858
859# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
860 ! Count total rows
861# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
862 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
863# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
864 nrows = 0
865# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
866 do
867# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
868 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
869# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
870 if (ios2 /= 0) exit
871# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
872 nrows = nrows + 1
873# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
874 end do
875# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
876 close (unit2)
877# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
878
879# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
880 xrows = nrows/yrows
881# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
882#ifdef MFC_DEBUG
883# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
884 block
885# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
886 use iso_fortran_env, only: output_unit
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 print *, 'm_icpp_patches.fpp:208: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
891# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
892
893# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
894 call flush (output_unit)
895# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
896 end block
897# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
898#endif
899# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
900 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
901# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
902
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
907# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
908
909# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
910#if defined(MFC_OpenACC)
911# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
912!$acc enter data create(x_coords, y_coords, stored_values)
913# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
914#elif defined(MFC_OpenMP)
915# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
916!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
917# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
918#endif
919# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
920 index_x = i
921# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
922 index_y = j
923# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
924
925# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
926 ! Read all files
927# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
928 do f = 1, max_files
929# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
930 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
931# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
932 if (ios /= 0) then
933# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
934 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
935# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
936 cycle
937# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
938 end if
939# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
940
941# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
942 iter = 0
943# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
944 do iix = 1, xrows
945# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
946 do iiy = 1, yrows
947# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
948 iter = iter + 1
949# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
950 if (f == 1) then
951# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
952 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
953# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
954 else
955# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
956 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
957# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
958 end if
959# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
960 if (ios /= 0) call s_mpi_abort("Error reading data")
961# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
962 end do
963# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
964 end do
965# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
966 close (unit)
967# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
968 end do
969# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
970
971# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
972 ! Calculate offsets
973# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
974 x_step = x_cc(1) - x_cc(0)
975# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
976 y_step = y_cc(1) - y_cc(0)
977# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
978 delta_x = x_cc(index_x) - x_coords(1)
979# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
980 delta_y = y_cc(index_y) - y_coords(1)
981# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
982 global_offset_x = nint(abs(delta_x)/x_step)
983# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
984 global_offset_y = nint(abs(delta_y)/y_step)
985# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
986
987# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
988 ! The index check below only catches overruns, so a file that is merely too
989# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
990 ! FINE stays in range and silently supplies a corner of itself. Check spacing
991# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
992 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
993# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
994 ! consecutive x values sit yRows apart.
995# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
996 if (nrows > yrows) then
997# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
998 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
999# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1000 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
1001# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1002 end if
1003# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1004 if (yrows > 1) then
1005# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1006 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
1007# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1008 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
1009# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1010 end if
1011# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1012 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
1013# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1014 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
1015# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1016 & wp)) > 1.e-6_wp) &
1017# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1018 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
1019# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1020 end select
1021# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1022
1023# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1024 files_loaded = .true.
1025# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1026 end if
1027# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1028
1029# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1030 ! Data assignment
1031# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1032 select case (num_dims)
1033# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1034 case (1)
1035# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1036 idx = i + 1 + global_offset_x
1037# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1038 ! idx must land inside the file's row range: this rank's subdomain offset
1039# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1040 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
1041# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1042 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
1043# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1044 if (idx < 1 .or. idx > xrows) &
1045# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1046 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
1047# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1048 do f = 1, sys_size
1049# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1050 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
1051# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1052 end do
1053# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1054 case (2)
1055# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1056 idx = i + 1 + global_offset_x - index_x
1057# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1058 if (idx < 1 .or. idx > xrows) &
1059# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1060 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
1061# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1062 do f = 1, sys_size - 1
1063# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1064 jump = merge(1, 0, f >= eqn_idx%mom%end)
1065# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1066 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
1067# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1068 end do
1069# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1070 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
1071# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1072 case (3)
1073# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1074 idx = i + 1 + global_offset_x - index_x
1075# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1076 idy = j + 1 + global_offset_y - index_y
1077# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1078 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
1079# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1080 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
1081# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1082 do f = 1, sys_size - 1
1083# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1084 jump = merge(1, 0, f >= eqn_idx%mom%end)
1085# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1086 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
1087# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1088 end do
1089# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1090 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
1091# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1092 end select
1093# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1094 case (180) ! Shu-Osher problem
1095# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1096 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
1097# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1098 ! 0.2*sin(5*x)"
1099# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1100 if (patch_id == 2) then
1101# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1102 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
1103# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1104 end if
1105# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1106 case (181) ! Titarev-Torro problem
1107# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1108 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
1109# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1110 ! "1 + 0.1*sin(20*x*pi)"
1111# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1112 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
1113# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1114 case (182) ! Multi-component diffusion
1115# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1116 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
1117# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1118 x_mid_diffu = 0.05_wp/2.0_wp
1119# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1120 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
1121# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1122 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
1123# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1124 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1125# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1126 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
1127# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1128 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
1129# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1130
1131# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1132 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
1133# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1134 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
1135# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1136 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
1137# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1138 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
1139# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1140
1141# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1142 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
1143# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1144 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
1145# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1146 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
1147# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1148 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
1149# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1150
1151# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1152 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
1153# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1154
1155# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1156 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
1157# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1158
1159# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1160 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)
1161# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1162 case(191) ! 1D Dual Isothermal case
1163# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1164 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
1165# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1166 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
1167# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1168 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
1169# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1170
1171# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1172 if (x_cc(i) <= 0.025_wp) then
1173# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1174 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
1175# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1176 else
1177# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1178 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
1179# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1180 end if
1181# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1182
1183# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1184 molar_mass_inv = 1.0_wp/2.01588_wp
1185# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1186 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1187# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1188 case default
1189# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1190 call s_int_to_str(patch_id, istr)
1191# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1192 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
1193# 208 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1194 end select
1195# 209 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1196 end if
1197
1198 ! Updating the patch identities bookkeeping variable
1199 if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id
1200 end if
1201 end do
1202 if (allocated(stored_values)) then
1203# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1204#ifdef MFC_DEBUG
1205# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1206 block
1207# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1208 use iso_fortran_env, only: output_unit
1209# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1210
1211# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1212 print *, 'm_icpp_patches.fpp:215: ', '@:DEALLOCATE(stored_values)'
1213# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1214
1215# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1216 call flush (output_unit)
1217# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1218 end block
1219# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1220#endif
1221# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1222
1223# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1224#if defined(MFC_OpenACC)
1225# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1226!$acc exit data delete(stored_values)
1227# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1228#elif defined(MFC_OpenMP)
1229# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1230!$omp target exit data map(release:stored_values)
1231# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1232#endif
1233# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1234 deallocate (stored_values)
1235# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1236#ifdef MFC_DEBUG
1237# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1238 block
1239# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1240 use iso_fortran_env, only: output_unit
1241# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1242
1243# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1244 print *, 'm_icpp_patches.fpp:215: ', '@:DEALLOCATE(x_coords)'
1245# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1246
1247# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1248 call flush (output_unit)
1249# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1250 end block
1251# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1252#endif
1253# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1254
1255# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1256#if defined(MFC_OpenACC)
1257# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1258!$acc exit data delete(x_coords)
1259# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1260#elif defined(MFC_OpenMP)
1261# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1262!$omp target exit data map(release:x_coords)
1263# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1264#endif
1265# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1266 deallocate (x_coords)
1267# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1268 end if
1269# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1270
1271# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1272 if (allocated(y_coords)) then
1273# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1274#ifdef MFC_DEBUG
1275# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1276 block
1277# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1278 use iso_fortran_env, only: output_unit
1279# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1280
1281# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1282 print *, 'm_icpp_patches.fpp:215: ', '@:DEALLOCATE(y_coords)'
1283# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1284
1285# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1286 call flush (output_unit)
1287# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1288 end block
1289# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1290#endif
1291# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1292
1293# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1294#if defined(MFC_OpenACC)
1295# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1296!$acc exit data delete(y_coords)
1297# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1298#elif defined(MFC_OpenMP)
1299# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1300!$omp target exit data map(release:y_coords)
1301# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1302#endif
1303# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1304 deallocate (y_coords)
1305# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1306 end if
1307# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1308
1309# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1310 files_loaded = .false.
1311# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1312
1313# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1314 if (allocated(stored_values274)) then
1315# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1316#ifdef MFC_DEBUG
1317# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1318 block
1319# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1320 use iso_fortran_env, only: output_unit
1321# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1322
1323# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1324 print *, 'm_icpp_patches.fpp:215: ', '@:DEALLOCATE(stored_values274)'
1325# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1326
1327# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1328 call flush (output_unit)
1329# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1330 end block
1331# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1332#endif
1333# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1334
1335# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1336#if defined(MFC_OpenACC)
1337# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1338!$acc exit data delete(stored_values274)
1339# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1340#elif defined(MFC_OpenMP)
1341# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1342!$omp target exit data map(release:stored_values274)
1343# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1344#endif
1345# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1346 deallocate (stored_values274)
1347# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1348 end if
1349# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1350
1351# 215 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1352 files_loaded274 = .false.
1353# 216 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1354
1355 end subroutine s_icpp_line_segment
1356
1357 !> The spiral patch is a 2D geometry that may be used, The geometry of the patch is well-defined when its centroid and radius
1358 !! are provided. Note that the circular patch DOES allow for the smoothing of its boundary.
1359 impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
1360
1361 integer, intent(in) :: patch_id
1362
1363#ifdef MFC_MIXED_PRECISION
1364 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1365#else
1366 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
1367#endif
1368 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
1369 integer :: i, j, k !< Generic loop iterators
1370 real(wp) :: th, thickness, nturns, mya
1371 real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max
1372
1373 integer :: xrows, yrows, nrows, iix, iiy, max_files
1374# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1375 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
1376# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1377 real(wp) :: x_step, y_step
1378# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1379 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
1380# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1381 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
1382# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1383 real(wp) :: delta_x, delta_y
1384# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1385 character(len=300), dimension(sys_size) :: filenames !< Arrays to store all data from files
1386# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1387 real(wp), allocatable :: stored_values(:,:,:)
1388# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1389 real(wp), allocatable :: x_coords(:), y_coords(:)
1390# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1391 logical :: files_loaded = .false.
1392# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1393 real(wp) :: domain_xstart
1394# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1395 character(len=20) :: file_num_str !< For storing the file number as a string
1396# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1397 integer :: ios
1398# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1399 integer :: ios2
1400# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1401
1402# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1403 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
1404# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1405 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
1406# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1407 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
1408# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1409 ! y_coords/files_loaded above.
1410# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1411 real(wp), allocatable, dimension(:,:,:) :: stored_values274
1412# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1413 logical :: files_loaded274 = .false.
1414# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1415 integer :: f274, ix274, iy274, unit274, ios274
1416# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1417 integer :: local_ix_beg274, local_iy_beg274
1418# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1419 character(len=300) :: fname274
1420# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1421 character(len=20) :: file_num_str274
1422# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1423 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
1424# 235 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1425 real(wp) :: file_dx274, file_dy274, r_align274
1426# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1427 ! Place any declaration of intermediate variables here
1428# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1429 real(wp) :: eps, eps_mhd, c_mhd
1430# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1431 real(wp) :: r, rmax, gam, umax, p0
1432# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1433 real(wp) :: rhoh, rhol, pref, pint, h, lam, wl, amp, inth, intl, alph
1434# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1435 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
1436# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1437 real(wp) :: r0, alpha, r2
1438# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1439 real(wp) :: sina, cosa
1440# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1441 real(wp) :: r_sq
1442# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1443
1444# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1445 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
1446# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1447 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, t_facq, wq
1448# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1449 real(wp) :: rho_avg, rhou_avg, rhov_avg, e_avg
1450# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1451 real(wp) :: rhoq, pq, uq, vq, eq, vortex_eps
1452# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1453 integer :: igq, jgq
1454# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1455
1456# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1457 ! # 291 - Shear/Thermal Layer Case
1458# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1459 real(wp) :: delta_shear, u_max, u_mean
1460# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1461 real(wp) :: t_wall, t_inf, p_atm, t_loc
1462# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1463 real(wp) :: delta_th, r_mix
1464# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1465 real(wp) :: y_n2, y_o2, mw_n2, mw_o2
1466# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1467 real(wp) :: bottom_blend_u, bottom_blend_t
1468# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1469
1470# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1471 ! # 207
1472# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1473 real(wp) :: sigma, gauss1, gauss2
1474# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1475
1476# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1477 ! # 208
1478# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1479 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
1480# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1481 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
1482# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1483 integer :: v, idx_lo, idx_hi, idx_mid
1484# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1485 real(wp), parameter :: ly_param = 0.00775735_wp
1486# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1487 real(wp), parameter :: a_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
1488# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1489 integer, parameter :: nwaves = 6
1490# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1491 real(wp), parameter :: y0_ref = 0.0_wp
1492# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1493
1494# 236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1495 eps = 1.e-9_wp
1496# 237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1497
1498 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
1499 x_centroid = patch_icpp(patch_id)%x_centroid
1500 y_centroid = patch_icpp(patch_id)%y_centroid
1501 mya = patch_icpp(patch_id)%radius
1502 thickness = patch_icpp(patch_id)%length_x
1503 nturns = patch_icpp(patch_id)%length_y
1504
1505 !
1506 logic_grid = 0
1507 do k = 0, int(m*91*nturns)
1508 th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi
1509
1510 spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1511 spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1512
1513 spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), f_r(th, thickness, mya)*cos(th)/))
1514 spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), f_r(th, thickness, mya)*sin(th)/))
1515
1516 do j = 0, n; do i = 0, m
1517 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) &
1518 & < spiral_y_max)) then
1519 logic_grid(i, j, 0) = 1
1520 end if
1521 end do; end do
1522 end do
1523
1524 do j = 0, n
1525 do i = 0, m
1526 if ((logic_grid(i, j, 0) == 1)) then
1527 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
1528
1529
1530# 270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1531 if (patch_icpp(patch_id)%hcid /= dflt_int) then
1532 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
1533# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1534 case (200) ! Two-fluid cubic interface
1535# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1536 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
1537# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1538 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
1539# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1540 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
1541# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1542 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
1543# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1544 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
1545# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1546 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
1547# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1548 end if
1549# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1550 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
1551# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1552 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1553# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1554 rmax = 0.2_wp
1555# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1556
1557# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1558 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1559# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1560 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1561# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1562 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1563# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1564
1565# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1566 if (r < rmax) then
1567# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1568 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1569# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1570 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1571# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1572 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1573# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1574 else if (r < 2*rmax) then
1575# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1576 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1577# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1578 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1579# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1580 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)))
1581# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1582 else
1583# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1584 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1585# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1586 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1587# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1588 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
1589# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1590 end if
1591# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1592 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
1593# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1594 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1595# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1596 rmax = 0.2_wp
1597# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1598
1599# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1600 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1601# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1602 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1603# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1604 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1605# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1606
1607# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1608 if (r < rmax) then
1609# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1610 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1611# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1612 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1613# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1614 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1615# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1616 else if (r < 2*rmax) then
1617# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1618 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1619# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1620 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1621# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1622 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)))
1623# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1624 else
1625# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1626 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
1627# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1628 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
1629# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1630 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
1631# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1632 end if
1633# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1634
1635# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1636 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
1637# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1638 case (204) ! Rayleigh-Taylor instability
1639# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1640 rhoh = 3._wp
1641# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1642 rhol = 1._wp
1643# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1644 pref = 1.e5_wp
1645# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1646 pint = pref
1647# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1648 h = 0.7_wp
1649# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1650 lam = 0.2_wp
1651# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1652 wl = 2._wp*pi/lam
1653# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1654 amp = 0.05_wp/wl
1655# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1656
1657# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1658 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
1659# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1660
1661# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1662 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
1663# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1664
1665# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1666 if (alph < eps) alph = eps
1667# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1668 if (alph > 1._wp - eps) alph = 1._wp - eps
1669# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1670
1671# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1672 if (y_cc(j) > inth) then
1673# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1674 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1675# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1676 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1677# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1678 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1679# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1680 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1681# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1682 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
1683# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1684 else
1685# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1686 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
1687# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1688 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
1689# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1690 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
1691# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1692 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
1693# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1694 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
1695# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1696 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
1697# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1698 end if
1699# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1700 case (205) ! 2D lung wave interaction problem
1701# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1702 h = 0.0_wp ! non dim origin y
1703# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1704 lam = 1.0_wp ! non dim lambda
1705# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1706 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
1707# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1708
1709# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1710 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
1711# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1712
1713# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1714 if (y_cc(j) > inth) then
1715# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1716 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1717# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1718 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1719# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1720 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1721# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1722 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1723# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1724 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1725# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1726 end if
1727# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1728 case (206) ! 2D lung wave interaction problem - horizontal domain
1729# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1730 h = 0.0_wp ! non dim origin y
1731# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1732 lam = 1.0_wp ! non dim lambda
1733# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1734 amp = patch_icpp(patch_id)%a(2)
1735# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1736
1737# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1738 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
1739# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1740
1741# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1742 if (x_cc(i) > intl) then ! this is the liquid
1743# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1744 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1745# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1746 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1747# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1748 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
1749# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1750 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1751# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1752 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1753# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1754 end if
1755# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1756 case (207) ! Kelvin Helmholtz Instability
1757# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1758 sigma = 0.05_wp/sqrt(2.0_wp)
1759# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1760 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
1761# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1762 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
1763# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1764 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)
1765# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1766 case (208) ! Richtmeyer Meshkov Instability
1767# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1768 lam = 1.0_wp
1769# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1770 eps = 1.0e-6_wp
1771# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1772 ei = 5.0_wp
1773# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1774 ! Smoothening function to smooth out sharp discontinuity in the interface
1775# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1776 if (x_cc(i) <= 0.7_wp*lam) then
1777# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1778 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
1779# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1780 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
1781# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1782 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
1783# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1784 alpha_sf6 = 1.0_wp - alpha_air
1785# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1786 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
1787# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1788 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
1789# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1790 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
1791# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1792 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
1793# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1794 end if
1795# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1796 case (250) ! MHD Orszag-Tang vortex
1797# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1798 ! 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),
1799# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1800 ! sin(4*pi*x)/sqrt(4*pi), 0)
1801# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1802
1803# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1804 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
1805# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1806 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
1807# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1808
1809# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1810 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
1811# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1812 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
1813# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1814 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
1815# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1816 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
1817# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1818 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
1819# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1820 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
1821# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1822 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
1823# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1824 ! Linear interpolation between r=0.08 and r=1.0
1825# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1826 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
1827# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1828 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
1829# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1830 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
1831# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1832 else
1833# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1834 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
1835# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1836 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
1837# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1838 end if
1839# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1840
1841# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1842 ! case 252 is for the 2D MHD Rotor problem
1843# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1844 case (252) ! 2D MHD Rotor Problem
1845# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1846 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
1847# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1848 !
1849# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1850 ! 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
1851# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1852 ! velocity w=20, giving v_tan=2 at r=0.1
1853# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1854
1855# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1856 ! Calculate distance squared from the center
1857# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1858 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
1859# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1860
1861# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1862 ! inner radius of 0.1
1863# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1864 if (r_sq <= 0.1**2) then
1865# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1866 ! -- Inside the rotor -- Set density uniformly to 10
1867# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1868 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
1869# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1870
1871# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1872 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
1873# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1874 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
1875# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1876 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
1877# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1878
1879# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1880 ! taper width of 0.015
1881# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1882 else if (r_sq <= 0.115**2) then
1883# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1884 ! linearly smooth the function between r = 0.1 and 0.115
1885# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1886 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1887# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1888
1889# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1890 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)
1891# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1892 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)
1893# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1894 end if
1895# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1896 case (253) ! MHD Smooth Magnetic Vortex
1897# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1898 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
1899# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1900 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
1901# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1902
1903# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1904 ! velocity
1905# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1906 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))
1907# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1908 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))
1909# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1910
1911# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1912 ! magnetic field
1913# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1914 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)
1915# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1916 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)
1917# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1918
1919# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1920 ! pressure
1921# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1922 q_prim_vf(eqn_idx%E)%sf(i, j, &
1923# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1924 & 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)
1925# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1926 case (260) ! Gaussian Divergence Pulse
1927# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1928 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
1929# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1930 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
1931# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1932 ! initialized to zero everywhere.
1933# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1934
1935# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1936 eps_mhd = patch_icpp(patch_id)%a(2)
1937# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1938 sigma = patch_icpp(patch_id)%a(3)
1939# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1940 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
1941# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1942
1943# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1944 ! B-field
1945# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1946 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
1947# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1948 case (261) ! Blob
1949# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1950 r0 = 1._wp/sqrt(8._wp)
1951# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1952 r2 = x_cc(i)**2 + y_cc(j)**2
1953# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1954 r = sqrt(r2)
1955# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1956 alpha = r/r0
1957# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1958 if (alpha < 1) then
1959# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1960 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)
1961# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1962 end if
1963# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1964 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
1965# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1966 ! rotate by \alpha = atan(2)
1967# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1968 alpha = atan(2._wp)
1969# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1970 cosa = cos(alpha)
1971# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1972 sina = sin(alpha)
1973# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1974 ! projection along shock normal
1975# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1976 r = x_cc(i)*cosa + y_cc(j)*sina
1977# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1978
1979# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1980 if (r <= 0.5_wp) then
1981# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1982 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
1983# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1984 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
1985# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1986 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
1987# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1988 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
1989# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1990 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
1991# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1992 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
1993# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1994 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
1995# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1996 else
1997# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1998 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
1999# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2000 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
2001# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2002 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
2003# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2004 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
2005# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2006 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
2007# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2008 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
2009# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2010 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
2011# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2012 end if
2013# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2014 ! v^z and B^z remain zero by default
2015# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2016 case (270) ! 2D extrusion of 1D profile from external data
2017# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2018 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
2019# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2020 if (.not. files_loaded) then
2021# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2022 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
2023# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2024 do f = 1, max_files
2025# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2026 write (file_num_str, '(I0)') f
2027# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2028 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
2029# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2030 end do
2031# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2032
2033# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2034 ! Common file reading setup
2035# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2036 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2037# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2038 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
2039# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2040
2041# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2042 select case (num_dims)
2043# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2044 case (1, 2) ! 1D and 2D cases are similar
2045# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2046 ! Count lines
2047# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2048 line_count = 0
2049# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2050 do
2051# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2052 read (unit2, *, iostat=ios2) dummy_x, dummy_y
2053# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2054 if (ios2 /= 0) exit
2055# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2056 line_count = line_count + 1
2057# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2058 end do
2059# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2060 close (unit2)
2061# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2062
2063# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2064 xrows = line_count
2065# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2066 yrows = 1
2067# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2068 index_x = 0
2069# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2070 if (num_dims == 2) index_x = i
2071# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2072#ifdef MFC_DEBUG
2073# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2074 block
2075# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2076 use iso_fortran_env, only: output_unit
2077# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2078
2079# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2080 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
2081# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2082
2083# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2084 call flush (output_unit)
2085# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2086 end block
2087# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2088#endif
2089# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2090 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
2091# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2092
2093# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2094
2095# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2096
2097# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2098#if defined(MFC_OpenACC)
2099# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2100!$acc enter data create(x_coords, stored_values)
2101# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2102#elif defined(MFC_OpenMP)
2103# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2104!$omp target enter data map(always,alloc:x_coords, stored_values)
2105# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2106#endif
2107# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2108
2109# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2110 ! Read data from all files
2111# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2112 do f = 1, max_files
2113# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2114 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2115# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2116 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2117# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2118
2119# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2120 do iter = 1, xrows
2121# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2122 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
2123# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2124 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
2125# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2126 end do
2127# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2128 close (unit)
2129# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2130 end do
2131# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2132
2133# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2134 ! Calculate offsets
2135# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2136 domain_xstart = x_coords(1)
2137# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2138 x_step = x_cc(1) - x_cc(0)
2139# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2140 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
2141# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2142 global_offset_x = nint(abs(delta_x)/x_step)
2143# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2144 case (3) ! 3D case - determine grid structure
2145# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2146 ! Find yRows by counting rows with same x
2147# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2148 read (unit2, *, iostat=ios2) x0, y0, dummy_z
2149# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2150 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
2151# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2152
2153# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2154 yrows = 1
2155# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2156 do
2157# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2158 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2159# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2160 if (ios2 /= 0) exit
2161# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2162 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
2163# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2164 yrows = yrows + 1
2165# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2166 else
2167# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2168 exit
2169# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2170 end if
2171# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2172 end do
2173# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2174 close (unit2)
2175# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2176
2177# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2178 ! Count total rows
2179# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2180 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2181# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2182 nrows = 0
2183# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2184 do
2185# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2186 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2187# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2188 if (ios2 /= 0) exit
2189# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2190 nrows = nrows + 1
2191# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2192 end do
2193# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2194 close (unit2)
2195# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2196
2197# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2198 xrows = nrows/yrows
2199# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2200#ifdef MFC_DEBUG
2201# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2202 block
2203# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2204 use iso_fortran_env, only: output_unit
2205# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2206
2207# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2208 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2209# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2210
2211# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2212 call flush (output_unit)
2213# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2214 end block
2215# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2216#endif
2217# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2218 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2219# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2220
2221# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2222
2223# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2224
2225# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2226
2227# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2228#if defined(MFC_OpenACC)
2229# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2230!$acc enter data create(x_coords, y_coords, stored_values)
2231# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2232#elif defined(MFC_OpenMP)
2233# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2234!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2235# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2236#endif
2237# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2238 index_x = i
2239# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2240 index_y = j
2241# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2242
2243# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2244 ! Read all files
2245# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2246 do f = 1, max_files
2247# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2248 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2249# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2250 if (ios /= 0) then
2251# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2252 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2253# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2254 cycle
2255# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2256 end if
2257# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2258
2259# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2260 iter = 0
2261# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2262 do iix = 1, xrows
2263# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2264 do iiy = 1, yrows
2265# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2266 iter = iter + 1
2267# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2268 if (f == 1) then
2269# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2270 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2271# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2272 else
2273# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2274 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2275# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2276 end if
2277# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2278 if (ios /= 0) call s_mpi_abort("Error reading data")
2279# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2280 end do
2281# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2282 end do
2283# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2284 close (unit)
2285# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2286 end do
2287# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2288
2289# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2290 ! Calculate offsets
2291# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2292 x_step = x_cc(1) - x_cc(0)
2293# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2294 y_step = y_cc(1) - y_cc(0)
2295# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2296 delta_x = x_cc(index_x) - x_coords(1)
2297# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2298 delta_y = y_cc(index_y) - y_coords(1)
2299# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2300 global_offset_x = nint(abs(delta_x)/x_step)
2301# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2302 global_offset_y = nint(abs(delta_y)/y_step)
2303# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2304
2305# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2306 ! The index check below only catches overruns, so a file that is merely too
2307# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2308 ! FINE stays in range and silently supplies a corner of itself. Check spacing
2309# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2310 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
2311# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2312 ! consecutive x values sit yRows apart.
2313# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2314 if (nrows > yrows) then
2315# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2316 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
2317# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2318 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
2319# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2320 end if
2321# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2322 if (yrows > 1) then
2323# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2324 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
2325# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2326 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
2327# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2328 end if
2329# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2330 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
2331# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2332 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
2333# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2334 & wp)) > 1.e-6_wp) &
2335# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2336 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
2337# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2338 end select
2339# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2340
2341# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2342 files_loaded = .true.
2343# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2344 end if
2345# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2346
2347# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2348 ! Data assignment
2349# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2350 select case (num_dims)
2351# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2352 case (1)
2353# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2354 idx = i + 1 + global_offset_x
2355# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2356 ! idx must land inside the file's row range: this rank's subdomain offset
2357# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2358 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
2359# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2360 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
2361# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2362 if (idx < 1 .or. idx > xrows) &
2363# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2364 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
2365# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2366 do f = 1, sys_size
2367# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2368 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2369# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2370 end do
2371# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2372 case (2)
2373# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2374 idx = i + 1 + global_offset_x - index_x
2375# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2376 if (idx < 1 .or. idx > xrows) &
2377# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2378 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
2379# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2380 do f = 1, sys_size - 1
2381# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2382 jump = merge(1, 0, f >= eqn_idx%mom%end)
2383# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2384 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2385# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2386 end do
2387# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2388 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2389# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2390 case (3)
2391# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2392 idx = i + 1 + global_offset_x - index_x
2393# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2394 idy = j + 1 + global_offset_y - index_y
2395# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2396 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
2397# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2398 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
2399# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2400 do f = 1, sys_size - 1
2401# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2402 jump = merge(1, 0, f >= eqn_idx%mom%end)
2403# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2404 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2405# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2406 end do
2407# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2408 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
2409# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2410 end select
2411# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2412 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
2413# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2414 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
2415# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2416 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
2417# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2418 ! cross-stream-position profile (real cross-stream velocity is legitimately
2419# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2420 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
2421# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2422 ! zero out mom%beg's true physical value.
2423# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2424 if (.not. files_loaded) then
2425# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2426 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
2427# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2428 do f = 1, max_files
2429# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2430 write (file_num_str, '(I0)') f
2431# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2432 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
2433# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2434 end do
2435# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2436
2437# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2438 ! Common file reading setup
2439# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2440 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2441# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2442 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
2443# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2444
2445# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2446 select case (num_dims)
2447# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2448 case (1, 2) ! 1D and 2D cases are similar
2449# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2450 ! Count lines
2451# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2452 line_count = 0
2453# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2454 do
2455# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2456 read (unit2, *, iostat=ios2) dummy_x, dummy_y
2457# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2458 if (ios2 /= 0) exit
2459# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2460 line_count = line_count + 1
2461# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2462 end do
2463# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2464 close (unit2)
2465# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2466
2467# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2468 xrows = line_count
2469# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2470 yrows = 1
2471# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2472 index_x = 0
2473# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2474 if (num_dims == 2) index_x = i
2475# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2476#ifdef MFC_DEBUG
2477# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2478 block
2479# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2480 use iso_fortran_env, only: output_unit
2481# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2482
2483# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2484 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
2485# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2486
2487# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2488 call flush (output_unit)
2489# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2490 end block
2491# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2492#endif
2493# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2494 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
2495# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2496
2497# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2498
2499# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2500
2501# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2502#if defined(MFC_OpenACC)
2503# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2504!$acc enter data create(x_coords, stored_values)
2505# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2506#elif defined(MFC_OpenMP)
2507# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2508!$omp target enter data map(always,alloc:x_coords, stored_values)
2509# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2510#endif
2511# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2512
2513# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2514 ! Read data from all files
2515# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2516 do f = 1, max_files
2517# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2518 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2519# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2520 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2521# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2522
2523# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2524 do iter = 1, xrows
2525# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2526 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
2527# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2528 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
2529# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2530 end do
2531# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2532 close (unit)
2533# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2534 end do
2535# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2536
2537# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2538 ! Calculate offsets
2539# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2540 domain_xstart = x_coords(1)
2541# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2542 x_step = x_cc(1) - x_cc(0)
2543# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2544 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
2545# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2546 global_offset_x = nint(abs(delta_x)/x_step)
2547# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2548 case (3) ! 3D case - determine grid structure
2549# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2550 ! Find yRows by counting rows with same x
2551# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2552 read (unit2, *, iostat=ios2) x0, y0, dummy_z
2553# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2554 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
2555# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2556
2557# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2558 yrows = 1
2559# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2560 do
2561# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2562 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2563# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2564 if (ios2 /= 0) exit
2565# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2566 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
2567# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2568 yrows = yrows + 1
2569# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2570 else
2571# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2572 exit
2573# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2574 end if
2575# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2576 end do
2577# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2578 close (unit2)
2579# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2580
2581# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2582 ! Count total rows
2583# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2584 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2585# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2586 nrows = 0
2587# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2588 do
2589# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2590 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2591# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2592 if (ios2 /= 0) exit
2593# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2594 nrows = nrows + 1
2595# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2596 end do
2597# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2598 close (unit2)
2599# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2600
2601# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2602 xrows = nrows/yrows
2603# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2604#ifdef MFC_DEBUG
2605# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2606 block
2607# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2608 use iso_fortran_env, only: output_unit
2609# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2610
2611# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2612 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2613# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2614
2615# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2616 call flush (output_unit)
2617# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2618 end block
2619# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2620#endif
2621# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2622 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2623# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2624
2625# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2626
2627# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2628
2629# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2630
2631# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2632#if defined(MFC_OpenACC)
2633# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2634!$acc enter data create(x_coords, y_coords, stored_values)
2635# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2636#elif defined(MFC_OpenMP)
2637# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2638!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2639# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2640#endif
2641# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2642 index_x = i
2643# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2644 index_y = j
2645# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2646
2647# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2648 ! Read all files
2649# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2650 do f = 1, max_files
2651# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2652 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2653# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2654 if (ios /= 0) then
2655# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2656 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
2657# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2658 cycle
2659# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2660 end if
2661# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2662
2663# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2664 iter = 0
2665# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2666 do iix = 1, xrows
2667# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2668 do iiy = 1, yrows
2669# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2670 iter = iter + 1
2671# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2672 if (f == 1) then
2673# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2674 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2675# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2676 else
2677# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2678 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2679# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2680 end if
2681# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2682 if (ios /= 0) call s_mpi_abort("Error reading data")
2683# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2684 end do
2685# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2686 end do
2687# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2688 close (unit)
2689# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2690 end do
2691# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2692
2693# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2694 ! Calculate offsets
2695# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2696 x_step = x_cc(1) - x_cc(0)
2697# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2698 y_step = y_cc(1) - y_cc(0)
2699# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2700 delta_x = x_cc(index_x) - x_coords(1)
2701# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2702 delta_y = y_cc(index_y) - y_coords(1)
2703# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2704 global_offset_x = nint(abs(delta_x)/x_step)
2705# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2706 global_offset_y = nint(abs(delta_y)/y_step)
2707# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2708
2709# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2710 ! The index check below only catches overruns, so a file that is merely too
2711# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2712 ! FINE stays in range and silently supplies a corner of itself. Check spacing
2713# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2714 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
2715# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2716 ! consecutive x values sit yRows apart.
2717# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2718 if (nrows > yrows) then
2719# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2720 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
2721# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2722 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
2723# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2724 end if
2725# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2726 if (yrows > 1) then
2727# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2728 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
2729# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2730 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
2731# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2732 end if
2733# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2734 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
2735# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2736 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
2737# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2738 & wp)) > 1.e-6_wp) &
2739# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2740 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
2741# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2742 end select
2743# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2744
2745# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2746 files_loaded = .true.
2747# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2748 end if
2749# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2750
2751# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2752 ! Data assignment
2753# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2754 select case (num_dims)
2755# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2756 case (1)
2757# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2758 idx = i + 1 + global_offset_x
2759# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2760 ! idx must land inside the file's row range: this rank's subdomain offset
2761# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2762 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
2763# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2764 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
2765# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2766 if (idx < 1 .or. idx > xrows) &
2767# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2768 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
2769# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2770 do f = 1, sys_size
2771# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2772 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2773# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2774 end do
2775# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2776 case (2)
2777# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2778 idx = i + 1 + global_offset_x - index_x
2779# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2780 if (idx < 1 .or. idx > xrows) &
2781# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2782 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
2783# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2784 do f = 1, sys_size - 1
2785# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2786 jump = merge(1, 0, f >= eqn_idx%mom%end)
2787# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2788 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2789# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2790 end do
2791# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2792 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
2793# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2794 case (3)
2795# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2796 idx = i + 1 + global_offset_x - index_x
2797# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2798 idy = j + 1 + global_offset_y - index_y
2799# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2800 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
2801# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2802 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
2803# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2804 do f = 1, sys_size - 1
2805# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2806 jump = merge(1, 0, f >= eqn_idx%mom%end)
2807# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2808 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2809# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2810 end do
2811# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2812 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
2813# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2814 end select
2815# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2816 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
2817# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2818 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
2819# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2820 case (274) ! Full 2D field from external data (no extrusion)
2821# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2822 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
2823# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2824 ! extrusion direction and no zeroed component -- all sys_size variables are read and
2825# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2826 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
2827# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2828 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
2829# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2830 ! global grid exactly -- by construction, since the IC generator derives both the
2831# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2832 ! grid and the file contents from the same computation.
2833# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2834 !
2835# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2836 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
2837# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2838 ! file's own first coordinate and this rank's uniform grid spacing -- following the
2839# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2840 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
2841# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2842 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
2843# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2844 ! returns before allocating it otherwise), so a serial-IO run (the default for
2845# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2846 ! golden-file tests) would index into an unallocated array.
2847# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2848 !
2849# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2850 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
2851# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2852 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
2853# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2854 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
2855# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2856 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
2857# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2858 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
2859# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2860 ! global cell offset) are pinned from f274==1's very first record, before any other
2861# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2862 ! record is read, so every subsequent record -- across all variables -- can be tested
2863# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2864 ! against this rank's range and dropped if it falls outside it.
2865# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2866 x_step274 = x_cc(1) - x_cc(0)
2867# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2868 y_step274 = y_cc(1) - y_cc(0)
2869# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2870
2871# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2872 if (.not. files_loaded274) then
2873# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2874#ifdef MFC_DEBUG
2875# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2876 block
2877# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2878 use iso_fortran_env, only: output_unit
2879# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2880
2881# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2882 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
2883# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2884
2885# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2886 call flush (output_unit)
2887# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2888 end block
2889# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2890#endif
2891# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2892 allocate (stored_values274(0:m, 0:n, sys_size))
2893# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2894
2895# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2896
2897# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2898#if defined(MFC_OpenACC)
2899# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2900!$acc enter data create(stored_values274)
2901# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2902#elif defined(MFC_OpenMP)
2903# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2904!$omp target enter data map(always,alloc:stored_values274)
2905# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2906#endif
2907# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2908 do f274 = 1, sys_size
2909# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2910 write (file_num_str274, '(I0)') f274
2911# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2912 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
2913# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2914 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
2915# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2916 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
2917# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2918 do ix274 = 0, m_glb
2919# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2920 do iy274 = 0, n_glb
2921# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2922 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
2923# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2924 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
2925# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2926 ! Capture the file's own origin and spacing from its first records so we can
2927# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2928 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
2929# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2930 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
2931# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2932 if (f274 == 1) then
2933# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2934 if (ix274 == 0 .and. iy274 == 0) then
2935# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2936 x0_274 = dummy_x274
2937# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2938 y0_274 = dummy_y274
2939# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2940 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
2941# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2942 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
2943# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2944 end if
2945# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2946 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
2947# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2948 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
2949# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2950 end if
2951# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2952 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
2953# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2954 & .and. iy274 - local_iy_beg274 <= n) then
2955# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2956 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
2957# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2958 end if
2959# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2960 end do
2961# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2962 end do
2963# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2964 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
2965# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2966 ! read means it was generated for a larger grid and would be silently misread.
2967# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2968 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
2969# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2970 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
2971# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2972 close (unit274)
2973# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2974 end do
2975# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2976
2977# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2978 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
2979# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2980 ! Check alignment via the integer cell offset of this rank's first cell from the file
2981# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2982 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
2983# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2984 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
2985# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2986 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
2987# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2988 ! the global origin.) The spacing checks below must also hold.
2989# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2990 r_align274 = (x_cc(0) - x0_274)/x_step274
2991# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2992 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
2993# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2994 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
2995# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2996 if (m_glb >= 1) then
2997# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2998 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
2999# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3000 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
3001# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3002 end if
3003# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3004 if (n_glb >= 1) then
3005# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3006 r_align274 = (y_cc(0) - y0_274)/y_step274
3007# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3008 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
3009# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3010 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
3011# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3012 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
3013# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3014 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
3015# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3016 end if
3017# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3018
3019# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3020 files_loaded274 = .true.
3021# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3022 end if
3023# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3024 ! Alignment is verified above (or this rank would already have aborted), so the local
3025# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3026 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
3027# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3028 do f274 = 1, sys_size
3029# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3030 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
3031# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3032 end do
3033# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3034 case (271) ! Premixed Flame Vortices Interaction
3035# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3036 if (.not. files_loaded) then
3037# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3038 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
3039# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3040 do f = 1, max_files
3041# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3042 write (file_num_str, '(I0)') f
3043# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3044 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
3045# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3046 end do
3047# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3048
3049# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3050 ! Common file reading setup
3051# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3052 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3053# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3054 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
3055# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3056
3057# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3058 select case (num_dims)
3059# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3060 case (1, 2) ! 1D and 2D cases are similar
3061# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3062 ! Count lines
3063# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3064 line_count = 0
3065# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3066 do
3067# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3068 read (unit2, *, iostat=ios2) dummy_x, dummy_y
3069# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3070 if (ios2 /= 0) exit
3071# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3072 line_count = line_count + 1
3073# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3074 end do
3075# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3076 close (unit2)
3077# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3078
3079# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3080 xrows = line_count
3081# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3082 yrows = 1
3083# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3084 index_x = 0
3085# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3086 if (num_dims == 2) index_x = i
3087# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3088#ifdef MFC_DEBUG
3089# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3090 block
3091# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3092 use iso_fortran_env, only: output_unit
3093# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3094
3095# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3096 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
3097# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3098
3099# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3100 call flush (output_unit)
3101# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3102 end block
3103# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3104#endif
3105# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3106 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
3107# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3108
3109# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3110
3111# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3112
3113# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3114#if defined(MFC_OpenACC)
3115# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3116!$acc enter data create(x_coords, stored_values)
3117# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3118#elif defined(MFC_OpenMP)
3119# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3120!$omp target enter data map(always,alloc:x_coords, stored_values)
3121# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3122#endif
3123# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3124
3125# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3126 ! Read data from all files
3127# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3128 do f = 1, max_files
3129# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3130 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3131# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3132 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3133# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3134
3135# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3136 do iter = 1, xrows
3137# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3138 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3139# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3140 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
3141# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3142 end do
3143# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3144 close (unit)
3145# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3146 end do
3147# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3148
3149# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3150 ! Calculate offsets
3151# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3152 domain_xstart = x_coords(1)
3153# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3154 x_step = x_cc(1) - x_cc(0)
3155# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3156 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
3157# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3158 global_offset_x = nint(abs(delta_x)/x_step)
3159# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3160 case (3) ! 3D case - determine grid structure
3161# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3162 ! Find yRows by counting rows with same x
3163# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3164 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3165# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3166 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3167# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3168
3169# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3170 yrows = 1
3171# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3172 do
3173# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3174 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3175# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3176 if (ios2 /= 0) exit
3177# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3178 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
3179# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3180 yrows = yrows + 1
3181# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3182 else
3183# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3184 exit
3185# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3186 end if
3187# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3188 end do
3189# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3190 close (unit2)
3191# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3192
3193# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3194 ! Count total rows
3195# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3196 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3197# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3198 nrows = 0
3199# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3200 do
3201# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3202 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3203# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3204 if (ios2 /= 0) exit
3205# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3206 nrows = nrows + 1
3207# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3208 end do
3209# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3210 close (unit2)
3211# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3212
3213# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3214 xrows = nrows/yrows
3215# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3216#ifdef MFC_DEBUG
3217# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3218 block
3219# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3220 use iso_fortran_env, only: output_unit
3221# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3222
3223# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3224 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3225# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3226
3227# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3228 call flush (output_unit)
3229# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3230 end block
3231# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3232#endif
3233# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3234 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3235# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3236
3237# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3238
3239# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3240
3241# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3242
3243# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3244#if defined(MFC_OpenACC)
3245# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3246!$acc enter data create(x_coords, y_coords, stored_values)
3247# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3248#elif defined(MFC_OpenMP)
3249# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3250!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3251# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3252#endif
3253# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3254 index_x = i
3255# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3256 index_y = j
3257# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3258
3259# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3260 ! Read all files
3261# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3262 do f = 1, max_files
3263# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3264 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3265# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3266 if (ios /= 0) then
3267# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3268 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3269# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3270 cycle
3271# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3272 end if
3273# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3274
3275# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3276 iter = 0
3277# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3278 do iix = 1, xrows
3279# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3280 do iiy = 1, yrows
3281# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3282 iter = iter + 1
3283# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3284 if (f == 1) then
3285# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3286 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3287# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3288 else
3289# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3290 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3291# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3292 end if
3293# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3294 if (ios /= 0) call s_mpi_abort("Error reading data")
3295# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3296 end do
3297# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3298 end do
3299# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3300 close (unit)
3301# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3302 end do
3303# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3304
3305# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3306 ! Calculate offsets
3307# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3308 x_step = x_cc(1) - x_cc(0)
3309# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3310 y_step = y_cc(1) - y_cc(0)
3311# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3312 delta_x = x_cc(index_x) - x_coords(1)
3313# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3314 delta_y = y_cc(index_y) - y_coords(1)
3315# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3316 global_offset_x = nint(abs(delta_x)/x_step)
3317# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3318 global_offset_y = nint(abs(delta_y)/y_step)
3319# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3320
3321# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3322 ! The index check below only catches overruns, so a file that is merely too
3323# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3324 ! FINE stays in range and silently supplies a corner of itself. Check spacing
3325# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3326 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
3327# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3328 ! consecutive x values sit yRows apart.
3329# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3330 if (nrows > yrows) then
3331# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3332 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
3333# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3334 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
3335# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3336 end if
3337# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3338 if (yrows > 1) then
3339# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3340 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
3341# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3342 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
3343# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3344 end if
3345# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3346 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
3347# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3348 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
3349# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3350 & wp)) > 1.e-6_wp) &
3351# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3352 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
3353# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3354 end select
3355# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3356
3357# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3358 files_loaded = .true.
3359# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3360 end if
3361# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3362
3363# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3364 ! Data assignment
3365# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3366 select case (num_dims)
3367# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3368 case (1)
3369# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3370 idx = i + 1 + global_offset_x
3371# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3372 ! idx must land inside the file's row range: this rank's subdomain offset
3373# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3374 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
3375# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3376 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
3377# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3378 if (idx < 1 .or. idx > xrows) &
3379# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3380 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
3381# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3382 do f = 1, sys_size
3383# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3384 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3385# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3386 end do
3387# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3388 case (2)
3389# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3390 idx = i + 1 + global_offset_x - index_x
3391# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3392 if (idx < 1 .or. idx > xrows) &
3393# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3394 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
3395# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3396 do f = 1, sys_size - 1
3397# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3398 jump = merge(1, 0, f >= eqn_idx%mom%end)
3399# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3400 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3401# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3402 end do
3403# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3404 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3405# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3406 case (3)
3407# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3408 idx = i + 1 + global_offset_x - index_x
3409# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3410 idy = j + 1 + global_offset_y - index_y
3411# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3412 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
3413# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3414 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
3415# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3416 do f = 1, sys_size - 1
3417# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3418 jump = merge(1, 0, f >= eqn_idx%mom%end)
3419# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3420 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3421# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3422 end do
3423# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3424 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
3425# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3426 end select
3427# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3428 x1c = 0.0027_wp
3429# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3430 y1c = 0.005_wp
3431# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3432 x2c = 0.0027_wp
3433# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3434 y2c = 0.003_wp
3435# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3436 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
3437# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3438 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
3439# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3440 rvortex = 0.0005_wp
3441# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3442 cvortex = 6000.0_wp
3443# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3444
3445# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3446 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
3447# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3448 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
3449# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3450
3451# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3452 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
3453# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3454 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
3455# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3456 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
3457# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3458 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
3459# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3460 case (272) ! Premixed Flame Instability
3461# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3462 if (.not. files_loaded) then
3463# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3464 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
3465# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3466 do f = 1, max_files
3467# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3468 write (file_num_str, '(I0)') f
3469# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3470 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
3471# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3472 end do
3473# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3474
3475# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3476 ! Common file reading setup
3477# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3478 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3479# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3480 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
3481# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3482
3483# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3484 select case (num_dims)
3485# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3486 case (1, 2) ! 1D and 2D cases are similar
3487# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3488 ! Count lines
3489# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3490 line_count = 0
3491# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3492 do
3493# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3494 read (unit2, *, iostat=ios2) dummy_x, dummy_y
3495# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3496 if (ios2 /= 0) exit
3497# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3498 line_count = line_count + 1
3499# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3500 end do
3501# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3502 close (unit2)
3503# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3504
3505# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3506 xrows = line_count
3507# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3508 yrows = 1
3509# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3510 index_x = 0
3511# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3512 if (num_dims == 2) index_x = i
3513# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3514#ifdef MFC_DEBUG
3515# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3516 block
3517# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3518 use iso_fortran_env, only: output_unit
3519# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3520
3521# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3522 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
3523# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3524
3525# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3526 call flush (output_unit)
3527# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3528 end block
3529# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3530#endif
3531# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3532 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
3533# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3534
3535# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3536
3537# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3538
3539# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3540#if defined(MFC_OpenACC)
3541# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3542!$acc enter data create(x_coords, stored_values)
3543# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3544#elif defined(MFC_OpenMP)
3545# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3546!$omp target enter data map(always,alloc:x_coords, stored_values)
3547# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3548#endif
3549# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3550
3551# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3552 ! Read data from all files
3553# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3554 do f = 1, max_files
3555# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3556 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3557# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3558 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3559# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3560
3561# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3562 do iter = 1, xrows
3563# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3564 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3565# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3566 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
3567# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3568 end do
3569# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3570 close (unit)
3571# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3572 end do
3573# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3574
3575# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3576 ! Calculate offsets
3577# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3578 domain_xstart = x_coords(1)
3579# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3580 x_step = x_cc(1) - x_cc(0)
3581# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3582 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
3583# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3584 global_offset_x = nint(abs(delta_x)/x_step)
3585# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3586 case (3) ! 3D case - determine grid structure
3587# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3588 ! Find yRows by counting rows with same x
3589# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3590 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3591# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3592 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3593# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3594
3595# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3596 yrows = 1
3597# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3598 do
3599# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3600 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3601# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3602 if (ios2 /= 0) exit
3603# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3604 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
3605# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3606 yrows = yrows + 1
3607# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3608 else
3609# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3610 exit
3611# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3612 end if
3613# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3614 end do
3615# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3616 close (unit2)
3617# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3618
3619# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3620 ! Count total rows
3621# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3622 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3623# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3624 nrows = 0
3625# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3626 do
3627# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3628 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3629# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3630 if (ios2 /= 0) exit
3631# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3632 nrows = nrows + 1
3633# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3634 end do
3635# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3636 close (unit2)
3637# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3638
3639# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3640 xrows = nrows/yrows
3641# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3642#ifdef MFC_DEBUG
3643# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3644 block
3645# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3646 use iso_fortran_env, only: output_unit
3647# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3648
3649# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3650 print *, 'm_icpp_patches.fpp:271: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3651# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3652
3653# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3654 call flush (output_unit)
3655# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3656 end block
3657# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3658#endif
3659# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3660 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3661# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3662
3663# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3664
3665# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3666
3667# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3668
3669# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3670#if defined(MFC_OpenACC)
3671# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3672!$acc enter data create(x_coords, y_coords, stored_values)
3673# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3674#elif defined(MFC_OpenMP)
3675# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3676!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3677# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3678#endif
3679# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3680 index_x = i
3681# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3682 index_y = j
3683# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3684
3685# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3686 ! Read all files
3687# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3688 do f = 1, max_files
3689# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3690 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3691# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3692 if (ios /= 0) then
3693# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3694 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
3695# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3696 cycle
3697# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3698 end if
3699# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3700
3701# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3702 iter = 0
3703# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3704 do iix = 1, xrows
3705# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3706 do iiy = 1, yrows
3707# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3708 iter = iter + 1
3709# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3710 if (f == 1) then
3711# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3712 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3713# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3714 else
3715# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3716 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3717# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3718 end if
3719# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3720 if (ios /= 0) call s_mpi_abort("Error reading data")
3721# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3722 end do
3723# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3724 end do
3725# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3726 close (unit)
3727# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3728 end do
3729# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3730
3731# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3732 ! Calculate offsets
3733# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3734 x_step = x_cc(1) - x_cc(0)
3735# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3736 y_step = y_cc(1) - y_cc(0)
3737# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3738 delta_x = x_cc(index_x) - x_coords(1)
3739# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3740 delta_y = y_cc(index_y) - y_coords(1)
3741# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3742 global_offset_x = nint(abs(delta_x)/x_step)
3743# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3744 global_offset_y = nint(abs(delta_y)/y_step)
3745# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3746
3747# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3748 ! The index check below only catches overruns, so a file that is merely too
3749# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3750 ! FINE stays in range and silently supplies a corner of itself. Check spacing
3751# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3752 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
3753# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3754 ! consecutive x values sit yRows apart.
3755# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3756 if (nrows > yrows) then
3757# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3758 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
3759# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3760 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
3761# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3762 end if
3763# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3764 if (yrows > 1) then
3765# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3766 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
3767# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3768 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
3769# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3770 end if
3771# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3772 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
3773# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3774 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
3775# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3776 & wp)) > 1.e-6_wp) &
3777# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3778 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
3779# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3780 end select
3781# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3782
3783# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3784 files_loaded = .true.
3785# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3786 end if
3787# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3788
3789# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3790 ! Data assignment
3791# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3792 select case (num_dims)
3793# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3794 case (1)
3795# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3796 idx = i + 1 + global_offset_x
3797# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3798 ! idx must land inside the file's row range: this rank's subdomain offset
3799# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3800 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
3801# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3802 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
3803# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3804 if (idx < 1 .or. idx > xrows) &
3805# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3806 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
3807# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3808 do f = 1, sys_size
3809# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3810 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3811# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3812 end do
3813# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3814 case (2)
3815# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3816 idx = i + 1 + global_offset_x - index_x
3817# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3818 if (idx < 1 .or. idx > xrows) &
3819# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3820 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
3821# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3822 do f = 1, sys_size - 1
3823# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3824 jump = merge(1, 0, f >= eqn_idx%mom%end)
3825# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3826 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3827# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3828 end do
3829# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3830 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3831# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3832 case (3)
3833# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3834 idx = i + 1 + global_offset_x - index_x
3835# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3836 idy = j + 1 + global_offset_y - index_y
3837# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3838 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
3839# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3840 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
3841# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3842 do f = 1, sys_size - 1
3843# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3844 jump = merge(1, 0, f >= eqn_idx%mom%end)
3845# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3846 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3847# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3848 end do
3849# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3850 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
3851# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3852 end select
3853# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3854
3855# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3856 y_center = y0_ref
3857# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3858 y_dist = y_cc(j) - y_center
3859# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3860 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
3861# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3862 front_shift = a_param*sin(wave_phase)
3863# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3864
3865# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3866 x_mapped = x_cc(i) - front_shift
3867# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3868
3869# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3870 if (x_mapped <= x_coords(1)) then
3871# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3872 do v = 1, sys_size - 1
3873# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3874 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
3875# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3876 end do
3877# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3878 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3879# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3880 else if (x_mapped >= x_coords(xrows)) then
3881# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3882 do v = 1, sys_size - 1
3883# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3884 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
3885# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3886 end do
3887# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3888 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3889# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3890 else
3891# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3892 idx_lo = 1; idx_hi = xrows
3893# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3894 do while (idx_hi - idx_lo > 1)
3895# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3896 idx_mid = (idx_lo + idx_hi)/2
3897# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3898 if (x_coords(idx_mid) <= x_mapped) then
3899# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3900 idx_lo = idx_mid
3901# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3902 else
3903# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3904 idx_hi = idx_mid
3905# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3906 end if
3907# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3908 end do
3909# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3910
3911# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3912 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
3913# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3914
3915# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3916 do v = 1, sys_size - 1
3917# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3918 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, &
3919# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3920 & v) + interp_wt*stored_values(idx_hi, 1, v)
3921# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3922 end do
3923# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3924 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
3925# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3926 end if
3927# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3928 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
3929# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3930 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
3931# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3932 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
3933# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3934 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
3935# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3936 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 &
3937# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3938 & - y_domain%beg))
3939# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3940 if (x_cc(i) > d) then
3941# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3942 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
3943# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3944 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
3945# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3946 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
3947# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3948 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
3949# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3950 do v = eqn_idx%species%beg, eqn_idx%species%end
3951# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3952 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
3953# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3954 end do
3955# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3956 end if
3957# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3958 case (280) ! Isentropic vortex
3959# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3960 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
3961# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3962 ! geometry 2
3963# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3964 if (patch_id == 1) then
3965# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3966 q_prim_vf(eqn_idx%E)%sf(i, j, &
3967# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3968 & 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) &
3969# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3970 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
3971# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3972 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
3973# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3974 & 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) &
3975# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3976 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
3977# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3978 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
3979# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3980 & 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) &
3981# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3982 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3983# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3984 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
3985# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3986 & 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) &
3987# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3988 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3989# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3990 end if
3991# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3992 case (281) ! Acoustic pulse
3993# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3994 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
3995# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3996 ! geometry 2
3997# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3998 if (patch_id == 2) then
3999# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4000 q_prim_vf(eqn_idx%E)%sf(i, j, &
4001# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4002 & 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))
4003# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4004 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4005# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4006 & 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))
4007# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4008 end if
4009# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4010 case (282) ! Zero-circulation vortex
4011# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4012 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
4013# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4014 ! geometry 2
4015# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4016 if (patch_id == 2) then
4017# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4018 q_prim_vf(eqn_idx%E)%sf(i, j, &
4019# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4020 & 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))
4021# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4022 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
4023# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4024 & 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))
4025# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4026 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
4027# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4028 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4029# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4030 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
4031# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4032 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4033# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4034 end if
4035# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4036 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
4037# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4038 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
4039# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4040 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
4041# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4042 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
4043# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4044 ! patch_icpp(patch_id)%epsilon; defaults to 5.
4045# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4046 if (patch_id == 1) then
4047# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4048 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
4049# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4050 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
4051# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4052 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
4053# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4054 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
4055# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4056 do igq = 1, 3
4057# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4058 do jgq = 1, 3
4059# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4060 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
4061# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4062 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
4063# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4064 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
4065# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4066 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))
4067# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4068 wq = gauss_w(igq)*gauss_w(jgq)
4069# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4070 rhoq = t_facq**1.4_wp
4071# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4072 pq = t_facq**2.4_wp
4073# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4074 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
4075# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4076 & - r2q)
4077# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4078 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
4079# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4080 & - r2q)
4081# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4082 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
4083# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4084 rho_avg = rho_avg + wq*rhoq
4085# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4086 rhou_avg = rhou_avg + wq*(rhoq*uq)
4087# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4088 rhov_avg = rhov_avg + wq*(rhoq*vq)
4089# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4090 e_avg = e_avg + wq*eq
4091# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4092 end do
4093# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4094 end do
4095# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4096 rho_avg = rho_avg*0.25_wp
4097# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4098 rhou_avg = rhou_avg*0.25_wp
4099# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4100 rhov_avg = rhov_avg*0.25_wp
4101# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4102 e_avg = e_avg*0.25_wp
4103# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4104 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
4105# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4106 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
4107# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4108 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
4109# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4110 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
4111# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4112 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
4113# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4114 end if
4115# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4116 case (291) ! Isothermal Flat Plate
4117# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4118 t_inf = 1125.0_wp
4119# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4120 t_wall = 600.0_wp
4121# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4122 p_atm = 101325.0_wp
4123# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4124
4125# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4126 ! Boundary/Shear Layer thicknesses
4127# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4128 delta_th = 0.0003_wp ! Thermal BL thickness
4129# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4130 delta_shear = 8e-3_wp ! Velocity BL thickness
4131# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4132
4133# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4134 u_max = 50.0_wp ! Freestream Velocity (m/s)
4135# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4136
4137# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4138 mw_n2 = 28.0134e-3_wp
4139# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4140 mw_o2 = 31.999e-3_wp
4141# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4142 y_n2 = 0.767_wp
4143# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4144 y_o2 = 0.233_wp
4145# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4146 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
4147# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4148 bottom_blend_u = tanh(y_cc(j)/delta_shear)
4149# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4150 bottom_blend_t = tanh(y_cc(j)/delta_th)
4151# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4152 u_mean = u_max*bottom_blend_u
4153# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4154 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
4155# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4156 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
4157# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4158 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
4159# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4160 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
4161# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4162 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
4163# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4164 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
4165# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4166 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
4167# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4168 case default
4169# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4170 if (proc_rank == 0) then
4171# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4172 call s_int_to_str(patch_id, istr)
4173# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4174 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
4175# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4176 end if
4177# 271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4178 end select
4179# 272 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4180 end if
4181
4182 ! Updating the patch identities bookkeeping variable
4183 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
4184 end if
4185 end do
4186 end do
4187 if (allocated(stored_values)) then
4188# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4189#ifdef MFC_DEBUG
4190# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4191 block
4192# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4193 use iso_fortran_env, only: output_unit
4194# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4195
4196# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4197 print *, 'm_icpp_patches.fpp:279: ', '@:DEALLOCATE(stored_values)'
4198# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4199
4200# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4201 call flush (output_unit)
4202# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4203 end block
4204# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4205#endif
4206# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4207
4208# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4209#if defined(MFC_OpenACC)
4210# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4211!$acc exit data delete(stored_values)
4212# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4213#elif defined(MFC_OpenMP)
4214# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4215!$omp target exit data map(release:stored_values)
4216# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4217#endif
4218# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4219 deallocate (stored_values)
4220# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4221#ifdef MFC_DEBUG
4222# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4223 block
4224# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4225 use iso_fortran_env, only: output_unit
4226# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4227
4228# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4229 print *, 'm_icpp_patches.fpp:279: ', '@:DEALLOCATE(x_coords)'
4230# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4231
4232# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4233 call flush (output_unit)
4234# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4235 end block
4236# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4237#endif
4238# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4239
4240# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4241#if defined(MFC_OpenACC)
4242# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4243!$acc exit data delete(x_coords)
4244# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4245#elif defined(MFC_OpenMP)
4246# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4247!$omp target exit data map(release:x_coords)
4248# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4249#endif
4250# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4251 deallocate (x_coords)
4252# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4253 end if
4254# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4255
4256# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4257 if (allocated(y_coords)) then
4258# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4259#ifdef MFC_DEBUG
4260# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4261 block
4262# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4263 use iso_fortran_env, only: output_unit
4264# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4265
4266# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4267 print *, 'm_icpp_patches.fpp:279: ', '@:DEALLOCATE(y_coords)'
4268# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4269
4270# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4271 call flush (output_unit)
4272# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4273 end block
4274# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4275#endif
4276# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4277
4278# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4279#if defined(MFC_OpenACC)
4280# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4281!$acc exit data delete(y_coords)
4282# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4283#elif defined(MFC_OpenMP)
4284# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4285!$omp target exit data map(release:y_coords)
4286# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4287#endif
4288# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4289 deallocate (y_coords)
4290# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4291 end if
4292# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4293
4294# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4295 files_loaded = .false.
4296# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4297
4298# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4299 if (allocated(stored_values274)) then
4300# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4301#ifdef MFC_DEBUG
4302# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4303 block
4304# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4305 use iso_fortran_env, only: output_unit
4306# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4307
4308# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4309 print *, 'm_icpp_patches.fpp:279: ', '@:DEALLOCATE(stored_values274)'
4310# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4311
4312# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4313 call flush (output_unit)
4314# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4315 end block
4316# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4317#endif
4318# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4319
4320# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4321#if defined(MFC_OpenACC)
4322# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4323!$acc exit data delete(stored_values274)
4324# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4325#elif defined(MFC_OpenMP)
4326# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4327!$omp target exit data map(release:stored_values274)
4328# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4329#endif
4330# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4331 deallocate (stored_values274)
4332# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4333 end if
4334# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4335
4336# 279 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4337 files_loaded274 = .false.
4338# 280 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4339
4340 end subroutine s_icpp_spiral
4341
4342 !> The circular patch is a 2D geometry that may be used, for example, in creating a bubble or a droplet. The geometry of the
4343 !! patch is well-defined when its centroid and radius are provided. Note that the circular patch DOES allow for the smoothing of
4344 !! its boundary.
4345 subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
4346
4347 integer, intent(in) :: patch_id
4348
4349#ifdef MFC_MIXED_PRECISION
4350 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
4351#else
4352 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
4353#endif
4354 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
4355 real(wp) :: radius
4356 integer :: i, j, k !< Generic loop iterators
4357
4358 integer :: xRows, yRows, nRows, iix, iiy, max_files
4359# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4360 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
4361# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4362 real(wp) :: x_step, y_step
4363# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4364 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
4365# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4366 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
4367# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4368 real(wp) :: delta_x, delta_y
4369# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4370 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
4371# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4372 real(wp), allocatable :: stored_values(:,:,:)
4373# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4374 real(wp), allocatable :: x_coords(:), y_coords(:)
4375# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4376 logical :: files_loaded = .false.
4377# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4378 real(wp) :: domain_xstart
4379# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4380 character(len=20) :: file_num_str !< For storing the file number as a string
4381# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4382 integer :: ios
4383# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4384 integer :: ios2
4385# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4386
4387# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4388 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
4389# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4390 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
4391# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4392 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
4393# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4394 ! y_coords/files_loaded above.
4395# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4396 real(wp), allocatable, dimension(:,:,:) :: stored_values274
4397# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4398 logical :: files_loaded274 = .false.
4399# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4400 integer :: f274, ix274, iy274, unit274, ios274
4401# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4402 integer :: local_ix_beg274, local_iy_beg274
4403# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4404 character(len=300) :: fname274
4405# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4406 character(len=20) :: file_num_str274
4407# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4408 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
4409# 299 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4410 real(wp) :: file_dx274, file_dy274, r_align274
4411# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4412 ! Place any declaration of intermediate variables here
4413# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4414 real(wp) :: eps, eps_mhd, C_mhd
4415# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4416 real(wp) :: r, rmax, gam, umax, p0
4417# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4418 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
4419# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4420 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
4421# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4422 real(wp) :: r0, alpha, r2
4423# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4424 real(wp) :: sinA, cosA
4425# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4426 real(wp) :: r_sq
4427# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4428
4429# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4430 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
4431# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4432 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
4433# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4434 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
4435# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4436 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
4437# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4438 integer :: igq, jgq
4439# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4440
4441# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4442 ! # 291 - Shear/Thermal Layer Case
4443# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4444 real(wp) :: delta_shear, u_max, u_mean
4445# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4446 real(wp) :: T_wall, T_inf, P_atm, T_loc
4447# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4448 real(wp) :: delta_th, R_mix
4449# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4450 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
4451# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4452 real(wp) :: bottom_blend_u, bottom_blend_T
4453# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4454
4455# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4456 ! # 207
4457# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4458 real(wp) :: sigma, gauss1, gauss2
4459# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4460
4461# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4462 ! # 208
4463# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4464 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
4465# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4466 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
4467# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4468 integer :: v, idx_lo, idx_hi, idx_mid
4469# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4470 real(wp), parameter :: Ly_param = 0.00775735_wp
4471# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4472 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
4473# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4474 integer, parameter :: Nwaves = 6
4475# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4476 real(wp), parameter :: y0_ref = 0.0_wp
4477# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4478
4479# 300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4480 eps = 1.e-9_wp
4481# 301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4482
4483 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
4484
4485 x_centroid = patch_icpp(patch_id)%x_centroid
4486 y_centroid = patch_icpp(patch_id)%y_centroid
4487 radius = patch_icpp(patch_id)%radius
4488 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
4489 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
4490
4491 ! Initialize eta=1; modified if smoothing is enabled
4492 eta = 1._wp
4493
4494 ! Assign patch vars if cell is covered and patch has write permission
4495
4496 do j = 0, n
4497 do i = 0, m
4498 if (patch_icpp(patch_id)%smoothen) then
4499 ! Smooth Heaviside via hyperbolic tangent; smooth_coeff controls interface sharpness
4500 eta = tanh(smooth_coeff/min(dx_min, &
4501 & dy_min)*(sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2) - radius))*(-0.5_wp) + 0.5_wp
4502 end if
4503
4504 if ((f_is_inside_cylinder(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, radius, &
4505 & 0._wp) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
4506 & 0) == smooth_patch_id) then
4507 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
4508
4509
4510# 329 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4511 if (patch_icpp(patch_id)%hcid /= dflt_int) then
4512 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
4513# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4514 case (200) ! Two-fluid cubic interface
4515# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4516 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
4517# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4518 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
4519# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4520 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
4521# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4522 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
4523# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4524 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
4525# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4526 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
4527# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4528 end if
4529# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4530 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
4531# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4532 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
4533# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4534 rmax = 0.2_wp
4535# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4536
4537# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4538 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
4539# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4540 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
4541# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4542 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
4543# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4544
4545# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4546 if (r < rmax) then
4547# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4548 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
4549# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4550 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
4551# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4552 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
4553# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4554 else if (r < 2*rmax) then
4555# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4556 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4557# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4558 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4559# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4560 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)))
4561# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4562 else
4563# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4564 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
4565# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4566 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
4567# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4568 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
4569# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4570 end if
4571# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4572 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
4573# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4574 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
4575# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4576 rmax = 0.2_wp
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 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
4581# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4582 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
4583# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4584 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
4585# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4586
4587# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4588 if (r < rmax) then
4589# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4590 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
4591# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4592 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
4593# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4594 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
4595# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4596 else if (r < 2*rmax) then
4597# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4598 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4599# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4600 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
4601# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4602 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)))
4603# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4604 else
4605# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4606 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
4607# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4608 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
4609# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4610 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
4611# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4612 end if
4613# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4614
4615# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4616 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
4617# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4618 case (204) ! Rayleigh-Taylor instability
4619# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4620 rhoh = 3._wp
4621# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4622 rhol = 1._wp
4623# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4624 pref = 1.e5_wp
4625# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4626 pint = pref
4627# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4628 h = 0.7_wp
4629# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4630 lam = 0.2_wp
4631# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4632 wl = 2._wp*pi/lam
4633# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4634 amp = 0.05_wp/wl
4635# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4636
4637# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4638 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
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 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
4643# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4644
4645# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4646 if (alph < eps) alph = eps
4647# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4648 if (alph > 1._wp - eps) alph = 1._wp - eps
4649# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4650
4651# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4652 if (y_cc(j) > inth) then
4653# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4654 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4655# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4656 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4657# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4658 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4659# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4660 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4661# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4662 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
4663# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4664 else
4665# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4666 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
4667# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4668 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
4669# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4670 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
4671# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4672 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
4673# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4674 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
4675# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4676 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
4677# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4678 end if
4679# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4680 case (205) ! 2D lung wave interaction problem
4681# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4682 h = 0.0_wp ! non dim origin y
4683# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4684 lam = 1.0_wp ! non dim lambda
4685# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4686 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
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 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
4691# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4692
4693# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4694 if (y_cc(j) > inth) then
4695# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4696 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4697# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4698 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4699# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4700 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4701# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4702 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4703# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4704 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4705# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4706 end if
4707# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4708 case (206) ! 2D lung wave interaction problem - horizontal domain
4709# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4710 h = 0.0_wp ! non dim origin y
4711# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4712 lam = 1.0_wp ! non dim lambda
4713# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4714 amp = patch_icpp(patch_id)%a(2)
4715# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4716
4717# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4718 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
4719# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4720
4721# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4722 if (x_cc(i) > intl) then ! this is the liquid
4723# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4724 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4725# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4726 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4727# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4728 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
4729# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4730 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4731# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4732 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4733# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4734 end if
4735# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4736 case (207) ! Kelvin Helmholtz Instability
4737# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4738 sigma = 0.05_wp/sqrt(2.0_wp)
4739# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4740 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
4741# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4742 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
4743# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4744 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)
4745# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4746 case (208) ! Richtmeyer Meshkov Instability
4747# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4748 lam = 1.0_wp
4749# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4750 eps = 1.0e-6_wp
4751# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4752 ei = 5.0_wp
4753# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4754 ! Smoothening function to smooth out sharp discontinuity in the interface
4755# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4756 if (x_cc(i) <= 0.7_wp*lam) then
4757# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4758 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
4759# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4760 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
4761# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4762 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
4763# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4764 alpha_sf6 = 1.0_wp - alpha_air
4765# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4766 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
4767# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4768 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
4769# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4770 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
4771# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4772 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
4773# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4774 end if
4775# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4776 case (250) ! MHD Orszag-Tang vortex
4777# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4778 ! 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),
4779# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4780 ! sin(4*pi*x)/sqrt(4*pi), 0)
4781# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4782
4783# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4784 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
4785# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4786 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
4787# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4788
4789# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4790 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
4791# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4792 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
4793# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4794 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
4795# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4796 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
4797# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4798 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
4799# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4800 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
4801# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4802 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
4803# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4804 ! Linear interpolation between r=0.08 and r=1.0
4805# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4806 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
4807# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4808 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
4809# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4810 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
4811# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4812 else
4813# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4814 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
4815# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4816 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
4817# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4818 end if
4819# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4820
4821# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4822 ! case 252 is for the 2D MHD Rotor problem
4823# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4824 case (252) ! 2D MHD Rotor Problem
4825# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4826 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
4827# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4828 !
4829# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4830 ! 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
4831# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4832 ! velocity w=20, giving v_tan=2 at r=0.1
4833# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4834
4835# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4836 ! Calculate distance squared from the center
4837# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4838 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
4839# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4840
4841# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4842 ! inner radius of 0.1
4843# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4844 if (r_sq <= 0.1**2) then
4845# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4846 ! -- Inside the rotor -- Set density uniformly to 10
4847# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4848 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
4849# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4850
4851# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4852 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
4853# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4854 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
4855# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4856 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
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 ! taper width of 0.015
4861# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4862 else if (r_sq <= 0.115**2) then
4863# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4864 ! linearly smooth the function between r = 0.1 and 0.115
4865# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4866 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
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 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)
4871# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4872 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)
4873# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4874 end if
4875# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4876 case (253) ! MHD Smooth Magnetic Vortex
4877# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4878 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
4879# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4880 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
4881# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4882
4883# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4884 ! velocity
4885# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4886 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))
4887# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4888 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))
4889# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4890
4891# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4892 ! magnetic field
4893# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4894 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)
4895# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4896 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)
4897# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4898
4899# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4900 ! pressure
4901# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4902 q_prim_vf(eqn_idx%E)%sf(i, j, &
4903# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4904 & 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)
4905# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4906 case (260) ! Gaussian Divergence Pulse
4907# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4908 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
4909# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4910 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
4911# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4912 ! initialized to zero everywhere.
4913# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4914
4915# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4916 eps_mhd = patch_icpp(patch_id)%a(2)
4917# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4918 sigma = patch_icpp(patch_id)%a(3)
4919# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4920 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
4921# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4922
4923# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4924 ! B-field
4925# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4926 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
4927# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4928 case (261) ! Blob
4929# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4930 r0 = 1._wp/sqrt(8._wp)
4931# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4932 r2 = x_cc(i)**2 + y_cc(j)**2
4933# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4934 r = sqrt(r2)
4935# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4936 alpha = r/r0
4937# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4938 if (alpha < 1) then
4939# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4940 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)
4941# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4942 end if
4943# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4944 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
4945# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4946 ! rotate by \alpha = atan(2)
4947# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4948 alpha = atan(2._wp)
4949# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4950 cosa = cos(alpha)
4951# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4952 sina = sin(alpha)
4953# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4954 ! projection along shock normal
4955# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4956 r = x_cc(i)*cosa + y_cc(j)*sina
4957# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4958
4959# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4960 if (r <= 0.5_wp) then
4961# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4962 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
4963# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4964 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4965# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4966 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
4967# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4968 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
4969# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4970 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
4971# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4972 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
4973# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4974 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
4975# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4976 else
4977# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4978 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
4979# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4980 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
4981# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4982 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
4983# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4984 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
4985# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4986 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
4987# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4988 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
4989# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4990 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
4991# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4992 end if
4993# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4994 ! v^z and B^z remain zero by default
4995# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4996 case (270) ! 2D extrusion of 1D profile from external data
4997# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4998 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
4999# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5000 if (.not. files_loaded) then
5001# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5002 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5003# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5004 do f = 1, max_files
5005# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5006 write (file_num_str, '(I0)') f
5007# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5008 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
5009# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5010 end do
5011# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5012
5013# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5014 ! Common file reading setup
5015# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5016 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5017# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5018 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
5019# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5020
5021# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5022 select case (num_dims)
5023# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5024 case (1, 2) ! 1D and 2D cases are similar
5025# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5026 ! Count lines
5027# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5028 line_count = 0
5029# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5030 do
5031# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5032 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5033# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5034 if (ios2 /= 0) exit
5035# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5036 line_count = line_count + 1
5037# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5038 end do
5039# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5040 close (unit2)
5041# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5042
5043# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5044 xrows = line_count
5045# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5046 yrows = 1
5047# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5048 index_x = 0
5049# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5050 if (num_dims == 2) index_x = i
5051# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5052#ifdef MFC_DEBUG
5053# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5054 block
5055# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5056 use iso_fortran_env, only: output_unit
5057# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5058
5059# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5060 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5061# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5062
5063# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5064 call flush (output_unit)
5065# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5066 end block
5067# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5068#endif
5069# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5070 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5071# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5072
5073# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5074
5075# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5076
5077# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5078#if defined(MFC_OpenACC)
5079# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5080!$acc enter data create(x_coords, stored_values)
5081# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5082#elif defined(MFC_OpenMP)
5083# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5084!$omp target enter data map(always,alloc:x_coords, stored_values)
5085# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5086#endif
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 ! Read data from all files
5091# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5092 do f = 1, max_files
5093# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5094 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5095# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5096 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5097# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5098
5099# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5100 do iter = 1, xrows
5101# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5102 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5103# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5104 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
5105# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5106 end do
5107# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5108 close (unit)
5109# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5110 end do
5111# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5112
5113# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5114 ! Calculate offsets
5115# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5116 domain_xstart = x_coords(1)
5117# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5118 x_step = x_cc(1) - x_cc(0)
5119# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5120 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
5121# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5122 global_offset_x = nint(abs(delta_x)/x_step)
5123# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5124 case (3) ! 3D case - determine grid structure
5125# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5126 ! Find yRows by counting rows with same x
5127# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5128 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5129# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5130 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5131# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5132
5133# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5134 yrows = 1
5135# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5136 do
5137# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5138 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5139# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5140 if (ios2 /= 0) exit
5141# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5142 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
5143# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5144 yrows = yrows + 1
5145# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5146 else
5147# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5148 exit
5149# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5150 end if
5151# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5152 end do
5153# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5154 close (unit2)
5155# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5156
5157# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5158 ! Count total rows
5159# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5160 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5161# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5162 nrows = 0
5163# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5164 do
5165# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5166 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5167# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5168 if (ios2 /= 0) exit
5169# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5170 nrows = nrows + 1
5171# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5172 end do
5173# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5174 close (unit2)
5175# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5176
5177# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5178 xrows = nrows/yrows
5179# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5180#ifdef MFC_DEBUG
5181# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5182 block
5183# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5184 use iso_fortran_env, only: output_unit
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 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5189# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5190
5191# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5192 call flush (output_unit)
5193# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5194 end block
5195# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5196#endif
5197# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5198 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5199# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5200
5201# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5202
5203# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5204
5205# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5206
5207# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5208#if defined(MFC_OpenACC)
5209# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5210!$acc enter data create(x_coords, y_coords, stored_values)
5211# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5212#elif defined(MFC_OpenMP)
5213# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5214!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5215# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5216#endif
5217# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5218 index_x = i
5219# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5220 index_y = j
5221# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5222
5223# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5224 ! Read all files
5225# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5226 do f = 1, max_files
5227# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5228 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5229# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5230 if (ios /= 0) then
5231# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5232 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5233# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5234 cycle
5235# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5236 end if
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 iter = 0
5241# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5242 do iix = 1, xrows
5243# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5244 do iiy = 1, yrows
5245# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5246 iter = iter + 1
5247# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5248 if (f == 1) then
5249# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5250 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5251# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5252 else
5253# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5254 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5255# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5256 end if
5257# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5258 if (ios /= 0) call s_mpi_abort("Error reading data")
5259# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5260 end do
5261# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5262 end do
5263# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5264 close (unit)
5265# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5266 end do
5267# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5268
5269# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5270 ! Calculate offsets
5271# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5272 x_step = x_cc(1) - x_cc(0)
5273# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5274 y_step = y_cc(1) - y_cc(0)
5275# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5276 delta_x = x_cc(index_x) - x_coords(1)
5277# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5278 delta_y = y_cc(index_y) - y_coords(1)
5279# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5280 global_offset_x = nint(abs(delta_x)/x_step)
5281# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5282 global_offset_y = nint(abs(delta_y)/y_step)
5283# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5284
5285# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5286 ! The index check below only catches overruns, so a file that is merely too
5287# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5288 ! FINE stays in range and silently supplies a corner of itself. Check spacing
5289# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5290 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
5291# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5292 ! consecutive x values sit yRows apart.
5293# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5294 if (nrows > yrows) then
5295# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5296 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
5297# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5298 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
5299# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5300 end if
5301# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5302 if (yrows > 1) then
5303# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5304 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
5305# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5306 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
5307# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5308 end if
5309# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5310 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
5311# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5312 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
5313# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5314 & wp)) > 1.e-6_wp) &
5315# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5316 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
5317# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5318 end select
5319# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5320
5321# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5322 files_loaded = .true.
5323# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5324 end if
5325# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5326
5327# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5328 ! Data assignment
5329# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5330 select case (num_dims)
5331# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5332 case (1)
5333# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5334 idx = i + 1 + global_offset_x
5335# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5336 ! idx must land inside the file's row range: this rank's subdomain offset
5337# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5338 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
5339# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5340 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
5341# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5342 if (idx < 1 .or. idx > xrows) &
5343# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5344 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
5345# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5346 do f = 1, sys_size
5347# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5348 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5349# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5350 end do
5351# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5352 case (2)
5353# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5354 idx = i + 1 + global_offset_x - index_x
5355# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5356 if (idx < 1 .or. idx > xrows) &
5357# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5358 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
5359# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5360 do f = 1, sys_size - 1
5361# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5362 jump = merge(1, 0, f >= eqn_idx%mom%end)
5363# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5364 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5365# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5366 end do
5367# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5368 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
5369# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5370 case (3)
5371# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5372 idx = i + 1 + global_offset_x - index_x
5373# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5374 idy = j + 1 + global_offset_y - index_y
5375# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5376 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
5377# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5378 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
5379# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5380 do f = 1, sys_size - 1
5381# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5382 jump = merge(1, 0, f >= eqn_idx%mom%end)
5383# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5384 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5385# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5386 end do
5387# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5388 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
5389# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5390 end select
5391# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5392 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
5393# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5394 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
5395# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5396 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
5397# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5398 ! cross-stream-position profile (real cross-stream velocity is legitimately
5399# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5400 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
5401# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5402 ! zero out mom%beg's true physical value.
5403# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5404 if (.not. files_loaded) then
5405# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5406 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5407# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5408 do f = 1, max_files
5409# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5410 write (file_num_str, '(I0)') f
5411# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5412 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
5413# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5414 end do
5415# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5416
5417# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5418 ! Common file reading setup
5419# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5420 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5421# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5422 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
5423# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5424
5425# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5426 select case (num_dims)
5427# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5428 case (1, 2) ! 1D and 2D cases are similar
5429# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5430 ! Count lines
5431# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5432 line_count = 0
5433# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5434 do
5435# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5436 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5437# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5438 if (ios2 /= 0) exit
5439# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5440 line_count = line_count + 1
5441# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5442 end do
5443# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5444 close (unit2)
5445# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5446
5447# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5448 xrows = line_count
5449# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5450 yrows = 1
5451# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5452 index_x = 0
5453# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5454 if (num_dims == 2) index_x = i
5455# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5456#ifdef MFC_DEBUG
5457# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5458 block
5459# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5460 use iso_fortran_env, only: output_unit
5461# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5462
5463# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5464 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5465# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5466
5467# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5468 call flush (output_unit)
5469# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5470 end block
5471# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5472#endif
5473# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5474 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5475# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5476
5477# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5478
5479# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5480
5481# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5482#if defined(MFC_OpenACC)
5483# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5484!$acc enter data create(x_coords, stored_values)
5485# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5486#elif defined(MFC_OpenMP)
5487# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5488!$omp target enter data map(always,alloc:x_coords, stored_values)
5489# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5490#endif
5491# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5492
5493# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5494 ! Read data from all files
5495# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5496 do f = 1, max_files
5497# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5498 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5499# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5500 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5501# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5502
5503# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5504 do iter = 1, xrows
5505# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5506 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5507# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5508 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
5509# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5510 end do
5511# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5512 close (unit)
5513# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5514 end do
5515# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5516
5517# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5518 ! Calculate offsets
5519# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5520 domain_xstart = x_coords(1)
5521# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5522 x_step = x_cc(1) - x_cc(0)
5523# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5524 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
5525# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5526 global_offset_x = nint(abs(delta_x)/x_step)
5527# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5528 case (3) ! 3D case - determine grid structure
5529# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5530 ! Find yRows by counting rows with same x
5531# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5532 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5533# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5534 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5535# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5536
5537# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5538 yrows = 1
5539# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5540 do
5541# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5542 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5543# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5544 if (ios2 /= 0) exit
5545# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5546 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
5547# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5548 yrows = yrows + 1
5549# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5550 else
5551# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5552 exit
5553# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5554 end if
5555# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5556 end do
5557# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5558 close (unit2)
5559# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5560
5561# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5562 ! Count total rows
5563# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5564 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5565# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5566 nrows = 0
5567# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5568 do
5569# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5570 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5571# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5572 if (ios2 /= 0) exit
5573# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5574 nrows = nrows + 1
5575# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5576 end do
5577# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5578 close (unit2)
5579# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5580
5581# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5582 xrows = nrows/yrows
5583# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5584#ifdef MFC_DEBUG
5585# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5586 block
5587# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5588 use iso_fortran_env, only: output_unit
5589# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5590
5591# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5592 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5593# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5594
5595# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5596 call flush (output_unit)
5597# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5598 end block
5599# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5600#endif
5601# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5602 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
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
5607# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5608
5609# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5610
5611# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5612#if defined(MFC_OpenACC)
5613# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5614!$acc enter data create(x_coords, y_coords, stored_values)
5615# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5616#elif defined(MFC_OpenMP)
5617# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5618!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5619# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5620#endif
5621# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5622 index_x = i
5623# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5624 index_y = j
5625# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5626
5627# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5628 ! Read all files
5629# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5630 do f = 1, max_files
5631# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5632 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5633# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5634 if (ios /= 0) then
5635# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5636 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
5637# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5638 cycle
5639# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5640 end if
5641# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5642
5643# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5644 iter = 0
5645# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5646 do iix = 1, xrows
5647# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5648 do iiy = 1, yrows
5649# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5650 iter = iter + 1
5651# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5652 if (f == 1) then
5653# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5654 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5655# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5656 else
5657# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5658 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5659# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5660 end if
5661# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5662 if (ios /= 0) call s_mpi_abort("Error reading data")
5663# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5664 end do
5665# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5666 end do
5667# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5668 close (unit)
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
5673# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5674 ! Calculate offsets
5675# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5676 x_step = x_cc(1) - x_cc(0)
5677# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5678 y_step = y_cc(1) - y_cc(0)
5679# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5680 delta_x = x_cc(index_x) - x_coords(1)
5681# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5682 delta_y = y_cc(index_y) - y_coords(1)
5683# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5684 global_offset_x = nint(abs(delta_x)/x_step)
5685# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5686 global_offset_y = nint(abs(delta_y)/y_step)
5687# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5688
5689# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5690 ! The index check below only catches overruns, so a file that is merely too
5691# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5692 ! FINE stays in range and silently supplies a corner of itself. Check spacing
5693# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5694 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
5695# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5696 ! consecutive x values sit yRows apart.
5697# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5698 if (nrows > yrows) then
5699# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5700 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
5701# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5702 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
5703# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5704 end if
5705# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5706 if (yrows > 1) then
5707# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5708 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
5709# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5710 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
5711# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5712 end if
5713# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5714 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
5715# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5716 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
5717# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5718 & wp)) > 1.e-6_wp) &
5719# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5720 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
5721# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5722 end select
5723# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5724
5725# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5726 files_loaded = .true.
5727# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5728 end if
5729# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5730
5731# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5732 ! Data assignment
5733# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5734 select case (num_dims)
5735# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5736 case (1)
5737# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5738 idx = i + 1 + global_offset_x
5739# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5740 ! idx must land inside the file's row range: this rank's subdomain offset
5741# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5742 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
5743# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5744 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
5745# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5746 if (idx < 1 .or. idx > xrows) &
5747# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5748 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
5749# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5750 do f = 1, sys_size
5751# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5752 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
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 case (2)
5757# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5758 idx = i + 1 + global_offset_x - index_x
5759# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5760 if (idx < 1 .or. idx > xrows) &
5761# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5762 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
5763# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5764 do f = 1, sys_size - 1
5765# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5766 jump = merge(1, 0, f >= eqn_idx%mom%end)
5767# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5768 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5769# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5770 end do
5771# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5772 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
5773# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5774 case (3)
5775# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5776 idx = i + 1 + global_offset_x - index_x
5777# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5778 idy = j + 1 + global_offset_y - index_y
5779# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5780 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
5781# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5782 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
5783# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5784 do f = 1, sys_size - 1
5785# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5786 jump = merge(1, 0, f >= eqn_idx%mom%end)
5787# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5788 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5789# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5790 end do
5791# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5792 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
5793# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5794 end select
5795# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5796 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
5797# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5798 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
5799# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5800 case (274) ! Full 2D field from external data (no extrusion)
5801# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5802 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
5803# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5804 ! extrusion direction and no zeroed component -- all sys_size variables are read and
5805# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5806 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
5807# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5808 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
5809# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5810 ! global grid exactly -- by construction, since the IC generator derives both the
5811# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5812 ! grid and the file contents from the same computation.
5813# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5814 !
5815# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5816 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
5817# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5818 ! file's own first coordinate and this rank's uniform grid spacing -- following the
5819# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5820 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
5821# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5822 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
5823# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5824 ! returns before allocating it otherwise), so a serial-IO run (the default for
5825# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5826 ! golden-file tests) would index into an unallocated array.
5827# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5828 !
5829# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5830 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
5831# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5832 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
5833# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5834 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
5835# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5836 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
5837# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5838 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
5839# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5840 ! global cell offset) are pinned from f274==1's very first record, before any other
5841# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5842 ! record is read, so every subsequent record -- across all variables -- can be tested
5843# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5844 ! against this rank's range and dropped if it falls outside it.
5845# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5846 x_step274 = x_cc(1) - x_cc(0)
5847# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5848 y_step274 = y_cc(1) - y_cc(0)
5849# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5850
5851# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5852 if (.not. files_loaded274) then
5853# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5854#ifdef MFC_DEBUG
5855# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5856 block
5857# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5858 use iso_fortran_env, only: output_unit
5859# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5860
5861# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5862 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
5863# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5864
5865# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5866 call flush (output_unit)
5867# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5868 end block
5869# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5870#endif
5871# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5872 allocate (stored_values274(0:m, 0:n, sys_size))
5873# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5874
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#if defined(MFC_OpenACC)
5879# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5880!$acc enter data create(stored_values274)
5881# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5882#elif defined(MFC_OpenMP)
5883# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5884!$omp target enter data map(always,alloc:stored_values274)
5885# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5886#endif
5887# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5888 do f274 = 1, sys_size
5889# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5890 write (file_num_str274, '(I0)') f274
5891# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5892 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
5893# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5894 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
5895# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5896 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
5897# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5898 do ix274 = 0, m_glb
5899# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5900 do iy274 = 0, n_glb
5901# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5902 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
5903# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5904 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
5905# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5906 ! Capture the file's own origin and spacing from its first records so we can
5907# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5908 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
5909# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5910 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
5911# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5912 if (f274 == 1) then
5913# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5914 if (ix274 == 0 .and. iy274 == 0) then
5915# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5916 x0_274 = dummy_x274
5917# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5918 y0_274 = dummy_y274
5919# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5920 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
5921# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5922 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
5923# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5924 end if
5925# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5926 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
5927# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5928 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
5929# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5930 end if
5931# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5932 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
5933# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5934 & .and. iy274 - local_iy_beg274 <= n) then
5935# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5936 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
5937# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5938 end if
5939# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5940 end do
5941# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5942 end do
5943# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5944 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
5945# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5946 ! read means it was generated for a larger grid and would be silently misread.
5947# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5948 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
5949# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5950 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
5951# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5952 close (unit274)
5953# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5954 end do
5955# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5956
5957# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5958 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
5959# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5960 ! Check alignment via the integer cell offset of this rank's first cell from the file
5961# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5962 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
5963# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5964 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
5965# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5966 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
5967# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5968 ! the global origin.) The spacing checks below must also hold.
5969# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5970 r_align274 = (x_cc(0) - x0_274)/x_step274
5971# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5972 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
5973# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5974 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
5975# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5976 if (m_glb >= 1) then
5977# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5978 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
5979# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5980 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
5981# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5982 end if
5983# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5984 if (n_glb >= 1) then
5985# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5986 r_align274 = (y_cc(0) - y0_274)/y_step274
5987# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5988 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
5989# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5990 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
5991# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5992 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
5993# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5994 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
5995# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5996 end if
5997# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5998
5999# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6000 files_loaded274 = .true.
6001# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6002 end if
6003# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6004 ! Alignment is verified above (or this rank would already have aborted), so the local
6005# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6006 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
6007# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6008 do f274 = 1, sys_size
6009# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6010 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
6011# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6012 end do
6013# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6014 case (271) ! Premixed Flame Vortices Interaction
6015# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6016 if (.not. files_loaded) then
6017# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6018 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6019# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6020 do f = 1, max_files
6021# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6022 write (file_num_str, '(I0)') f
6023# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6024 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
6025# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6026 end do
6027# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6028
6029# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6030 ! Common file reading setup
6031# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6032 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6033# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6034 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
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 select case (num_dims)
6039# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6040 case (1, 2) ! 1D and 2D cases are similar
6041# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6042 ! Count lines
6043# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6044 line_count = 0
6045# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6046 do
6047# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6048 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6049# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6050 if (ios2 /= 0) exit
6051# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6052 line_count = line_count + 1
6053# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6054 end do
6055# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6056 close (unit2)
6057# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6058
6059# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6060 xrows = line_count
6061# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6062 yrows = 1
6063# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6064 index_x = 0
6065# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6066 if (num_dims == 2) index_x = i
6067# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6068#ifdef MFC_DEBUG
6069# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6070 block
6071# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6072 use iso_fortran_env, only: output_unit
6073# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6074
6075# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6076 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
6077# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6078
6079# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6080 call flush (output_unit)
6081# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6082 end block
6083# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6084#endif
6085# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6086 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6087# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6088
6089# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6090
6091# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6092
6093# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6094#if defined(MFC_OpenACC)
6095# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6096!$acc enter data create(x_coords, stored_values)
6097# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6098#elif defined(MFC_OpenMP)
6099# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6100!$omp target enter data map(always,alloc:x_coords, stored_values)
6101# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6102#endif
6103# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6104
6105# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6106 ! Read data from all files
6107# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6108 do f = 1, max_files
6109# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6110 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6111# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6112 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6113# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6114
6115# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6116 do iter = 1, xrows
6117# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6118 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6119# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6120 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
6121# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6122 end do
6123# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6124 close (unit)
6125# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6126 end do
6127# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6128
6129# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6130 ! Calculate offsets
6131# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6132 domain_xstart = x_coords(1)
6133# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6134 x_step = x_cc(1) - x_cc(0)
6135# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6136 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
6137# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6138 global_offset_x = nint(abs(delta_x)/x_step)
6139# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6140 case (3) ! 3D case - determine grid structure
6141# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6142 ! Find yRows by counting rows with same x
6143# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6144 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6145# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6146 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
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 yrows = 1
6151# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6152 do
6153# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6154 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6155# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6156 if (ios2 /= 0) exit
6157# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6158 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
6159# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6160 yrows = yrows + 1
6161# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6162 else
6163# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6164 exit
6165# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6166 end if
6167# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6168 end do
6169# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6170 close (unit2)
6171# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6172
6173# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6174 ! Count total rows
6175# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6176 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6177# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6178 nrows = 0
6179# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6180 do
6181# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6182 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6183# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6184 if (ios2 /= 0) exit
6185# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6186 nrows = nrows + 1
6187# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6188 end do
6189# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6190 close (unit2)
6191# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6192
6193# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6194 xrows = nrows/yrows
6195# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6196#ifdef MFC_DEBUG
6197# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6198 block
6199# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6200 use iso_fortran_env, only: output_unit
6201# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6202
6203# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6204 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6205# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6206
6207# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6208 call flush (output_unit)
6209# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6210 end block
6211# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6212#endif
6213# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6214 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6215# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6216
6217# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6218
6219# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6220
6221# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6222
6223# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6224#if defined(MFC_OpenACC)
6225# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6226!$acc enter data create(x_coords, y_coords, stored_values)
6227# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6228#elif defined(MFC_OpenMP)
6229# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6230!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6231# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6232#endif
6233# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6234 index_x = i
6235# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6236 index_y = j
6237# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6238
6239# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6240 ! Read all files
6241# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6242 do f = 1, max_files
6243# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6244 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6245# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6246 if (ios /= 0) then
6247# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6248 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6249# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6250 cycle
6251# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6252 end if
6253# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6254
6255# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6256 iter = 0
6257# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6258 do iix = 1, xrows
6259# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6260 do iiy = 1, yrows
6261# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6262 iter = iter + 1
6263# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6264 if (f == 1) then
6265# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6266 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6267# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6268 else
6269# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6270 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6271# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6272 end if
6273# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6274 if (ios /= 0) call s_mpi_abort("Error reading data")
6275# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6276 end do
6277# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6278 end do
6279# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6280 close (unit)
6281# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6282 end do
6283# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6284
6285# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6286 ! Calculate offsets
6287# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6288 x_step = x_cc(1) - x_cc(0)
6289# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6290 y_step = y_cc(1) - y_cc(0)
6291# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6292 delta_x = x_cc(index_x) - x_coords(1)
6293# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6294 delta_y = y_cc(index_y) - y_coords(1)
6295# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6296 global_offset_x = nint(abs(delta_x)/x_step)
6297# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6298 global_offset_y = nint(abs(delta_y)/y_step)
6299# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6300
6301# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6302 ! The index check below only catches overruns, so a file that is merely too
6303# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6304 ! FINE stays in range and silently supplies a corner of itself. Check spacing
6305# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6306 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
6307# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6308 ! consecutive x values sit yRows apart.
6309# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6310 if (nrows > yrows) then
6311# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6312 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
6313# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6314 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
6315# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6316 end if
6317# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6318 if (yrows > 1) then
6319# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6320 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
6321# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6322 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
6323# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6324 end if
6325# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6326 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
6327# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6328 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
6329# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6330 & wp)) > 1.e-6_wp) &
6331# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6332 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
6333# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6334 end select
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 files_loaded = .true.
6339# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6340 end if
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 ! Data assignment
6345# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6346 select case (num_dims)
6347# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6348 case (1)
6349# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6350 idx = i + 1 + global_offset_x
6351# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6352 ! idx must land inside the file's row range: this rank's subdomain offset
6353# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6354 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
6355# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6356 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
6357# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6358 if (idx < 1 .or. idx > xrows) &
6359# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6360 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
6361# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6362 do f = 1, sys_size
6363# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6364 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6365# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6366 end do
6367# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6368 case (2)
6369# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6370 idx = i + 1 + global_offset_x - index_x
6371# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6372 if (idx < 1 .or. idx > xrows) &
6373# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6374 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
6375# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6376 do f = 1, sys_size - 1
6377# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6378 jump = merge(1, 0, f >= eqn_idx%mom%end)
6379# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6380 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6381# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6382 end do
6383# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6384 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6385# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6386 case (3)
6387# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6388 idx = i + 1 + global_offset_x - index_x
6389# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6390 idy = j + 1 + global_offset_y - index_y
6391# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6392 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
6393# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6394 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
6395# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6396 do f = 1, sys_size - 1
6397# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6398 jump = merge(1, 0, f >= eqn_idx%mom%end)
6399# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6400 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
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 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
6405# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6406 end select
6407# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6408 x1c = 0.0027_wp
6409# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6410 y1c = 0.005_wp
6411# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6412 x2c = 0.0027_wp
6413# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6414 y2c = 0.003_wp
6415# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6416 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
6417# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6418 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
6419# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6420 rvortex = 0.0005_wp
6421# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6422 cvortex = 6000.0_wp
6423# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6424
6425# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6426 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
6427# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6428 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
6429# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6430
6431# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6432 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
6433# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6434 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
6435# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6436 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
6437# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6438 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
6439# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6440 case (272) ! Premixed Flame Instability
6441# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6442 if (.not. files_loaded) then
6443# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6444 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6445# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6446 do f = 1, max_files
6447# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6448 write (file_num_str, '(I0)') f
6449# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6450 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
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
6455# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6456 ! Common file reading setup
6457# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6458 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6459# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6460 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
6461# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6462
6463# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6464 select case (num_dims)
6465# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6466 case (1, 2) ! 1D and 2D cases are similar
6467# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6468 ! Count lines
6469# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6470 line_count = 0
6471# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6472 do
6473# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6474 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6475# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6476 if (ios2 /= 0) exit
6477# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6478 line_count = line_count + 1
6479# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6480 end do
6481# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6482 close (unit2)
6483# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6484
6485# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6486 xrows = line_count
6487# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6488 yrows = 1
6489# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6490 index_x = 0
6491# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6492 if (num_dims == 2) index_x = i
6493# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6494#ifdef MFC_DEBUG
6495# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6496 block
6497# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6498 use iso_fortran_env, only: output_unit
6499# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6500
6501# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6502 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
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 call flush (output_unit)
6507# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6508 end block
6509# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6510#endif
6511# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6512 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6513# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6514
6515# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6516
6517# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6518
6519# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6520#if defined(MFC_OpenACC)
6521# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6522!$acc enter data create(x_coords, stored_values)
6523# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6524#elif defined(MFC_OpenMP)
6525# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6526!$omp target enter data map(always,alloc:x_coords, stored_values)
6527# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6528#endif
6529# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6530
6531# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6532 ! Read data from all files
6533# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6534 do f = 1, max_files
6535# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6536 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6537# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6538 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6539# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6540
6541# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6542 do iter = 1, xrows
6543# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6544 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6545# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6546 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
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 close (unit)
6551# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6552 end do
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 ! Calculate offsets
6557# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6558 domain_xstart = x_coords(1)
6559# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6560 x_step = x_cc(1) - x_cc(0)
6561# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6562 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
6563# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6564 global_offset_x = nint(abs(delta_x)/x_step)
6565# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6566 case (3) ! 3D case - determine grid structure
6567# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6568 ! Find yRows by counting rows with same x
6569# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6570 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6571# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6572 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
6573# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6574
6575# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6576 yrows = 1
6577# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6578 do
6579# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6580 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6581# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6582 if (ios2 /= 0) exit
6583# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6584 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
6585# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6586 yrows = yrows + 1
6587# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6588 else
6589# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6590 exit
6591# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6592 end if
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 close (unit2)
6597# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6598
6599# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6600 ! Count total rows
6601# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6602 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6603# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6604 nrows = 0
6605# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6606 do
6607# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6608 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6609# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6610 if (ios2 /= 0) exit
6611# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6612 nrows = nrows + 1
6613# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6614 end do
6615# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6616 close (unit2)
6617# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6618
6619# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6620 xrows = nrows/yrows
6621# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6622#ifdef MFC_DEBUG
6623# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6624 block
6625# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6626 use iso_fortran_env, only: output_unit
6627# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6628
6629# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6630 print *, 'm_icpp_patches.fpp:330: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6631# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6632
6633# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6634 call flush (output_unit)
6635# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6636 end block
6637# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6638#endif
6639# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6640 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6641# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6642
6643# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6644
6645# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6646
6647# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6648
6649# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6650#if defined(MFC_OpenACC)
6651# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6652!$acc enter data create(x_coords, y_coords, stored_values)
6653# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6654#elif defined(MFC_OpenMP)
6655# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6656!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6657# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6658#endif
6659# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6660 index_x = i
6661# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6662 index_y = j
6663# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6664
6665# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6666 ! Read all files
6667# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6668 do f = 1, max_files
6669# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6670 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6671# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6672 if (ios /= 0) then
6673# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6674 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
6675# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6676 cycle
6677# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6678 end if
6679# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6680
6681# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6682 iter = 0
6683# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6684 do iix = 1, xrows
6685# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6686 do iiy = 1, yrows
6687# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6688 iter = iter + 1
6689# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6690 if (f == 1) then
6691# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6692 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6693# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6694 else
6695# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6696 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6697# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6698 end if
6699# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6700 if (ios /= 0) call s_mpi_abort("Error reading data")
6701# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6702 end do
6703# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6704 end do
6705# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6706 close (unit)
6707# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6708 end do
6709# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6710
6711# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6712 ! Calculate offsets
6713# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6714 x_step = x_cc(1) - x_cc(0)
6715# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6716 y_step = y_cc(1) - y_cc(0)
6717# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6718 delta_x = x_cc(index_x) - x_coords(1)
6719# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6720 delta_y = y_cc(index_y) - y_coords(1)
6721# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6722 global_offset_x = nint(abs(delta_x)/x_step)
6723# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6724 global_offset_y = nint(abs(delta_y)/y_step)
6725# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6726
6727# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6728 ! The index check below only catches overruns, so a file that is merely too
6729# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6730 ! FINE stays in range and silently supplies a corner of itself. Check spacing
6731# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6732 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
6733# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6734 ! consecutive x values sit yRows apart.
6735# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6736 if (nrows > yrows) then
6737# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6738 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
6739# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6740 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
6741# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6742 end if
6743# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6744 if (yrows > 1) then
6745# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6746 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
6747# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6748 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
6749# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6750 end if
6751# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6752 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
6753# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6754 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
6755# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6756 & wp)) > 1.e-6_wp) &
6757# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6758 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
6759# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6760 end select
6761# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6762
6763# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6764 files_loaded = .true.
6765# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6766 end if
6767# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6768
6769# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6770 ! Data assignment
6771# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6772 select case (num_dims)
6773# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6774 case (1)
6775# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6776 idx = i + 1 + global_offset_x
6777# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6778 ! idx must land inside the file's row range: this rank's subdomain offset
6779# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6780 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
6781# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6782 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
6783# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6784 if (idx < 1 .or. idx > xrows) &
6785# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6786 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
6787# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6788 do f = 1, sys_size
6789# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6790 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6791# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6792 end do
6793# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6794 case (2)
6795# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6796 idx = i + 1 + global_offset_x - index_x
6797# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6798 if (idx < 1 .or. idx > xrows) &
6799# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6800 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
6801# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6802 do f = 1, sys_size - 1
6803# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6804 jump = merge(1, 0, f >= eqn_idx%mom%end)
6805# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6806 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6807# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6808 end do
6809# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6810 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6811# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6812 case (3)
6813# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6814 idx = i + 1 + global_offset_x - index_x
6815# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6816 idy = j + 1 + global_offset_y - index_y
6817# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6818 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
6819# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6820 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
6821# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6822 do f = 1, sys_size - 1
6823# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6824 jump = merge(1, 0, f >= eqn_idx%mom%end)
6825# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6826 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6827# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6828 end do
6829# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6830 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
6831# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6832 end select
6833# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6834
6835# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6836 y_center = y0_ref
6837# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6838 y_dist = y_cc(j) - y_center
6839# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6840 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
6841# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6842 front_shift = a_param*sin(wave_phase)
6843# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6844
6845# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6846 x_mapped = x_cc(i) - front_shift
6847# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6848
6849# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6850 if (x_mapped <= x_coords(1)) then
6851# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6852 do v = 1, sys_size - 1
6853# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6854 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
6855# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6856 end do
6857# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6858 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6859# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6860 else if (x_mapped >= x_coords(xrows)) then
6861# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6862 do v = 1, sys_size - 1
6863# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6864 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
6865# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6866 end do
6867# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6868 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6869# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6870 else
6871# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6872 idx_lo = 1; idx_hi = xrows
6873# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6874 do while (idx_hi - idx_lo > 1)
6875# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6876 idx_mid = (idx_lo + idx_hi)/2
6877# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6878 if (x_coords(idx_mid) <= x_mapped) then
6879# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6880 idx_lo = idx_mid
6881# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6882 else
6883# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6884 idx_hi = idx_mid
6885# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6886 end if
6887# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6888 end do
6889# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6890
6891# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6892 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
6893# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6894
6895# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6896 do v = 1, sys_size - 1
6897# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6898 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, &
6899# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6900 & v) + interp_wt*stored_values(idx_hi, 1, v)
6901# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6902 end do
6903# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6904 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
6905# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6906 end if
6907# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6908 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
6909# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6910 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
6911# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6912 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
6913# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6914 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
6915# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6916 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 &
6917# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6918 & - y_domain%beg))
6919# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6920 if (x_cc(i) > d) then
6921# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6922 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6923# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6924 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
6925# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6926 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
6927# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6928 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
6929# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6930 do v = eqn_idx%species%beg, eqn_idx%species%end
6931# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6932 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
6933# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6934 end do
6935# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6936 end if
6937# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6938 case (280) ! Isentropic vortex
6939# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6940 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
6941# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6942 ! geometry 2
6943# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6944 if (patch_id == 1) then
6945# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6946 q_prim_vf(eqn_idx%E)%sf(i, j, &
6947# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6948 & 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) &
6949# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6950 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
6951# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6952 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
6953# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6954 & 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) &
6955# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6956 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
6957# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6958 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
6959# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6960 & 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) &
6961# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6962 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6963# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6964 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
6965# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6966 & 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) &
6967# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6968 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6969# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6970 end if
6971# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6972 case (281) ! Acoustic pulse
6973# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6974 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
6975# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6976 ! geometry 2
6977# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6978 if (patch_id == 2) then
6979# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6980 q_prim_vf(eqn_idx%E)%sf(i, j, &
6981# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6982 & 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))
6983# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6984 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
6985# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6986 & 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))
6987# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6988 end if
6989# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6990 case (282) ! Zero-circulation vortex
6991# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6992 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
6993# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6994 ! geometry 2
6995# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6996 if (patch_id == 2) then
6997# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6998 q_prim_vf(eqn_idx%E)%sf(i, j, &
6999# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7000 & 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))
7001# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7002 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
7003# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7004 & 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))
7005# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7006 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
7007# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7008 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
7009# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7010 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
7011# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7012 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
7013# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7014 end if
7015# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7016 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
7017# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7018 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
7019# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7020 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
7021# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7022 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
7023# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7024 ! patch_icpp(patch_id)%epsilon; defaults to 5.
7025# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7026 if (patch_id == 1) then
7027# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7028 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
7029# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7030 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
7031# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7032 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
7033# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7034 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
7035# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7036 do igq = 1, 3
7037# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7038 do jgq = 1, 3
7039# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7040 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
7041# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7042 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
7043# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7044 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
7045# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7046 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))
7047# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7048 wq = gauss_w(igq)*gauss_w(jgq)
7049# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7050 rhoq = t_facq**1.4_wp
7051# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7052 pq = t_facq**2.4_wp
7053# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7054 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
7055# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7056 & - r2q)
7057# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7058 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
7059# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7060 & - r2q)
7061# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7062 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
7063# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7064 rho_avg = rho_avg + wq*rhoq
7065# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7066 rhou_avg = rhou_avg + wq*(rhoq*uq)
7067# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7068 rhov_avg = rhov_avg + wq*(rhoq*vq)
7069# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7070 e_avg = e_avg + wq*eq
7071# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7072 end do
7073# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7074 end do
7075# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7076 rho_avg = rho_avg*0.25_wp
7077# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7078 rhou_avg = rhou_avg*0.25_wp
7079# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7080 rhov_avg = rhov_avg*0.25_wp
7081# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7082 e_avg = e_avg*0.25_wp
7083# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7084 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
7085# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7086 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
7087# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7088 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
7089# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7090 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
7091# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7092 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
7093# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7094 end if
7095# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7096 case (291) ! Isothermal Flat Plate
7097# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7098 t_inf = 1125.0_wp
7099# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7100 t_wall = 600.0_wp
7101# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7102 p_atm = 101325.0_wp
7103# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7104
7105# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7106 ! Boundary/Shear Layer thicknesses
7107# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7108 delta_th = 0.0003_wp ! Thermal BL thickness
7109# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7110 delta_shear = 8e-3_wp ! Velocity BL thickness
7111# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7112
7113# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7114 u_max = 50.0_wp ! Freestream Velocity (m/s)
7115# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7116
7117# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7118 mw_n2 = 28.0134e-3_wp
7119# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7120 mw_o2 = 31.999e-3_wp
7121# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7122 y_n2 = 0.767_wp
7123# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7124 y_o2 = 0.233_wp
7125# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7126 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
7127# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7128 bottom_blend_u = tanh(y_cc(j)/delta_shear)
7129# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7130 bottom_blend_t = tanh(y_cc(j)/delta_th)
7131# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7132 u_mean = u_max*bottom_blend_u
7133# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7134 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
7135# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7136 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
7137# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7138 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
7139# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7140 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
7141# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7142 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
7143# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7144 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
7145# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7146 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
7147# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7148 case default
7149# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7150 if (proc_rank == 0) then
7151# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7152 call s_int_to_str(patch_id, istr)
7153# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7154 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
7155# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7156 end if
7157# 330 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7158 end select
7159# 331 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7160 end if
7161 end if
7162 end do
7163 end do
7164 if (allocated(stored_values)) then
7165# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7166#ifdef MFC_DEBUG
7167# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7168 block
7169# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7170 use iso_fortran_env, only: output_unit
7171# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7172
7173# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7174 print *, 'm_icpp_patches.fpp:335: ', '@:DEALLOCATE(stored_values)'
7175# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7176
7177# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7178 call flush (output_unit)
7179# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7180 end block
7181# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7182#endif
7183# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7184
7185# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7186#if defined(MFC_OpenACC)
7187# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7188!$acc exit data delete(stored_values)
7189# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7190#elif defined(MFC_OpenMP)
7191# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7192!$omp target exit data map(release:stored_values)
7193# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7194#endif
7195# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7196 deallocate (stored_values)
7197# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7198#ifdef MFC_DEBUG
7199# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7200 block
7201# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7202 use iso_fortran_env, only: output_unit
7203# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7204
7205# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7206 print *, 'm_icpp_patches.fpp:335: ', '@:DEALLOCATE(x_coords)'
7207# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7208
7209# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7210 call flush (output_unit)
7211# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7212 end block
7213# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7214#endif
7215# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7216
7217# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7218#if defined(MFC_OpenACC)
7219# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7220!$acc exit data delete(x_coords)
7221# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7222#elif defined(MFC_OpenMP)
7223# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7224!$omp target exit data map(release:x_coords)
7225# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7226#endif
7227# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7228 deallocate (x_coords)
7229# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7230 end if
7231# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7232
7233# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7234 if (allocated(y_coords)) then
7235# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7236#ifdef MFC_DEBUG
7237# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7238 block
7239# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7240 use iso_fortran_env, only: output_unit
7241# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7242
7243# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7244 print *, 'm_icpp_patches.fpp:335: ', '@:DEALLOCATE(y_coords)'
7245# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7246
7247# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7248 call flush (output_unit)
7249# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7250 end block
7251# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7252#endif
7253# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7254
7255# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7256#if defined(MFC_OpenACC)
7257# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7258!$acc exit data delete(y_coords)
7259# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7260#elif defined(MFC_OpenMP)
7261# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7262!$omp target exit data map(release:y_coords)
7263# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7264#endif
7265# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7266 deallocate (y_coords)
7267# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7268 end if
7269# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7270
7271# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7272 files_loaded = .false.
7273# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7274
7275# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7276 if (allocated(stored_values274)) then
7277# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7278#ifdef MFC_DEBUG
7279# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7280 block
7281# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7282 use iso_fortran_env, only: output_unit
7283# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7284
7285# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7286 print *, 'm_icpp_patches.fpp:335: ', '@:DEALLOCATE(stored_values274)'
7287# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7288
7289# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7290 call flush (output_unit)
7291# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7292 end block
7293# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7294#endif
7295# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7296
7297# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7298#if defined(MFC_OpenACC)
7299# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7300!$acc exit data delete(stored_values274)
7301# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7302#elif defined(MFC_OpenMP)
7303# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7304!$omp target exit data map(release:stored_values274)
7305# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7306#endif
7307# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7308 deallocate (stored_values274)
7309# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7310 end if
7311# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7312
7313# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7314 files_loaded274 = .false.
7315# 336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7316
7317 end subroutine s_icpp_circle
7318
7319 !> The varcircle patch is a 2D geometry that may be used . It generatres an annulus
7320 subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
7321
7322 ! Patch identifier
7323 integer, intent(in) :: patch_id
7324
7325#ifdef MFC_MIXED_PRECISION
7326 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7327#else
7328 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
7329#endif
7330 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
7331
7332 ! Generic loop iterators
7333 integer :: i, j, k
7334 real(wp) :: radius, myr, thickness
7335
7336 integer :: xRows, yRows, nRows, iix, iiy, max_files
7337# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7338 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
7339# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7340 real(wp) :: x_step, y_step
7341# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7342 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
7343# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7344 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
7345# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7346 real(wp) :: delta_x, delta_y
7347# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7348 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
7349# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7350 real(wp), allocatable :: stored_values(:,:,:)
7351# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7352 real(wp), allocatable :: x_coords(:), y_coords(:)
7353# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7354 logical :: files_loaded = .false.
7355# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7356 real(wp) :: domain_xstart
7357# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7358 character(len=20) :: file_num_str !< For storing the file number as a string
7359# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7360 integer :: ios
7361# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7362 integer :: ios2
7363# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7364
7365# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7366 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
7367# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7368 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
7369# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7370 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
7371# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7372 ! y_coords/files_loaded above.
7373# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7374 real(wp), allocatable, dimension(:,:,:) :: stored_values274
7375# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7376 logical :: files_loaded274 = .false.
7377# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7378 integer :: f274, ix274, iy274, unit274, ios274
7379# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7380 integer :: local_ix_beg274, local_iy_beg274
7381# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7382 character(len=300) :: fname274
7383# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7384 character(len=20) :: file_num_str274
7385# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7386 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
7387# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7388 real(wp) :: file_dx274, file_dy274, r_align274
7389# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7390 ! Place any declaration of intermediate variables here
7391# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7392 real(wp) :: eps, eps_mhd, C_mhd
7393# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7394 real(wp) :: r, rmax, gam, umax, p0
7395# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7396 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
7397# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7398 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
7399# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7400 real(wp) :: r0, alpha, r2
7401# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7402 real(wp) :: sinA, cosA
7403# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7404 real(wp) :: r_sq
7405# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7406
7407# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7408 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
7409# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7410 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
7411# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7412 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
7413# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7414 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
7415# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7416 integer :: igq, jgq
7417# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7418
7419# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7420 ! # 291 - Shear/Thermal Layer Case
7421# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7422 real(wp) :: delta_shear, u_max, u_mean
7423# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7424 real(wp) :: T_wall, T_inf, P_atm, T_loc
7425# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7426 real(wp) :: delta_th, R_mix
7427# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7428 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
7429# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7430 real(wp) :: bottom_blend_u, bottom_blend_T
7431# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7432
7433# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7434 ! # 207
7435# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7436 real(wp) :: sigma, gauss1, gauss2
7437# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7438
7439# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7440 ! # 208
7441# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7442 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
7443# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7444 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
7445# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7446 integer :: v, idx_lo, idx_hi, idx_mid
7447# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7448 real(wp), parameter :: Ly_param = 0.00775735_wp
7449# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7450 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
7451# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7452 integer, parameter :: Nwaves = 6
7453# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7454 real(wp), parameter :: y0_ref = 0.0_wp
7455# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7456
7457# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7458 eps = 1.e-9_wp
7459# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7460
7461 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
7462 x_centroid = patch_icpp(patch_id)%x_centroid
7463 y_centroid = patch_icpp(patch_id)%y_centroid
7464 radius = patch_icpp(patch_id)%radius
7465 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
7466 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
7467 thickness = patch_icpp(patch_id)%epsilon
7468
7469 ! Initialize eta=1; modified if smoothing is enabled
7470 eta = 1._wp
7471
7472 ! Assign patch vars if cell is covered and patch has write permission
7473 do j = 0, n
7474 do i = 0, m
7475 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
7476
7477 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
7478 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
7479 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
7480
7481
7482# 380 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7483 if (patch_icpp(patch_id)%hcid /= dflt_int) then
7484 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
7485# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7486 case (200) ! Two-fluid cubic interface
7487# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7488 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
7489# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7490 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
7491# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7492 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
7493# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7494 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
7495# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7496 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
7497# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7498 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
7499# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7500 end if
7501# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7502 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
7503# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7504 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
7505# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7506 rmax = 0.2_wp
7507# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7508
7509# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7510 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
7511# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7512 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
7513# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7514 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
7515# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7516
7517# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7518 if (r < rmax) then
7519# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7520 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
7521# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7522 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
7523# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7524 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
7525# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7526 else if (r < 2*rmax) then
7527# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7528 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7529# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7530 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7531# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7532 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)))
7533# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7534 else
7535# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7536 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
7537# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7538 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
7539# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7540 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
7541# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7542 end if
7543# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7544 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
7545# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7546 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
7547# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7548 rmax = 0.2_wp
7549# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7550
7551# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7552 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
7553# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7554 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
7555# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7556 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
7557# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7558
7559# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7560 if (r < rmax) then
7561# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7562 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
7563# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7564 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
7565# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7566 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
7567# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7568 else if (r < 2*rmax) then
7569# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7570 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7571# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7572 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
7573# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7574 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)))
7575# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7576 else
7577# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7578 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
7579# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7580 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
7581# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7582 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
7583# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7584 end if
7585# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7586
7587# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7588 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
7589# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7590 case (204) ! Rayleigh-Taylor instability
7591# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7592 rhoh = 3._wp
7593# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7594 rhol = 1._wp
7595# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7596 pref = 1.e5_wp
7597# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7598 pint = pref
7599# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7600 h = 0.7_wp
7601# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7602 lam = 0.2_wp
7603# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7604 wl = 2._wp*pi/lam
7605# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7606 amp = 0.05_wp/wl
7607# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7608
7609# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7610 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
7611# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7612
7613# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7614 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
7615# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7616
7617# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7618 if (alph < eps) alph = eps
7619# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7620 if (alph > 1._wp - eps) alph = 1._wp - eps
7621# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7622
7623# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7624 if (y_cc(j) > inth) then
7625# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7626 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
7627# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7628 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
7629# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7630 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
7631# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7632 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
7633# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7634 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
7635# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7636 else
7637# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7638 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
7639# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7640 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
7641# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7642 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
7643# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7644 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
7645# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7646 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
7647# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7648 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
7649# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7650 end if
7651# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7652 case (205) ! 2D lung wave interaction problem
7653# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7654 h = 0.0_wp ! non dim origin y
7655# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7656 lam = 1.0_wp ! non dim lambda
7657# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7658 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
7659# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7660
7661# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7662 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
7663# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7664
7665# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7666 if (y_cc(j) > inth) then
7667# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7668 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
7669# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7670 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
7671# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7672 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
7673# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7674 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
7675# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7676 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
7677# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7678 end if
7679# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7680 case (206) ! 2D lung wave interaction problem - horizontal domain
7681# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7682 h = 0.0_wp ! non dim origin y
7683# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7684 lam = 1.0_wp ! non dim lambda
7685# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7686 amp = patch_icpp(patch_id)%a(2)
7687# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7688
7689# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7690 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
7691# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7692
7693# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7694 if (x_cc(i) > intl) then ! this is the liquid
7695# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7696 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
7697# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7698 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
7699# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7700 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
7701# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7702 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
7703# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7704 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
7705# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7706 end if
7707# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7708 case (207) ! Kelvin Helmholtz Instability
7709# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7710 sigma = 0.05_wp/sqrt(2.0_wp)
7711# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7712 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
7713# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7714 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
7715# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7716 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)
7717# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7718 case (208) ! Richtmeyer Meshkov Instability
7719# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7720 lam = 1.0_wp
7721# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7722 eps = 1.0e-6_wp
7723# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7724 ei = 5.0_wp
7725# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7726 ! Smoothening function to smooth out sharp discontinuity in the interface
7727# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7728 if (x_cc(i) <= 0.7_wp*lam) then
7729# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7730 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
7731# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7732 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
7733# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7734 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
7735# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7736 alpha_sf6 = 1.0_wp - alpha_air
7737# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7738 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
7739# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7740 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
7741# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7742 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
7743# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7744 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
7745# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7746 end if
7747# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7748 case (250) ! MHD Orszag-Tang vortex
7749# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7750 ! 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),
7751# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7752 ! sin(4*pi*x)/sqrt(4*pi), 0)
7753# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7754
7755# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7756 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
7757# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7758 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
7759# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7760
7761# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7762 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
7763# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7764 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
7765# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7766 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
7767# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7768 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
7769# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7770 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
7771# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7772 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
7773# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7774 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
7775# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7776 ! Linear interpolation between r=0.08 and r=1.0
7777# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7778 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
7779# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7780 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
7781# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7782 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
7783# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7784 else
7785# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7786 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
7787# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7788 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
7789# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7790 end if
7791# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7792
7793# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7794 ! case 252 is for the 2D MHD Rotor problem
7795# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7796 case (252) ! 2D MHD Rotor Problem
7797# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7798 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
7799# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7800 !
7801# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7802 ! 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
7803# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7804 ! velocity w=20, giving v_tan=2 at r=0.1
7805# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7806
7807# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7808 ! Calculate distance squared from the center
7809# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7810 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
7811# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7812
7813# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7814 ! inner radius of 0.1
7815# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7816 if (r_sq <= 0.1**2) then
7817# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7818 ! -- Inside the rotor -- Set density uniformly to 10
7819# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7820 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
7821# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7822
7823# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7824 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
7825# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7826 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
7827# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7828 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
7829# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7830
7831# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7832 ! taper width of 0.015
7833# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7834 else if (r_sq <= 0.115**2) then
7835# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7836 ! linearly smooth the function between r = 0.1 and 0.115
7837# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7838 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
7839# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7840
7841# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7842 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)
7843# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7844 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)
7845# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7846 end if
7847# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7848 case (253) ! MHD Smooth Magnetic Vortex
7849# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7850 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
7851# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7852 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
7853# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7854
7855# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7856 ! velocity
7857# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7858 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))
7859# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7860 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))
7861# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7862
7863# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7864 ! magnetic field
7865# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7866 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)
7867# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7868 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)
7869# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7870
7871# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7872 ! pressure
7873# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7874 q_prim_vf(eqn_idx%E)%sf(i, j, &
7875# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7876 & 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)
7877# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7878 case (260) ! Gaussian Divergence Pulse
7879# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7880 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
7881# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7882 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
7883# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7884 ! initialized to zero everywhere.
7885# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7886
7887# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7888 eps_mhd = patch_icpp(patch_id)%a(2)
7889# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7890 sigma = patch_icpp(patch_id)%a(3)
7891# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7892 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
7893# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7894
7895# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7896 ! B-field
7897# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7898 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
7899# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7900 case (261) ! Blob
7901# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7902 r0 = 1._wp/sqrt(8._wp)
7903# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7904 r2 = x_cc(i)**2 + y_cc(j)**2
7905# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7906 r = sqrt(r2)
7907# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7908 alpha = r/r0
7909# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7910 if (alpha < 1) then
7911# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7912 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)
7913# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7914 end if
7915# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7916 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
7917# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7918 ! rotate by \alpha = atan(2)
7919# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7920 alpha = atan(2._wp)
7921# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7922 cosa = cos(alpha)
7923# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7924 sina = sin(alpha)
7925# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7926 ! projection along shock normal
7927# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7928 r = x_cc(i)*cosa + y_cc(j)*sina
7929# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7930
7931# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7932 if (r <= 0.5_wp) then
7933# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7934 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
7935# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7936 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
7937# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7938 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
7939# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7940 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
7941# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7942 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
7943# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7944 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
7945# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7946 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
7947# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7948 else
7949# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7950 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
7951# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7952 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
7953# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7954 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
7955# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7956 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
7957# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7958 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
7959# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7960 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
7961# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7962 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
7963# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7964 end if
7965# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7966 ! v^z and B^z remain zero by default
7967# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7968 case (270) ! 2D extrusion of 1D profile from external data
7969# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7970 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
7971# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7972 if (.not. files_loaded) then
7973# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7974 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
7975# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7976 do f = 1, max_files
7977# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7978 write (file_num_str, '(I0)') f
7979# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7980 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
7981# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7982 end do
7983# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7984
7985# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7986 ! Common file reading setup
7987# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7988 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7989# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7990 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
7991# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7992
7993# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7994 select case (num_dims)
7995# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7996 case (1, 2) ! 1D and 2D cases are similar
7997# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7998 ! Count lines
7999# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8000 line_count = 0
8001# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8002 do
8003# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8004 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8005# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8006 if (ios2 /= 0) exit
8007# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8008 line_count = line_count + 1
8009# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8010 end do
8011# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8012 close (unit2)
8013# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8014
8015# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8016 xrows = line_count
8017# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8018 yrows = 1
8019# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8020 index_x = 0
8021# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8022 if (num_dims == 2) index_x = i
8023# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8024#ifdef MFC_DEBUG
8025# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8026 block
8027# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8028 use iso_fortran_env, only: output_unit
8029# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8030
8031# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8032 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8033# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8034
8035# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8036 call flush (output_unit)
8037# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8038 end block
8039# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8040#endif
8041# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8042 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8043# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8044
8045# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8046
8047# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8048
8049# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8050#if defined(MFC_OpenACC)
8051# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8052!$acc enter data create(x_coords, stored_values)
8053# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8054#elif defined(MFC_OpenMP)
8055# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8056!$omp target enter data map(always,alloc:x_coords, stored_values)
8057# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8058#endif
8059# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8060
8061# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8062 ! Read data from all files
8063# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8064 do f = 1, max_files
8065# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8066 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8067# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8068 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8069# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8070
8071# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8072 do iter = 1, xrows
8073# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8074 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8075# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8076 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
8077# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8078 end do
8079# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8080 close (unit)
8081# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8082 end do
8083# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8084
8085# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8086 ! Calculate offsets
8087# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8088 domain_xstart = x_coords(1)
8089# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8090 x_step = x_cc(1) - x_cc(0)
8091# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8092 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
8093# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8094 global_offset_x = nint(abs(delta_x)/x_step)
8095# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8096 case (3) ! 3D case - determine grid structure
8097# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8098 ! Find yRows by counting rows with same x
8099# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8100 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8101# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8102 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8103# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8104
8105# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8106 yrows = 1
8107# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8108 do
8109# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8110 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8111# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8112 if (ios2 /= 0) exit
8113# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8114 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
8115# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8116 yrows = yrows + 1
8117# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8118 else
8119# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8120 exit
8121# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8122 end if
8123# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8124 end do
8125# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8126 close (unit2)
8127# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8128
8129# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8130 ! Count total rows
8131# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8132 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8133# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8134 nrows = 0
8135# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8136 do
8137# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8138 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8139# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8140 if (ios2 /= 0) exit
8141# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8142 nrows = nrows + 1
8143# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8144 end do
8145# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8146 close (unit2)
8147# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8148
8149# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8150 xrows = nrows/yrows
8151# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8152#ifdef MFC_DEBUG
8153# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8154 block
8155# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8156 use iso_fortran_env, only: output_unit
8157# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8158
8159# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8160 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
8161# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8162
8163# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8164 call flush (output_unit)
8165# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8166 end block
8167# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8168#endif
8169# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8170 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
8171# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8172
8173# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8174
8175# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8176
8177# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8178
8179# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8180#if defined(MFC_OpenACC)
8181# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8182!$acc enter data create(x_coords, y_coords, stored_values)
8183# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8184#elif defined(MFC_OpenMP)
8185# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8186!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
8187# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8188#endif
8189# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8190 index_x = i
8191# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8192 index_y = j
8193# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8194
8195# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8196 ! Read all files
8197# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8198 do f = 1, max_files
8199# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8200 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8201# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8202 if (ios /= 0) then
8203# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8204 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8205# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8206 cycle
8207# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8208 end if
8209# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8210
8211# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8212 iter = 0
8213# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8214 do iix = 1, xrows
8215# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8216 do iiy = 1, yrows
8217# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8218 iter = iter + 1
8219# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8220 if (f == 1) then
8221# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8222 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
8223# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8224 else
8225# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8226 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
8227# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8228 end if
8229# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8230 if (ios /= 0) call s_mpi_abort("Error reading data")
8231# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8232 end do
8233# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8234 end do
8235# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8236 close (unit)
8237# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8238 end do
8239# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8240
8241# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8242 ! Calculate offsets
8243# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8244 x_step = x_cc(1) - x_cc(0)
8245# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8246 y_step = y_cc(1) - y_cc(0)
8247# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8248 delta_x = x_cc(index_x) - x_coords(1)
8249# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8250 delta_y = y_cc(index_y) - y_coords(1)
8251# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8252 global_offset_x = nint(abs(delta_x)/x_step)
8253# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8254 global_offset_y = nint(abs(delta_y)/y_step)
8255# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8256
8257# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8258 ! The index check below only catches overruns, so a file that is merely too
8259# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8260 ! FINE stays in range and silently supplies a corner of itself. Check spacing
8261# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8262 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
8263# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8264 ! consecutive x values sit yRows apart.
8265# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8266 if (nrows > yrows) then
8267# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8268 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
8269# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8270 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
8271# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8272 end if
8273# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8274 if (yrows > 1) then
8275# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8276 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
8277# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8278 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
8279# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8280 end if
8281# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8282 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
8283# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8284 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
8285# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8286 & wp)) > 1.e-6_wp) &
8287# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8288 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
8289# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8290 end select
8291# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8292
8293# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8294 files_loaded = .true.
8295# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8296 end if
8297# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8298
8299# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8300 ! Data assignment
8301# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8302 select case (num_dims)
8303# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8304 case (1)
8305# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8306 idx = i + 1 + global_offset_x
8307# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8308 ! idx must land inside the file's row range: this rank's subdomain offset
8309# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8310 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
8311# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8312 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
8313# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8314 if (idx < 1 .or. idx > xrows) &
8315# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8316 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
8317# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8318 do f = 1, sys_size
8319# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8320 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
8321# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8322 end do
8323# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8324 case (2)
8325# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8326 idx = i + 1 + global_offset_x - index_x
8327# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8328 if (idx < 1 .or. idx > xrows) &
8329# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8330 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
8331# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8332 do f = 1, sys_size - 1
8333# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8334 jump = merge(1, 0, f >= eqn_idx%mom%end)
8335# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8336 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
8337# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8338 end do
8339# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8340 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
8341# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8342 case (3)
8343# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8344 idx = i + 1 + global_offset_x - index_x
8345# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8346 idy = j + 1 + global_offset_y - index_y
8347# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8348 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
8349# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8350 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
8351# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8352 do f = 1, sys_size - 1
8353# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8354 jump = merge(1, 0, f >= eqn_idx%mom%end)
8355# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8356 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
8357# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8358 end do
8359# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8360 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
8361# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8362 end select
8363# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8364 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
8365# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8366 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
8367# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8368 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
8369# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8370 ! cross-stream-position profile (real cross-stream velocity is legitimately
8371# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8372 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
8373# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8374 ! zero out mom%beg's true physical value.
8375# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8376 if (.not. files_loaded) then
8377# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8378 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8379# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8380 do f = 1, max_files
8381# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8382 write (file_num_str, '(I0)') f
8383# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8384 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
8385# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8386 end do
8387# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8388
8389# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8390 ! Common file reading setup
8391# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8392 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8393# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8394 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
8395# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8396
8397# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8398 select case (num_dims)
8399# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8400 case (1, 2) ! 1D and 2D cases are similar
8401# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8402 ! Count lines
8403# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8404 line_count = 0
8405# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8406 do
8407# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8408 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8409# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8410 if (ios2 /= 0) exit
8411# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8412 line_count = line_count + 1
8413# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8414 end do
8415# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8416 close (unit2)
8417# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8418
8419# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8420 xrows = line_count
8421# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8422 yrows = 1
8423# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8424 index_x = 0
8425# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8426 if (num_dims == 2) index_x = i
8427# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8428#ifdef MFC_DEBUG
8429# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8430 block
8431# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8432 use iso_fortran_env, only: output_unit
8433# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8434
8435# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8436 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8437# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8438
8439# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8440 call flush (output_unit)
8441# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8442 end block
8443# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8444#endif
8445# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8446 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8447# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8448
8449# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8450
8451# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8452
8453# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8454#if defined(MFC_OpenACC)
8455# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8456!$acc enter data create(x_coords, stored_values)
8457# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8458#elif defined(MFC_OpenMP)
8459# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8460!$omp target enter data map(always,alloc:x_coords, stored_values)
8461# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8462#endif
8463# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8464
8465# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8466 ! Read data from all files
8467# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8468 do f = 1, max_files
8469# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8470 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8471# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8472 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8473# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8474
8475# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8476 do iter = 1, xrows
8477# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8478 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8479# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8480 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
8481# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8482 end do
8483# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8484 close (unit)
8485# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8486 end do
8487# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8488
8489# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8490 ! Calculate offsets
8491# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8492 domain_xstart = x_coords(1)
8493# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8494 x_step = x_cc(1) - x_cc(0)
8495# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8496 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
8497# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8498 global_offset_x = nint(abs(delta_x)/x_step)
8499# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8500 case (3) ! 3D case - determine grid structure
8501# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8502 ! Find yRows by counting rows with same x
8503# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8504 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8505# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8506 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8507# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8508
8509# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8510 yrows = 1
8511# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8512 do
8513# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8514 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8515# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8516 if (ios2 /= 0) exit
8517# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8518 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
8519# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8520 yrows = yrows + 1
8521# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8522 else
8523# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8524 exit
8525# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8526 end if
8527# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8528 end do
8529# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8530 close (unit2)
8531# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8532
8533# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8534 ! Count total rows
8535# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8536 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8537# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8538 nrows = 0
8539# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8540 do
8541# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8542 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8543# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8544 if (ios2 /= 0) exit
8545# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8546 nrows = nrows + 1
8547# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8548 end do
8549# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8550 close (unit2)
8551# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8552
8553# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8554 xrows = nrows/yrows
8555# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8556#ifdef MFC_DEBUG
8557# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8558 block
8559# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8560 use iso_fortran_env, only: output_unit
8561# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8562
8563# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8564 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
8565# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8566
8567# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8568 call flush (output_unit)
8569# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8570 end block
8571# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8572#endif
8573# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8574 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
8575# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8576
8577# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8578
8579# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8580
8581# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8582
8583# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8584#if defined(MFC_OpenACC)
8585# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8586!$acc enter data create(x_coords, y_coords, stored_values)
8587# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8588#elif defined(MFC_OpenMP)
8589# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8590!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
8591# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8592#endif
8593# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8594 index_x = i
8595# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8596 index_y = j
8597# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8598
8599# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8600 ! Read all files
8601# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8602 do f = 1, max_files
8603# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8604 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8605# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8606 if (ios /= 0) then
8607# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8608 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
8609# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8610 cycle
8611# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8612 end if
8613# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8614
8615# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8616 iter = 0
8617# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8618 do iix = 1, xrows
8619# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8620 do iiy = 1, yrows
8621# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8622 iter = iter + 1
8623# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8624 if (f == 1) then
8625# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8626 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
8627# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8628 else
8629# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8630 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
8631# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8632 end if
8633# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8634 if (ios /= 0) call s_mpi_abort("Error reading data")
8635# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8636 end do
8637# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8638 end do
8639# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8640 close (unit)
8641# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8642 end do
8643# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8644
8645# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8646 ! Calculate offsets
8647# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8648 x_step = x_cc(1) - x_cc(0)
8649# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8650 y_step = y_cc(1) - y_cc(0)
8651# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8652 delta_x = x_cc(index_x) - x_coords(1)
8653# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8654 delta_y = y_cc(index_y) - y_coords(1)
8655# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8656 global_offset_x = nint(abs(delta_x)/x_step)
8657# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8658 global_offset_y = nint(abs(delta_y)/y_step)
8659# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8660
8661# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8662 ! The index check below only catches overruns, so a file that is merely too
8663# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8664 ! FINE stays in range and silently supplies a corner of itself. Check spacing
8665# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8666 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
8667# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8668 ! consecutive x values sit yRows apart.
8669# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8670 if (nrows > yrows) then
8671# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8672 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
8673# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8674 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
8675# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8676 end if
8677# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8678 if (yrows > 1) then
8679# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8680 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
8681# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8682 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
8683# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8684 end if
8685# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8686 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
8687# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8688 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
8689# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8690 & wp)) > 1.e-6_wp) &
8691# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8692 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
8693# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8694 end select
8695# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8696
8697# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8698 files_loaded = .true.
8699# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8700 end if
8701# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8702
8703# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8704 ! Data assignment
8705# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8706 select case (num_dims)
8707# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8708 case (1)
8709# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8710 idx = i + 1 + global_offset_x
8711# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8712 ! idx must land inside the file's row range: this rank's subdomain offset
8713# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8714 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
8715# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8716 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
8717# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8718 if (idx < 1 .or. idx > xrows) &
8719# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8720 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
8721# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8722 do f = 1, sys_size
8723# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8724 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
8725# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8726 end do
8727# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8728 case (2)
8729# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8730 idx = i + 1 + global_offset_x - index_x
8731# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8732 if (idx < 1 .or. idx > xrows) &
8733# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8734 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
8735# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8736 do f = 1, sys_size - 1
8737# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8738 jump = merge(1, 0, f >= eqn_idx%mom%end)
8739# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8740 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
8741# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8742 end do
8743# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8744 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
8745# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8746 case (3)
8747# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8748 idx = i + 1 + global_offset_x - index_x
8749# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8750 idy = j + 1 + global_offset_y - index_y
8751# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8752 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
8753# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8754 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
8755# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8756 do f = 1, sys_size - 1
8757# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8758 jump = merge(1, 0, f >= eqn_idx%mom%end)
8759# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8760 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
8761# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8762 end do
8763# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8764 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
8765# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8766 end select
8767# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8768 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
8769# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8770 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
8771# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8772 case (274) ! Full 2D field from external data (no extrusion)
8773# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8774 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
8775# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8776 ! extrusion direction and no zeroed component -- all sys_size variables are read and
8777# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8778 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
8779# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8780 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
8781# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8782 ! global grid exactly -- by construction, since the IC generator derives both the
8783# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8784 ! grid and the file contents from the same computation.
8785# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8786 !
8787# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8788 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
8789# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8790 ! file's own first coordinate and this rank's uniform grid spacing -- following the
8791# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8792 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
8793# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8794 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
8795# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8796 ! returns before allocating it otherwise), so a serial-IO run (the default for
8797# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8798 ! golden-file tests) would index into an unallocated array.
8799# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8800 !
8801# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8802 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
8803# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8804 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
8805# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8806 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
8807# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8808 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
8809# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8810 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
8811# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8812 ! global cell offset) are pinned from f274==1's very first record, before any other
8813# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8814 ! record is read, so every subsequent record -- across all variables -- can be tested
8815# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8816 ! against this rank's range and dropped if it falls outside it.
8817# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8818 x_step274 = x_cc(1) - x_cc(0)
8819# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8820 y_step274 = y_cc(1) - y_cc(0)
8821# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8822
8823# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8824 if (.not. files_loaded274) then
8825# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8826#ifdef MFC_DEBUG
8827# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8828 block
8829# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8830 use iso_fortran_env, only: output_unit
8831# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8832
8833# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8834 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
8835# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8836
8837# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8838 call flush (output_unit)
8839# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8840 end block
8841# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8842#endif
8843# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8844 allocate (stored_values274(0:m, 0:n, sys_size))
8845# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8846
8847# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8848
8849# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8850#if defined(MFC_OpenACC)
8851# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8852!$acc enter data create(stored_values274)
8853# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8854#elif defined(MFC_OpenMP)
8855# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8856!$omp target enter data map(always,alloc:stored_values274)
8857# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8858#endif
8859# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8860 do f274 = 1, sys_size
8861# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8862 write (file_num_str274, '(I0)') f274
8863# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8864 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
8865# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8866 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
8867# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8868 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
8869# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8870 do ix274 = 0, m_glb
8871# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8872 do iy274 = 0, n_glb
8873# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8874 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
8875# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8876 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
8877# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8878 ! Capture the file's own origin and spacing from its first records so we can
8879# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8880 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
8881# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8882 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
8883# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8884 if (f274 == 1) then
8885# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8886 if (ix274 == 0 .and. iy274 == 0) then
8887# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8888 x0_274 = dummy_x274
8889# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8890 y0_274 = dummy_y274
8891# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8892 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
8893# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8894 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
8895# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8896 end if
8897# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8898 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
8899# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8900 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
8901# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8902 end if
8903# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8904 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
8905# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8906 & .and. iy274 - local_iy_beg274 <= n) then
8907# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8908 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
8909# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8910 end if
8911# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8912 end do
8913# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8914 end do
8915# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8916 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
8917# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8918 ! read means it was generated for a larger grid and would be silently misread.
8919# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8920 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
8921# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8922 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
8923# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8924 close (unit274)
8925# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8926 end do
8927# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8928
8929# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8930 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
8931# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8932 ! Check alignment via the integer cell offset of this rank's first cell from the file
8933# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8934 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
8935# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8936 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
8937# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8938 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
8939# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8940 ! the global origin.) The spacing checks below must also hold.
8941# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8942 r_align274 = (x_cc(0) - x0_274)/x_step274
8943# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8944 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
8945# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8946 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
8947# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8948 if (m_glb >= 1) then
8949# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8950 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
8951# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8952 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
8953# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8954 end if
8955# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8956 if (n_glb >= 1) then
8957# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8958 r_align274 = (y_cc(0) - y0_274)/y_step274
8959# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8960 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
8961# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8962 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
8963# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8964 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
8965# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8966 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
8967# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8968 end if
8969# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8970
8971# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8972 files_loaded274 = .true.
8973# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8974 end if
8975# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8976 ! Alignment is verified above (or this rank would already have aborted), so the local
8977# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8978 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
8979# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8980 do f274 = 1, sys_size
8981# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8982 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
8983# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8984 end do
8985# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8986 case (271) ! Premixed Flame Vortices Interaction
8987# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8988 if (.not. files_loaded) then
8989# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8990 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8991# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8992 do f = 1, max_files
8993# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8994 write (file_num_str, '(I0)') f
8995# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8996 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
8997# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8998 end do
8999# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9000
9001# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9002 ! Common file reading setup
9003# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9004 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9005# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9006 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
9007# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9008
9009# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9010 select case (num_dims)
9011# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9012 case (1, 2) ! 1D and 2D cases are similar
9013# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9014 ! Count lines
9015# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9016 line_count = 0
9017# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9018 do
9019# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9020 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9021# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9022 if (ios2 /= 0) exit
9023# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9024 line_count = line_count + 1
9025# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9026 end do
9027# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9028 close (unit2)
9029# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9030
9031# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9032 xrows = line_count
9033# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9034 yrows = 1
9035# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9036 index_x = 0
9037# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9038 if (num_dims == 2) index_x = i
9039# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9040#ifdef MFC_DEBUG
9041# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9042 block
9043# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9044 use iso_fortran_env, only: output_unit
9045# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9046
9047# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9048 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9049# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9050
9051# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9052 call flush (output_unit)
9053# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9054 end block
9055# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9056#endif
9057# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9058 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
9059# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9060
9061# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9062
9063# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9064
9065# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9066#if defined(MFC_OpenACC)
9067# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9068!$acc enter data create(x_coords, stored_values)
9069# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9070#elif defined(MFC_OpenMP)
9071# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9072!$omp target enter data map(always,alloc:x_coords, stored_values)
9073# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9074#endif
9075# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9076
9077# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9078 ! Read data from all files
9079# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9080 do f = 1, max_files
9081# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9082 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9083# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9084 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9085# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9086
9087# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9088 do iter = 1, xrows
9089# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9090 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
9091# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9092 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
9093# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9094 end do
9095# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9096 close (unit)
9097# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9098 end do
9099# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9100
9101# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9102 ! Calculate offsets
9103# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9104 domain_xstart = x_coords(1)
9105# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9106 x_step = x_cc(1) - x_cc(0)
9107# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9108 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
9109# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9110 global_offset_x = nint(abs(delta_x)/x_step)
9111# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9112 case (3) ! 3D case - determine grid structure
9113# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9114 ! Find yRows by counting rows with same x
9115# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9116 read (unit2, *, iostat=ios2) x0, y0, dummy_z
9117# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9118 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
9119# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9120
9121# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9122 yrows = 1
9123# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9124 do
9125# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9126 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9127# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9128 if (ios2 /= 0) exit
9129# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9130 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
9131# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9132 yrows = yrows + 1
9133# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9134 else
9135# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9136 exit
9137# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9138 end if
9139# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9140 end do
9141# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9142 close (unit2)
9143# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9144
9145# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9146 ! Count total rows
9147# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9148 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9149# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9150 nrows = 0
9151# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9152 do
9153# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9154 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9155# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9156 if (ios2 /= 0) exit
9157# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9158 nrows = nrows + 1
9159# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9160 end do
9161# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9162 close (unit2)
9163# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9164
9165# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9166 xrows = nrows/yrows
9167# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9168#ifdef MFC_DEBUG
9169# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9170 block
9171# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9172 use iso_fortran_env, only: output_unit
9173# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9174
9175# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9176 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9177# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9178
9179# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9180 call flush (output_unit)
9181# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9182 end block
9183# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9184#endif
9185# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9186 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9187# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9188
9189# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9190
9191# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9192
9193# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9194
9195# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9196#if defined(MFC_OpenACC)
9197# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9198!$acc enter data create(x_coords, y_coords, stored_values)
9199# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9200#elif defined(MFC_OpenMP)
9201# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9202!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9203# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9204#endif
9205# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9206 index_x = i
9207# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9208 index_y = j
9209# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9210
9211# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9212 ! Read all files
9213# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9214 do f = 1, max_files
9215# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9216 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9217# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9218 if (ios /= 0) then
9219# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9220 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9221# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9222 cycle
9223# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9224 end if
9225# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9226
9227# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9228 iter = 0
9229# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9230 do iix = 1, xrows
9231# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9232 do iiy = 1, yrows
9233# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9234 iter = iter + 1
9235# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9236 if (f == 1) then
9237# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9238 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9239# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9240 else
9241# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9242 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9243# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9244 end if
9245# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9246 if (ios /= 0) call s_mpi_abort("Error reading data")
9247# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9248 end do
9249# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9250 end do
9251# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9252 close (unit)
9253# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9254 end do
9255# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9256
9257# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9258 ! Calculate offsets
9259# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9260 x_step = x_cc(1) - x_cc(0)
9261# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9262 y_step = y_cc(1) - y_cc(0)
9263# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9264 delta_x = x_cc(index_x) - x_coords(1)
9265# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9266 delta_y = y_cc(index_y) - y_coords(1)
9267# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9268 global_offset_x = nint(abs(delta_x)/x_step)
9269# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9270 global_offset_y = nint(abs(delta_y)/y_step)
9271# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9272
9273# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9274 ! The index check below only catches overruns, so a file that is merely too
9275# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9276 ! FINE stays in range and silently supplies a corner of itself. Check spacing
9277# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9278 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
9279# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9280 ! consecutive x values sit yRows apart.
9281# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9282 if (nrows > yrows) then
9283# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9284 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
9285# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9286 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
9287# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9288 end if
9289# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9290 if (yrows > 1) then
9291# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9292 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
9293# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9294 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
9295# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9296 end if
9297# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9298 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
9299# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9300 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
9301# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9302 & wp)) > 1.e-6_wp) &
9303# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9304 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
9305# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9306 end select
9307# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9308
9309# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9310 files_loaded = .true.
9311# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9312 end if
9313# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9314
9315# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9316 ! Data assignment
9317# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9318 select case (num_dims)
9319# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9320 case (1)
9321# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9322 idx = i + 1 + global_offset_x
9323# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9324 ! idx must land inside the file's row range: this rank's subdomain offset
9325# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9326 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
9327# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9328 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
9329# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9330 if (idx < 1 .or. idx > xrows) &
9331# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9332 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
9333# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9334 do f = 1, sys_size
9335# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9336 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9337# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9338 end do
9339# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9340 case (2)
9341# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9342 idx = i + 1 + global_offset_x - index_x
9343# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9344 if (idx < 1 .or. idx > xrows) &
9345# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9346 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
9347# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9348 do f = 1, sys_size - 1
9349# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9350 jump = merge(1, 0, f >= eqn_idx%mom%end)
9351# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9352 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9353# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9354 end do
9355# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9356 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9357# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9358 case (3)
9359# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9360 idx = i + 1 + global_offset_x - index_x
9361# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9362 idy = j + 1 + global_offset_y - index_y
9363# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9364 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
9365# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9366 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
9367# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9368 do f = 1, sys_size - 1
9369# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9370 jump = merge(1, 0, f >= eqn_idx%mom%end)
9371# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9372 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9373# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9374 end do
9375# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9376 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
9377# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9378 end select
9379# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9380 x1c = 0.0027_wp
9381# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9382 y1c = 0.005_wp
9383# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9384 x2c = 0.0027_wp
9385# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9386 y2c = 0.003_wp
9387# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9388 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
9389# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9390 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
9391# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9392 rvortex = 0.0005_wp
9393# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9394 cvortex = 6000.0_wp
9395# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9396
9397# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9398 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
9399# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9400 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
9401# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9402
9403# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9404 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
9405# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9406 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
9407# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9408 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
9409# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9410 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
9411# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9412 case (272) ! Premixed Flame Instability
9413# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9414 if (.not. files_loaded) then
9415# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9416 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
9417# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9418 do f = 1, max_files
9419# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9420 write (file_num_str, '(I0)') f
9421# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9422 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
9423# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9424 end do
9425# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9426
9427# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9428 ! Common file reading setup
9429# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9430 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9431# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9432 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
9433# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9434
9435# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9436 select case (num_dims)
9437# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9438 case (1, 2) ! 1D and 2D cases are similar
9439# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9440 ! Count lines
9441# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9442 line_count = 0
9443# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9444 do
9445# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9446 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9447# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9448 if (ios2 /= 0) exit
9449# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9450 line_count = line_count + 1
9451# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9452 end do
9453# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9454 close (unit2)
9455# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9456
9457# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9458 xrows = line_count
9459# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9460 yrows = 1
9461# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9462 index_x = 0
9463# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9464 if (num_dims == 2) index_x = i
9465# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9466#ifdef MFC_DEBUG
9467# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9468 block
9469# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9470 use iso_fortran_env, only: output_unit
9471# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9472
9473# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9474 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9475# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9476
9477# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9478 call flush (output_unit)
9479# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9480 end block
9481# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9482#endif
9483# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9484 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
9485# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9486
9487# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9488
9489# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9490
9491# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9492#if defined(MFC_OpenACC)
9493# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9494!$acc enter data create(x_coords, stored_values)
9495# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9496#elif defined(MFC_OpenMP)
9497# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9498!$omp target enter data map(always,alloc:x_coords, stored_values)
9499# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9500#endif
9501# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9502
9503# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9504 ! Read data from all files
9505# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9506 do f = 1, max_files
9507# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9508 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9509# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9510 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9511# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9512
9513# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9514 do iter = 1, xrows
9515# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9516 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
9517# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9518 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
9519# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9520 end do
9521# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9522 close (unit)
9523# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9524 end do
9525# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9526
9527# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9528 ! Calculate offsets
9529# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9530 domain_xstart = x_coords(1)
9531# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9532 x_step = x_cc(1) - x_cc(0)
9533# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9534 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
9535# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9536 global_offset_x = nint(abs(delta_x)/x_step)
9537# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9538 case (3) ! 3D case - determine grid structure
9539# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9540 ! Find yRows by counting rows with same x
9541# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9542 read (unit2, *, iostat=ios2) x0, y0, dummy_z
9543# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9544 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
9545# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9546
9547# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9548 yrows = 1
9549# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9550 do
9551# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9552 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9553# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9554 if (ios2 /= 0) exit
9555# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9556 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
9557# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9558 yrows = yrows + 1
9559# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9560 else
9561# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9562 exit
9563# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9564 end if
9565# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9566 end do
9567# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9568 close (unit2)
9569# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9570
9571# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9572 ! Count total rows
9573# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9574 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9575# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9576 nrows = 0
9577# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9578 do
9579# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9580 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9581# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9582 if (ios2 /= 0) exit
9583# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9584 nrows = nrows + 1
9585# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9586 end do
9587# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9588 close (unit2)
9589# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9590
9591# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9592 xrows = nrows/yrows
9593# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9594#ifdef MFC_DEBUG
9595# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9596 block
9597# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9598 use iso_fortran_env, only: output_unit
9599# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9600
9601# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9602 print *, 'm_icpp_patches.fpp:381: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9603# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9604
9605# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9606 call flush (output_unit)
9607# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9608 end block
9609# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9610#endif
9611# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9612 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9613# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9614
9615# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9616
9617# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9618
9619# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9620
9621# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9622#if defined(MFC_OpenACC)
9623# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9624!$acc enter data create(x_coords, y_coords, stored_values)
9625# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9626#elif defined(MFC_OpenMP)
9627# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9628!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9629# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9630#endif
9631# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9632 index_x = i
9633# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9634 index_y = j
9635# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9636
9637# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9638 ! Read all files
9639# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9640 do f = 1, max_files
9641# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9642 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9643# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9644 if (ios /= 0) then
9645# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9646 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
9647# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9648 cycle
9649# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9650 end if
9651# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9652
9653# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9654 iter = 0
9655# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9656 do iix = 1, xrows
9657# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9658 do iiy = 1, yrows
9659# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9660 iter = iter + 1
9661# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9662 if (f == 1) then
9663# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9664 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9665# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9666 else
9667# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9668 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9669# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9670 end if
9671# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9672 if (ios /= 0) call s_mpi_abort("Error reading data")
9673# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9674 end do
9675# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9676 end do
9677# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9678 close (unit)
9679# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9680 end do
9681# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9682
9683# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9684 ! Calculate offsets
9685# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9686 x_step = x_cc(1) - x_cc(0)
9687# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9688 y_step = y_cc(1) - y_cc(0)
9689# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9690 delta_x = x_cc(index_x) - x_coords(1)
9691# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9692 delta_y = y_cc(index_y) - y_coords(1)
9693# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9694 global_offset_x = nint(abs(delta_x)/x_step)
9695# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9696 global_offset_y = nint(abs(delta_y)/y_step)
9697# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9698
9699# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9700 ! The index check below only catches overruns, so a file that is merely too
9701# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9702 ! FINE stays in range and silently supplies a corner of itself. Check spacing
9703# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9704 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
9705# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9706 ! consecutive x values sit yRows apart.
9707# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9708 if (nrows > yrows) then
9709# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9710 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
9711# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9712 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
9713# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9714 end if
9715# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9716 if (yrows > 1) then
9717# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9718 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
9719# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9720 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
9721# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9722 end if
9723# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9724 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
9725# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9726 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
9727# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9728 & wp)) > 1.e-6_wp) &
9729# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9730 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
9731# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9732 end select
9733# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9734
9735# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9736 files_loaded = .true.
9737# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9738 end if
9739# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9740
9741# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9742 ! Data assignment
9743# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9744 select case (num_dims)
9745# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9746 case (1)
9747# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9748 idx = i + 1 + global_offset_x
9749# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9750 ! idx must land inside the file's row range: this rank's subdomain offset
9751# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9752 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
9753# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9754 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
9755# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9756 if (idx < 1 .or. idx > xrows) &
9757# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9758 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
9759# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9760 do f = 1, sys_size
9761# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9762 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9763# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9764 end do
9765# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9766 case (2)
9767# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9768 idx = i + 1 + global_offset_x - index_x
9769# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9770 if (idx < 1 .or. idx > xrows) &
9771# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9772 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
9773# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9774 do f = 1, sys_size - 1
9775# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9776 jump = merge(1, 0, f >= eqn_idx%mom%end)
9777# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9778 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9779# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9780 end do
9781# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9782 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9783# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9784 case (3)
9785# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9786 idx = i + 1 + global_offset_x - index_x
9787# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9788 idy = j + 1 + global_offset_y - index_y
9789# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9790 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
9791# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9792 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
9793# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9794 do f = 1, sys_size - 1
9795# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9796 jump = merge(1, 0, f >= eqn_idx%mom%end)
9797# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9798 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9799# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9800 end do
9801# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9802 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
9803# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9804 end select
9805# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9806
9807# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9808 y_center = y0_ref
9809# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9810 y_dist = y_cc(j) - y_center
9811# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9812 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
9813# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9814 front_shift = a_param*sin(wave_phase)
9815# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9816
9817# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9818 x_mapped = x_cc(i) - front_shift
9819# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9820
9821# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9822 if (x_mapped <= x_coords(1)) then
9823# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9824 do v = 1, sys_size - 1
9825# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9826 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
9827# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9828 end do
9829# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9830 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9831# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9832 else if (x_mapped >= x_coords(xrows)) then
9833# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9834 do v = 1, sys_size - 1
9835# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9836 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
9837# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9838 end do
9839# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9840 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9841# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9842 else
9843# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9844 idx_lo = 1; idx_hi = xrows
9845# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9846 do while (idx_hi - idx_lo > 1)
9847# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9848 idx_mid = (idx_lo + idx_hi)/2
9849# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9850 if (x_coords(idx_mid) <= x_mapped) then
9851# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9852 idx_lo = idx_mid
9853# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9854 else
9855# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9856 idx_hi = idx_mid
9857# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9858 end if
9859# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9860 end do
9861# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9862
9863# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9864 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
9865# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9866
9867# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9868 do v = 1, sys_size - 1
9869# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9870 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, &
9871# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9872 & v) + interp_wt*stored_values(idx_hi, 1, v)
9873# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9874 end do
9875# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9876 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
9877# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9878 end if
9879# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9880 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
9881# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9882 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
9883# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9884 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
9885# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9886 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
9887# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9888 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 &
9889# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9890 & - y_domain%beg))
9891# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9892 if (x_cc(i) > d) then
9893# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9894 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
9895# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9896 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
9897# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9898 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
9899# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9900 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
9901# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9902 do v = eqn_idx%species%beg, eqn_idx%species%end
9903# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9904 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
9905# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9906 end do
9907# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9908 end if
9909# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9910 case (280) ! Isentropic vortex
9911# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9912 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
9913# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9914 ! geometry 2
9915# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9916 if (patch_id == 1) then
9917# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9918 q_prim_vf(eqn_idx%E)%sf(i, j, &
9919# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9920 & 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) &
9921# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9922 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
9923# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9924 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9925# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9926 & 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) &
9927# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9928 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
9929# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9930 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9931# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9932 & 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) &
9933# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9934 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9935# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9936 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9937# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9938 & 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) &
9939# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9940 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9941# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9942 end if
9943# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9944 case (281) ! Acoustic pulse
9945# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9946 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
9947# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9948 ! geometry 2
9949# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9950 if (patch_id == 2) then
9951# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9952 q_prim_vf(eqn_idx%E)%sf(i, j, &
9953# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9954 & 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))
9955# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9956 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9957# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9958 & 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))
9959# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9960 end if
9961# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9962 case (282) ! Zero-circulation vortex
9963# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9964 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
9965# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9966 ! geometry 2
9967# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9968 if (patch_id == 2) then
9969# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9970 q_prim_vf(eqn_idx%E)%sf(i, j, &
9971# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9972 & 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))
9973# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9974 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
9975# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9976 & 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))
9977# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9978 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
9979# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9980 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9981# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9982 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
9983# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9984 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9985# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9986 end if
9987# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9988 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
9989# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9990 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
9991# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9992 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
9993# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9994 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
9995# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9996 ! patch_icpp(patch_id)%epsilon; defaults to 5.
9997# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9998 if (patch_id == 1) then
9999# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10000 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
10001# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10002 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
10003# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10004 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
10005# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10006 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
10007# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10008 do igq = 1, 3
10009# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10010 do jgq = 1, 3
10011# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10012 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
10013# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10014 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
10015# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10016 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
10017# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10018 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))
10019# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10020 wq = gauss_w(igq)*gauss_w(jgq)
10021# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10022 rhoq = t_facq**1.4_wp
10023# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10024 pq = t_facq**2.4_wp
10025# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10026 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
10027# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10028 & - r2q)
10029# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10030 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
10031# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10032 & - r2q)
10033# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10034 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
10035# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10036 rho_avg = rho_avg + wq*rhoq
10037# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10038 rhou_avg = rhou_avg + wq*(rhoq*uq)
10039# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10040 rhov_avg = rhov_avg + wq*(rhoq*vq)
10041# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10042 e_avg = e_avg + wq*eq
10043# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10044 end do
10045# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10046 end do
10047# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10048 rho_avg = rho_avg*0.25_wp
10049# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10050 rhou_avg = rhou_avg*0.25_wp
10051# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10052 rhov_avg = rhov_avg*0.25_wp
10053# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10054 e_avg = e_avg*0.25_wp
10055# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10056 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
10057# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10058 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
10059# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10060 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
10061# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10062 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
10063# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10064 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
10065# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10066 end if
10067# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10068 case (291) ! Isothermal Flat Plate
10069# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10070 t_inf = 1125.0_wp
10071# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10072 t_wall = 600.0_wp
10073# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10074 p_atm = 101325.0_wp
10075# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10076
10077# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10078 ! Boundary/Shear Layer thicknesses
10079# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10080 delta_th = 0.0003_wp ! Thermal BL thickness
10081# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10082 delta_shear = 8e-3_wp ! Velocity BL thickness
10083# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10084
10085# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10086 u_max = 50.0_wp ! Freestream Velocity (m/s)
10087# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10088
10089# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10090 mw_n2 = 28.0134e-3_wp
10091# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10092 mw_o2 = 31.999e-3_wp
10093# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10094 y_n2 = 0.767_wp
10095# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10096 y_o2 = 0.233_wp
10097# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10098 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
10099# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10100 bottom_blend_u = tanh(y_cc(j)/delta_shear)
10101# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10102 bottom_blend_t = tanh(y_cc(j)/delta_th)
10103# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10104 u_mean = u_max*bottom_blend_u
10105# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10106 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
10107# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10108 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
10109# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10110 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
10111# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10112 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
10113# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10114 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
10115# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10116 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
10117# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10118 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
10119# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10120 case default
10121# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10122 if (proc_rank == 0) then
10123# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10124 call s_int_to_str(patch_id, istr)
10125# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10126 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
10127# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10128 end if
10129# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10130 end select
10131# 382 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10132 end if
10133
10134 ! Updating the patch identities bookkeeping variable
10135 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
10136
10137 q_prim_vf(eqn_idx%alf)%sf(i, j, &
10138 & 0) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
10139 end if
10140 end do
10141 end do
10142 if (allocated(stored_values)) then
10143# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10144#ifdef MFC_DEBUG
10145# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10146 block
10147# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10148 use iso_fortran_env, only: output_unit
10149# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10150
10151# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10152 print *, 'm_icpp_patches.fpp:392: ', '@:DEALLOCATE(stored_values)'
10153# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10154
10155# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10156 call flush (output_unit)
10157# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10158 end block
10159# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10160#endif
10161# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10162
10163# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10164#if defined(MFC_OpenACC)
10165# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10166!$acc exit data delete(stored_values)
10167# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10168#elif defined(MFC_OpenMP)
10169# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10170!$omp target exit data map(release:stored_values)
10171# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10172#endif
10173# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10174 deallocate (stored_values)
10175# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10176#ifdef MFC_DEBUG
10177# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10178 block
10179# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10180 use iso_fortran_env, only: output_unit
10181# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10182
10183# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10184 print *, 'm_icpp_patches.fpp:392: ', '@:DEALLOCATE(x_coords)'
10185# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10186
10187# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10188 call flush (output_unit)
10189# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10190 end block
10191# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10192#endif
10193# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10194
10195# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10196#if defined(MFC_OpenACC)
10197# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10198!$acc exit data delete(x_coords)
10199# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10200#elif defined(MFC_OpenMP)
10201# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10202!$omp target exit data map(release:x_coords)
10203# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10204#endif
10205# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10206 deallocate (x_coords)
10207# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10208 end if
10209# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10210
10211# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10212 if (allocated(y_coords)) then
10213# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10214#ifdef MFC_DEBUG
10215# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10216 block
10217# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10218 use iso_fortran_env, only: output_unit
10219# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10220
10221# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10222 print *, 'm_icpp_patches.fpp:392: ', '@:DEALLOCATE(y_coords)'
10223# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10224
10225# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10226 call flush (output_unit)
10227# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10228 end block
10229# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10230#endif
10231# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10232
10233# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10234#if defined(MFC_OpenACC)
10235# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10236!$acc exit data delete(y_coords)
10237# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10238#elif defined(MFC_OpenMP)
10239# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10240!$omp target exit data map(release:y_coords)
10241# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10242#endif
10243# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10244 deallocate (y_coords)
10245# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10246 end if
10247# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10248
10249# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10250 files_loaded = .false.
10251# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10252
10253# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10254 if (allocated(stored_values274)) then
10255# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10256#ifdef MFC_DEBUG
10257# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10258 block
10259# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10260 use iso_fortran_env, only: output_unit
10261# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10262
10263# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10264 print *, 'm_icpp_patches.fpp:392: ', '@:DEALLOCATE(stored_values274)'
10265# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10266
10267# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10268 call flush (output_unit)
10269# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10270 end block
10271# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10272#endif
10273# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10274
10275# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10276#if defined(MFC_OpenACC)
10277# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10278!$acc exit data delete(stored_values274)
10279# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10280#elif defined(MFC_OpenMP)
10281# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10282!$omp target exit data map(release:stored_values274)
10283# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10284#endif
10285# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10286 deallocate (stored_values274)
10287# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10288 end if
10289# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10290
10291# 392 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10292 files_loaded274 = .false.
10293# 393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10294
10295 end subroutine s_icpp_varcircle
10296
10297 !> Initialize a 3D variable-thickness circular annulus patch extruded along the z-axis.
10298 subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
10299
10300 ! Patch identifier
10301 integer, intent(in) :: patch_id
10302
10303#ifdef MFC_MIXED_PRECISION
10304 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10305#else
10306 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
10307#endif
10308 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
10309
10310 ! Generic loop iterators
10311 integer :: i, j, k
10312 real(wp) :: radius, myr, thickness
10313
10314 integer :: xRows, yRows, nRows, iix, iiy, max_files
10315# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10316 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
10317# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10318 real(wp) :: x_step, y_step
10319# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10320 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
10321# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10322 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
10323# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10324 real(wp) :: delta_x, delta_y
10325# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10326 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
10327# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10328 real(wp), allocatable :: stored_values(:,:,:)
10329# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10330 real(wp), allocatable :: x_coords(:), y_coords(:)
10331# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10332 logical :: files_loaded = .false.
10333# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10334 real(wp) :: domain_xstart
10335# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10336 character(len=20) :: file_num_str !< For storing the file number as a string
10337# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10338 integer :: ios
10339# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10340 integer :: ios2
10341# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10342
10343# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10344 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
10345# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10346 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
10347# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10348 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
10349# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10350 ! y_coords/files_loaded above.
10351# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10352 real(wp), allocatable, dimension(:,:,:) :: stored_values274
10353# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10354 logical :: files_loaded274 = .false.
10355# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10356 integer :: f274, ix274, iy274, unit274, ios274
10357# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10358 integer :: local_ix_beg274, local_iy_beg274
10359# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10360 character(len=300) :: fname274
10361# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10362 character(len=20) :: file_num_str274
10363# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10364 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
10365# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10366 real(wp) :: file_dx274, file_dy274, r_align274
10367# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10368 ! Place any declaration of intermediate variables here
10369# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10370 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
10371# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10372 real(wp) :: eps
10373# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10374 real(wp) :: zlen371, kz371
10375# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10376
10377# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10378 ! IGR Jets Arrays to stor position and radii of jets from input file
10379# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10380 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
10381# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10382 ! Variables to describe initial condition of jet
10383# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10384 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
10385# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10386 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
10387# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10388 real(wp), dimension(0:n,0:p) :: rcut_arr
10389# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10390 integer :: l, q, s !< Iterators for reading input files
10391# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10392 integer :: start, end !< Ints to keep track of position in file
10393# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10394 character(len=100000) :: line ! String to store line in file
10395# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10396 character(len=25) :: value !< String to store value in line
10397# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10398 integer :: NJet !< Number of jets
10399# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10400 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
10401# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10402 logical :: file_exist ! Flag to check if file exists
10403# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10404
10405# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10406 eps = 1e-9_wp
10407# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10408
10409# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10410 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
10411# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10412 eps_smooth = 3._wp
10413# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10414 inquire (file="njet.txt", exist=file_exist)
10415# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10416 if (file_exist) then
10417# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10418 open (unit=10, file="njet.txt", status="old", action="read")
10419# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10420 read (10, *) njet
10421# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10422 close (10)
10423# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10424 else
10425# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10426 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
10427# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10428 end if
10429# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10430
10431# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10432#ifdef MFC_DEBUG
10433# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10434 block
10435# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10436 use iso_fortran_env, only: output_unit
10437# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10438
10439# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10440 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
10441# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10442
10443# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10444 call flush (output_unit)
10445# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10446 end block
10447# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10448#endif
10449# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10450 allocate (y_th_arr(0:njet - 1))
10451# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10452
10453# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10454
10455# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10456#if defined(MFC_OpenACC)
10457# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10458!$acc enter data create(y_th_arr)
10459# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10460#elif defined(MFC_OpenMP)
10461# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10462!$omp target enter data map(always,alloc:y_th_arr)
10463# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10464#endif
10465# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10466#ifdef MFC_DEBUG
10467# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10468 block
10469# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10470 use iso_fortran_env, only: output_unit
10471# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10472
10473# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10474 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
10475# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10476
10477# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10478 call flush (output_unit)
10479# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10480 end block
10481# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10482#endif
10483# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10484 allocate (z_th_arr(0:njet - 1))
10485# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10486
10487# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10488
10489# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10490#if defined(MFC_OpenACC)
10491# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10492!$acc enter data create(z_th_arr)
10493# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10494#elif defined(MFC_OpenMP)
10495# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10496!$omp target enter data map(always,alloc:z_th_arr)
10497# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10498#endif
10499# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10500#ifdef MFC_DEBUG
10501# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10502 block
10503# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10504 use iso_fortran_env, only: output_unit
10505# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10506
10507# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10508 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
10509# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10510
10511# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10512 call flush (output_unit)
10513# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10514 end block
10515# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10516#endif
10517# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10518 allocate (r_th_arr(0:njet - 1))
10519# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10520
10521# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10522
10523# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10524#if defined(MFC_OpenACC)
10525# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10526!$acc enter data create(r_th_arr)
10527# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10528#elif defined(MFC_OpenMP)
10529# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10530!$omp target enter data map(always,alloc:r_th_arr)
10531# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10532#endif
10533# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10534
10535# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10536 inquire (file="jets.csv", exist=file_exist)
10537# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10538 if (file_exist) then
10539# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10540 open (unit=10, file="jets.csv", status="old", action="read")
10541# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10542 do q = 0, njet - 1
10543# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10544 read (10, '(A)') line ! Read a full line as a string
10545# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10546 start = 1
10547# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10548
10549# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10550 do l = 0, 2
10551# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10552 end = index(line(start:), ',') ! Find the next comma
10553# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10554 if (end == 0) then
10555# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10556 value = trim(adjustl(line(start:))) ! Last value in the line
10557# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10558 else
10559# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10560 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
10561# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10562 start = start + end ! Move to next value
10563# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10564 end if
10565# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10566 if (l == 0) then
10567# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10568 read (value, *) y_th_arr(q) ! Convert string to numeric value
10569# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10570 else if (l == 1) then
10571# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10572 read (value, *) z_th_arr(q)
10573# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10574 else
10575# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10576 read (value, *) r_th_arr(q)
10577# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10578 end if
10579# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10580 end do
10581# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10582 end do
10583# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10584 close (10)
10585# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10586
10587# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10588 do q = 0, p
10589# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10590 do l = 0, n
10591# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10592 rcut = 0._wp
10593# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10594 do s = 0, njet - 1
10595# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10596 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
10597# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10598 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
10599# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10600 end do
10601# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10602 rcut_arr(l, q) = rcut
10603# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10604 end do
10605# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10606 end do
10607# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10608 else
10609# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10610 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
10611# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10612 end if
10613# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10614 end if
10615# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10616
10617# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10618 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
10619# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10620#ifdef MFC_DEBUG
10621# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10622 block
10623# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10624 use iso_fortran_env, only: output_unit
10625# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10626
10627# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10628 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
10629# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10630
10631# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10632 call flush (output_unit)
10633# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10634 end block
10635# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10636#endif
10637# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10638 allocate (ih(0:n_glb, 0:p_glb))
10639# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10640
10641# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10642
10643# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10644#if defined(MFC_OpenACC)
10645# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10646!$acc enter data create(ih)
10647# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10648#elif defined(MFC_OpenMP)
10649# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10650!$omp target enter data map(always,alloc:ih)
10651# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10652#endif
10653# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10654
10655# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10656 if (interface_file == '.') then
10657# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10658 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
10659# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10660 else
10661# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10662 inquire (file=trim(interface_file), exist=file_exist)
10663# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10664 if (file_exist) then
10665# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10666 open (unit=10, file=trim(interface_file), status="old", action="read")
10667# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10668 do i = 0, n_glb
10669# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10670 read (10, '(A)') line ! Read a full line as a string
10671# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10672 start = 1
10673# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10674
10675# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10676 do j = 0, p_glb
10677# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10678 end = index(line(start:), ',') ! Find the next comma
10679# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10680 if (end == 0) then
10681# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10682 value = trim(adjustl(line(start:))) ! Last value in the line
10683# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10684 else
10685# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10686 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
10687# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10688 start = start + end ! Move to next value
10689# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10690 end if
10691# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10692 read (value, *) ih(i, j) ! Convert string to numeric value
10693# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10694 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
10695# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10696 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
10697# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10698 end do
10699# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10700 end do
10701# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10702 close (10)
10703# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10704 else
10705# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10706 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
10707# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10708 end if
10709# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10710 end if
10711# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10712 end if
10713# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10714
10715# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10716 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
10717# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10718#ifdef MFC_DEBUG
10719# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10720 block
10721# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10722 use iso_fortran_env, only: output_unit
10723# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10724
10725# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10726 print *, 'm_icpp_patches.fpp:414: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
10727# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10728
10729# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10730 call flush (output_unit)
10731# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10732 end block
10733# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10734#endif
10735# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10736 allocate (ih(0:n_glb, 0:0))
10737# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10738
10739# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10740
10741# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10742#if defined(MFC_OpenACC)
10743# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10744!$acc enter data create(ih)
10745# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10746#elif defined(MFC_OpenMP)
10747# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10748!$omp target enter data map(always,alloc:ih)
10749# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10750#endif
10751# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10752 if (interface_file == '.') then
10753# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10754 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
10755# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10756 else
10757# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10758 inquire (file=trim(interface_file), exist=file_exist)
10759# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10760 if (file_exist) then
10761# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10762 open (unit=10, file=trim(interface_file), status="old", action="read")
10763# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10764 do i = 0, n_glb
10765# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10766 read (10, '(A)') line ! Read a full line as a string
10767# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10768 value = trim(line)
10769# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10770 read (value, *) ih(i, 0) ! Convert string to numeric value
10771# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10772 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
10773# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10774 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
10775# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10776 end do
10777# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10778 close (10)
10779# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10780 else
10781# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10782 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
10783# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10784 end if
10785# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10786 end if
10787# 414 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10788 end if
10789# 415 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10790
10791 ! Transferring the circular patch's radius, centroid, smearing patch identity and smearing coefficient information
10792 x_centroid = patch_icpp(patch_id)%x_centroid
10793 y_centroid = patch_icpp(patch_id)%y_centroid
10794 z_centroid = patch_icpp(patch_id)%z_centroid
10795 length_z = patch_icpp(patch_id)%length_z
10796 radius = patch_icpp(patch_id)%radius
10797 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
10798 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
10799 thickness = patch_icpp(patch_id)%epsilon
10800
10801 ! Initialize eta=1; modified if smoothing is enabled
10802 eta = 1._wp
10803
10804 ! write for all z
10805
10806 ! Assign patch vars if cell is covered and patch has write permission
10807 do k = 0, p
10808 do j = 0, n
10809 do i = 0, m
10810 myr = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
10811
10812 if (myr <= radius + thickness/2._wp .and. myr >= radius - thickness/2._wp &
10813 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
10814 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
10815
10816
10817# 442 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10818 if (patch_icpp(patch_id)%hcid /= dflt_int) then
10819 select case (patch_icpp(patch_id)%hcid)
10820# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10821 case (300) ! Rayleigh-Taylor instability
10822# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10823 rhoh = 3._wp
10824# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10825 rhol = 1._wp
10826# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10827 pref = 1.e5_wp
10828# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10829 pint = pref
10830# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10831 h = 0.7_wp
10832# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10833 lam = 0.2_wp
10834# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10835 wl = 2._wp*pi/lam
10836# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10837 amp = 0.025_wp/wl
10838# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10839
10840# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10841 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
10842# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10843
10844# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10845 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
10846# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10847
10848# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10849 if (alph < eps) alph = eps
10850# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10851 if (alph > 1._wp - eps) alph = 1._wp - eps
10852# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10853
10854# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10855 if (y_cc(j) > inth) then
10856# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10857 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
10858# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10859 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
10860# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10861 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
10862# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10863 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
10864# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10865 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
10866# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10867 else
10868# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10869 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
10870# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10871 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
10872# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10873 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
10874# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10875 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
10876# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10877 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
10878# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10879 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
10880# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10881 end if
10882# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10883 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
10884# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10885 h = 0.0_wp
10886# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10887 lam = 1.0_wp
10888# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10889 amp = patch_icpp(patch_id)%a(2)
10890# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10891 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
10892# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10893 if (x_cc(i) > inth) then
10894# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10895 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
10896# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10897 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
10898# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10899 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
10900# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10901 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
10902# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10903 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
10904# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10905 end if
10906# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10907 case (302) ! 3D Jet with IGR
10908# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10909 ux_th = 10*sqrt(1.4*0.4)
10910# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10911 ux_am = 0.0*sqrt(1.4)
10912# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10913 p_th = 2.0_wp
10914# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10915 p_am = 1.0_wp
10916# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10917 rho_th = 1._wp
10918# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10919 rho_am = 1._wp
10920# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10921 y_th = 0.0_wp
10922# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10923 z_th = 0.0_wp
10924# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10925 r_th = 1._wp
10926# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10927 eps_smooth = 1._wp
10928# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10929 eps = 1e-6
10930# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10931
10932# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10933 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
10934# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10935 rcut = f_cut_on(r - r_th, eps_smooth)
10936# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10937 xcut = f_cut_on(x_cc(i), eps_smooth)
10938# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10939
10940# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10941 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
10942# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10943 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
10944# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10945 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
10946# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10947
10948# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10949 if (num_fluids == 1) then
10950# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10951 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
10952# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10953 else
10954# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10955 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
10956# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10957 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
10958# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10959 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))
10960# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10961 end if
10962# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10963
10964# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10965 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
10966# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10967 case (303) ! 3D Multijet
10968# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10969 eps_smooth = 3.0_wp
10970# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10971 ux_th = 10*sqrt(1.4*0.4)
10972# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10973 ux_am = 2.5*sqrt(1.4*0.4)
10974# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10975 p_th = 0.8_wp
10976# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10977 p_am = 0.4_wp
10978# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10979 rho_th = 1._wp
10980# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10981 rho_am = 1._wp
10982# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10983 eps = 1e-6
10984# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10985
10986# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10987 rcut = rcut_arr(j, k)
10988# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10989 xcut = f_cut_on(x_cc(i), eps_smooth)
10990# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10991
10992# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10993 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
10994# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10995 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
10996# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10997 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
10998# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10999
11000# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11001 if (num_fluids == 1) then
11002# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11003 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
11004# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11005 else
11006# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11007 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
11008# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11009 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
11010# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11011 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))
11012# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11013 end if
11014# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11015
11016# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11017 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
11018# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11019 case (304) ! 3D Interface from file cartesian
11020# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11021 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)))
11022# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11023
11024# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11025 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
11026# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11027 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
11028# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11029
11030# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11031 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)
11032# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11033 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)
11034# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11035
11036# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11037 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, &
11038# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11039 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
11040# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11041
11042# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11043 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
11044# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11045 case (305) ! 3D Interface from file axisymmetric
11046# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11047 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)))
11048# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11049
11050# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11051 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
11052# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11053 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
11054# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11055
11056# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11057 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
11058# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11059 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)
11060# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11061
11062# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11063 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, &
11064# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11065 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
11066# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11067
11068# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11069 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
11070# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11071 case (370) ! 3D extrusion of 2D profile from external data
11072# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11073 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
11074# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11075 if (.not. files_loaded) then
11076# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11077 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11078# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11079 do f = 1, max_files
11080# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11081 write (file_num_str, '(I0)') f
11082# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11083 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
11084# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11085 end do
11086# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11087
11088# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11089 ! Common file reading setup
11090# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11091 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11092# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11093 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11094# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11095
11096# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11097 select case (num_dims)
11098# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11099 case (1, 2) ! 1D and 2D cases are similar
11100# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11101 ! Count lines
11102# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11103 line_count = 0
11104# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11105 do
11106# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11107 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11108# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11109 if (ios2 /= 0) exit
11110# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11111 line_count = line_count + 1
11112# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11113 end do
11114# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11115 close (unit2)
11116# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11117
11118# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11119 xrows = line_count
11120# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11121 yrows = 1
11122# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11123 index_x = 0
11124# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11125 if (num_dims == 2) index_x = i
11126# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11127#ifdef MFC_DEBUG
11128# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11129 block
11130# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11131 use iso_fortran_env, only: output_unit
11132# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11133
11134# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11135 print *, 'm_icpp_patches.fpp:443: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11136# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11137
11138# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11139 call flush (output_unit)
11140# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11141 end block
11142# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11143#endif
11144# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11145 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11146# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11147
11148# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11149
11150# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11151
11152# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11153#if defined(MFC_OpenACC)
11154# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11155!$acc enter data create(x_coords, stored_values)
11156# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11157#elif defined(MFC_OpenMP)
11158# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11159!$omp target enter data map(always,alloc:x_coords, stored_values)
11160# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11161#endif
11162# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11163
11164# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11165 ! Read data from all files
11166# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11167 do f = 1, max_files
11168# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11169 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11170# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11171 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11172# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11173
11174# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11175 do iter = 1, xrows
11176# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11177 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11178# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11179 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11180# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11181 end do
11182# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11183 close (unit)
11184# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11185 end do
11186# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11187
11188# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11189 ! Calculate offsets
11190# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11191 domain_xstart = x_coords(1)
11192# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11193 x_step = x_cc(1) - x_cc(0)
11194# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11195 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
11196# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11197 global_offset_x = nint(abs(delta_x)/x_step)
11198# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11199 case (3) ! 3D case - determine grid structure
11200# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11201 ! Find yRows by counting rows with same x
11202# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11203 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11204# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11205 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11206# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11207
11208# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11209 yrows = 1
11210# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11211 do
11212# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11213 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11214# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11215 if (ios2 /= 0) exit
11216# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11217 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11218# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11219 yrows = yrows + 1
11220# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11221 else
11222# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11223 exit
11224# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11225 end if
11226# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11227 end do
11228# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11229 close (unit2)
11230# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11231
11232# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11233 ! Count total rows
11234# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11235 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11236# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11237 nrows = 0
11238# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11239 do
11240# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11241 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11242# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11243 if (ios2 /= 0) exit
11244# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11245 nrows = nrows + 1
11246# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11247 end do
11248# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11249 close (unit2)
11250# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11251
11252# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11253 xrows = nrows/yrows
11254# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11255#ifdef MFC_DEBUG
11256# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11257 block
11258# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11259 use iso_fortran_env, only: output_unit
11260# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11261
11262# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11263 print *, 'm_icpp_patches.fpp:443: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11264# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11265
11266# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11267 call flush (output_unit)
11268# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11269 end block
11270# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11271#endif
11272# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11273 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11274# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11275
11276# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11277
11278# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11279
11280# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11281
11282# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11283#if defined(MFC_OpenACC)
11284# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11285!$acc enter data create(x_coords, y_coords, stored_values)
11286# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11287#elif defined(MFC_OpenMP)
11288# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11289!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11290# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11291#endif
11292# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11293 index_x = i
11294# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11295 index_y = j
11296# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11297
11298# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11299 ! Read all files
11300# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11301 do f = 1, max_files
11302# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11303 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11304# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11305 if (ios /= 0) then
11306# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11307 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11308# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11309 cycle
11310# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11311 end if
11312# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11313
11314# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11315 iter = 0
11316# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11317 do iix = 1, xrows
11318# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11319 do iiy = 1, yrows
11320# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11321 iter = iter + 1
11322# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11323 if (f == 1) then
11324# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11325 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11326# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11327 else
11328# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11329 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11330# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11331 end if
11332# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11333 if (ios /= 0) call s_mpi_abort("Error reading data")
11334# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11335 end do
11336# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11337 end do
11338# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11339 close (unit)
11340# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11341 end do
11342# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11343
11344# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11345 ! Calculate offsets
11346# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11347 x_step = x_cc(1) - x_cc(0)
11348# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11349 y_step = y_cc(1) - y_cc(0)
11350# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11351 delta_x = x_cc(index_x) - x_coords(1)
11352# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11353 delta_y = y_cc(index_y) - y_coords(1)
11354# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11355 global_offset_x = nint(abs(delta_x)/x_step)
11356# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11357 global_offset_y = nint(abs(delta_y)/y_step)
11358# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11359
11360# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11361 ! The index check below only catches overruns, so a file that is merely too
11362# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11363 ! FINE stays in range and silently supplies a corner of itself. Check spacing
11364# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11365 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
11366# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11367 ! consecutive x values sit yRows apart.
11368# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11369 if (nrows > yrows) then
11370# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11371 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
11372# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11373 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
11374# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11375 end if
11376# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11377 if (yrows > 1) then
11378# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11379 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
11380# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11381 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
11382# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11383 end if
11384# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11385 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
11386# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11387 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
11388# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11389 & wp)) > 1.e-6_wp) &
11390# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11391 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
11392# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11393 end select
11394# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11395
11396# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11397 files_loaded = .true.
11398# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11399 end if
11400# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11401
11402# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11403 ! Data assignment
11404# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11405 select case (num_dims)
11406# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11407 case (1)
11408# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11409 idx = i + 1 + global_offset_x
11410# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11411 ! idx must land inside the file's row range: this rank's subdomain offset
11412# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11413 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
11414# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11415 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
11416# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11417 if (idx < 1 .or. idx > xrows) &
11418# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11419 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
11420# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11421 do f = 1, sys_size
11422# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11423 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11424# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11425 end do
11426# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11427 case (2)
11428# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11429 idx = i + 1 + global_offset_x - index_x
11430# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11431 if (idx < 1 .or. idx > xrows) &
11432# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11433 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
11434# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11435 do f = 1, sys_size - 1
11436# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11437 jump = merge(1, 0, f >= eqn_idx%mom%end)
11438# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11439 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11440# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11441 end do
11442# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11443 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
11444# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11445 case (3)
11446# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11447 idx = i + 1 + global_offset_x - index_x
11448# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11449 idy = j + 1 + global_offset_y - index_y
11450# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11451 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
11452# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11453 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
11454# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11455 do f = 1, sys_size - 1
11456# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11457 jump = merge(1, 0, f >= eqn_idx%mom%end)
11458# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11459 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11460# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11461 end do
11462# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11463 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
11464# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11465 end select
11466# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11467 case (371) ! hcid=370 + closed-form spanwise (z) modulation for genuine 3D content
11468# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11469 ! hcid=370's read extrudes the (x,y) file uniformly across z, leaving the flow
11470# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11471 ! z-invariant. Modulate the file's cross-stream (y) velocity by a z-dependent
11472# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11473 ! factor and set the spanwise (w) component from the result, so both inherit the
11474# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11475 ! file's shear-layer localization and amplitude scale. Streamwise (x) is left as
11476# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11477 ! read. This scales the whole y-velocity, which is the perturbation alone only
11478# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11479 ! when the base state has v == 0, as a temporal mixing layer does.
11480# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11481 !
11482# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11483 ! kz uses the GLOBAL z extent: p and z_cc(0:p) are per-rank under MPI, so a local
11484# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11485 ! extent would scale kz by num_procs_z and break periodicity at the z wrap.
11486# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11487 ! z_cc(k) is already absolute, so the phase needs no offset. Assumes uniform dz.
11488# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11489 if (.not. files_loaded) then
11490# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11491 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11492# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11493 do f = 1, max_files
11494# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11495 write (file_num_str, '(I0)') f
11496# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11497 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
11498# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11499 end do
11500# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11501
11502# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11503 ! Common file reading setup
11504# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11505 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11506# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11507 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
11508# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11509
11510# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11511 select case (num_dims)
11512# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11513 case (1, 2) ! 1D and 2D cases are similar
11514# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11515 ! Count lines
11516# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11517 line_count = 0
11518# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11519 do
11520# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11521 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11522# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11523 if (ios2 /= 0) exit
11524# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11525 line_count = line_count + 1
11526# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11527 end do
11528# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11529 close (unit2)
11530# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11531
11532# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11533 xrows = line_count
11534# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11535 yrows = 1
11536# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11537 index_x = 0
11538# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11539 if (num_dims == 2) index_x = i
11540# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11541#ifdef MFC_DEBUG
11542# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11543 block
11544# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11545 use iso_fortran_env, only: output_unit
11546# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11547
11548# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11549 print *, 'm_icpp_patches.fpp:443: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11550# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11551
11552# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11553 call flush (output_unit)
11554# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11555 end block
11556# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11557#endif
11558# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11559 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11560# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11561
11562# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11563
11564# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11565
11566# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11567#if defined(MFC_OpenACC)
11568# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11569!$acc enter data create(x_coords, stored_values)
11570# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11571#elif defined(MFC_OpenMP)
11572# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11573!$omp target enter data map(always,alloc:x_coords, stored_values)
11574# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11575#endif
11576# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11577
11578# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11579 ! Read data from all files
11580# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11581 do f = 1, max_files
11582# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11583 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11584# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11585 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11586# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11587
11588# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11589 do iter = 1, xrows
11590# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11591 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11592# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11593 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
11594# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11595 end do
11596# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11597 close (unit)
11598# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11599 end do
11600# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11601
11602# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11603 ! Calculate offsets
11604# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11605 domain_xstart = x_coords(1)
11606# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11607 x_step = x_cc(1) - x_cc(0)
11608# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11609 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
11610# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11611 global_offset_x = nint(abs(delta_x)/x_step)
11612# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11613 case (3) ! 3D case - determine grid structure
11614# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11615 ! Find yRows by counting rows with same x
11616# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11617 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11618# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11619 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11620# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11621
11622# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11623 yrows = 1
11624# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11625 do
11626# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11627 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11628# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11629 if (ios2 /= 0) exit
11630# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11631 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
11632# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11633 yrows = yrows + 1
11634# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11635 else
11636# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11637 exit
11638# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11639 end if
11640# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11641 end do
11642# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11643 close (unit2)
11644# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11645
11646# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11647 ! Count total rows
11648# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11649 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11650# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11651 nrows = 0
11652# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11653 do
11654# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11655 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11656# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11657 if (ios2 /= 0) exit
11658# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11659 nrows = nrows + 1
11660# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11661 end do
11662# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11663 close (unit2)
11664# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11665
11666# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11667 xrows = nrows/yrows
11668# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11669#ifdef MFC_DEBUG
11670# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11671 block
11672# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11673 use iso_fortran_env, only: output_unit
11674# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11675
11676# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11677 print *, 'm_icpp_patches.fpp:443: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11678# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11679
11680# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11681 call flush (output_unit)
11682# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11683 end block
11684# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11685#endif
11686# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11687 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11688# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11689
11690# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11691
11692# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11693
11694# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11695
11696# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11697#if defined(MFC_OpenACC)
11698# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11699!$acc enter data create(x_coords, y_coords, stored_values)
11700# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11701#elif defined(MFC_OpenMP)
11702# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11703!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11704# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11705#endif
11706# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11707 index_x = i
11708# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11709 index_y = j
11710# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11711
11712# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11713 ! Read all files
11714# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11715 do f = 1, max_files
11716# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11717 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11718# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11719 if (ios /= 0) then
11720# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11721 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
11722# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11723 cycle
11724# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11725 end if
11726# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11727
11728# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11729 iter = 0
11730# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11731 do iix = 1, xrows
11732# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11733 do iiy = 1, yrows
11734# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11735 iter = iter + 1
11736# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11737 if (f == 1) then
11738# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11739 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11740# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11741 else
11742# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11743 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11744# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11745 end if
11746# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11747 if (ios /= 0) call s_mpi_abort("Error reading data")
11748# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11749 end do
11750# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11751 end do
11752# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11753 close (unit)
11754# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11755 end do
11756# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11757
11758# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11759 ! Calculate offsets
11760# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11761 x_step = x_cc(1) - x_cc(0)
11762# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11763 y_step = y_cc(1) - y_cc(0)
11764# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11765 delta_x = x_cc(index_x) - x_coords(1)
11766# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11767 delta_y = y_cc(index_y) - y_coords(1)
11768# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11769 global_offset_x = nint(abs(delta_x)/x_step)
11770# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11771 global_offset_y = nint(abs(delta_y)/y_step)
11772# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11773
11774# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11775 ! The index check below only catches overruns, so a file that is merely too
11776# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11777 ! FINE stays in range and silently supplies a corner of itself. Check spacing
11778# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11779 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
11780# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11781 ! consecutive x values sit yRows apart.
11782# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11783 if (nrows > yrows) then
11784# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11785 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
11786# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11787 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
11788# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11789 end if
11790# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11791 if (yrows > 1) then
11792# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11793 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
11794# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11795 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
11796# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11797 end if
11798# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11799 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
11800# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11801 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
11802# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11803 & wp)) > 1.e-6_wp) &
11804# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11805 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
11806# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11807 end select
11808# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11809
11810# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11811 files_loaded = .true.
11812# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11813 end if
11814# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11815
11816# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11817 ! Data assignment
11818# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11819 select case (num_dims)
11820# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11821 case (1)
11822# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11823 idx = i + 1 + global_offset_x
11824# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11825 ! idx must land inside the file's row range: this rank's subdomain offset
11826# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11827 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
11828# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11829 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
11830# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11831 if (idx < 1 .or. idx > xrows) &
11832# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11833 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
11834# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11835 do f = 1, sys_size
11836# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11837 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11838# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11839 end do
11840# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11841 case (2)
11842# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11843 idx = i + 1 + global_offset_x - index_x
11844# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11845 if (idx < 1 .or. idx > xrows) &
11846# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11847 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
11848# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11849 do f = 1, sys_size - 1
11850# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11851 jump = merge(1, 0, f >= eqn_idx%mom%end)
11852# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11853 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11854# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11855 end do
11856# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11857 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
11858# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11859 case (3)
11860# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11861 idx = i + 1 + global_offset_x - index_x
11862# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11863 idy = j + 1 + global_offset_y - index_y
11864# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11865 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
11866# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11867 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
11868# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11869 do f = 1, sys_size - 1
11870# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11871 jump = merge(1, 0, f >= eqn_idx%mom%end)
11872# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11873 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11874# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11875 end do
11876# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11877 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
11878# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11879 end select
11880# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11881 zlen371 = real(p_glb + 1, wp)*(z_cb(0) - z_cb(-1))
11882# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11883 kz371 = 2._wp*pi/zlen371
11884# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11885 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*(1._wp + 0.5_wp*cos(kz371*z_cc(k)))
11886# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11887 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.5_wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*sin(kz371*z_cc(k) + pi/3._wp)
11888# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11889 case (380) ! Taylor-Green vortex
11890# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11891 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
11892# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11893 ! geometry 9
11894# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11895 mach = 0.1
11896# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11897 if (patch_id == 1) then
11898# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11899 q_prim_vf(eqn_idx%E)%sf(i, j, &
11900# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11901 & 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)
11902# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11903 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)
11904# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11905 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)
11906# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11907 end if
11908# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11909 case default
11910# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11911 call s_int_to_str(patch_id, istr)
11912# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11913 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
11914# 443 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11915 end select
11916# 444 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11917 end if
11918
11919 ! Updating the patch identities bookkeeping variable
11920 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
11921
11922 q_prim_vf(eqn_idx%alf)%sf(i, j, &
11923 & k) = patch_icpp(patch_id)%alpha(1)*exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
11924 end if
11925 end do
11926 end do
11927 end do
11928 if (allocated(stored_values)) then
11929# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11930#ifdef MFC_DEBUG
11931# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11932 block
11933# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11934 use iso_fortran_env, only: output_unit
11935# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11936
11937# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11938 print *, 'm_icpp_patches.fpp:455: ', '@:DEALLOCATE(stored_values)'
11939# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11940
11941# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11942 call flush (output_unit)
11943# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11944 end block
11945# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11946#endif
11947# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11948
11949# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11950#if defined(MFC_OpenACC)
11951# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11952!$acc exit data delete(stored_values)
11953# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11954#elif defined(MFC_OpenMP)
11955# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11956!$omp target exit data map(release:stored_values)
11957# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11958#endif
11959# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11960 deallocate (stored_values)
11961# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11962#ifdef MFC_DEBUG
11963# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11964 block
11965# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11966 use iso_fortran_env, only: output_unit
11967# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11968
11969# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11970 print *, 'm_icpp_patches.fpp:455: ', '@:DEALLOCATE(x_coords)'
11971# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11972
11973# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11974 call flush (output_unit)
11975# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11976 end block
11977# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11978#endif
11979# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11980
11981# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11982#if defined(MFC_OpenACC)
11983# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11984!$acc exit data delete(x_coords)
11985# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11986#elif defined(MFC_OpenMP)
11987# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11988!$omp target exit data map(release:x_coords)
11989# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11990#endif
11991# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11992 deallocate (x_coords)
11993# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11994 end if
11995# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11996
11997# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11998 if (allocated(y_coords)) then
11999# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12000#ifdef MFC_DEBUG
12001# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12002 block
12003# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12004 use iso_fortran_env, only: output_unit
12005# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12006
12007# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12008 print *, 'm_icpp_patches.fpp:455: ', '@:DEALLOCATE(y_coords)'
12009# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12010
12011# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12012 call flush (output_unit)
12013# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12014 end block
12015# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12016#endif
12017# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12018
12019# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12020#if defined(MFC_OpenACC)
12021# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12022!$acc exit data delete(y_coords)
12023# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12024#elif defined(MFC_OpenMP)
12025# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12026!$omp target exit data map(release:y_coords)
12027# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12028#endif
12029# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12030 deallocate (y_coords)
12031# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12032 end if
12033# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12034
12035# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12036 files_loaded = .false.
12037# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12038
12039# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12040 if (allocated(stored_values274)) then
12041# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12042#ifdef MFC_DEBUG
12043# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12044 block
12045# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12046 use iso_fortran_env, only: output_unit
12047# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12048
12049# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12050 print *, 'm_icpp_patches.fpp:455: ', '@:DEALLOCATE(stored_values274)'
12051# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12052
12053# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12054 call flush (output_unit)
12055# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12056 end block
12057# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12058#endif
12059# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12060
12061# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12062#if defined(MFC_OpenACC)
12063# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12064!$acc exit data delete(stored_values274)
12065# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12066#elif defined(MFC_OpenMP)
12067# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12068!$omp target exit data map(release:stored_values274)
12069# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12070#endif
12071# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12072 deallocate (stored_values274)
12073# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12074 end if
12075# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12076
12077# 455 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12078 files_loaded274 = .false.
12079# 456 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12080
12081 end subroutine s_icpp_3dvarcircle
12082
12083 !> The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
12084 !! Note that the elliptical patch DOES allow for the smoothing of its boundary
12085 subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
12086
12087 integer, intent(in) :: patch_id
12088
12089#ifdef MFC_MIXED_PRECISION
12090 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12091#else
12092 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
12093#endif
12094 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12095 integer :: i, j, k !< Generic loop operators
12096 real(wp) :: a, b
12097
12098 integer :: xRows, yRows, nRows, iix, iiy, max_files
12099# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12100 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
12101# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12102 real(wp) :: x_step, y_step
12103# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12104 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
12105# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12106 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
12107# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12108 real(wp) :: delta_x, delta_y
12109# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12110 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
12111# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12112 real(wp), allocatable :: stored_values(:,:,:)
12113# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12114 real(wp), allocatable :: x_coords(:), y_coords(:)
12115# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12116 logical :: files_loaded = .false.
12117# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12118 real(wp) :: domain_xstart
12119# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12120 character(len=20) :: file_num_str !< For storing the file number as a string
12121# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12122 integer :: ios
12123# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12124 integer :: ios2
12125# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12126
12127# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12128 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
12129# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12130 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
12131# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12132 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
12133# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12134 ! y_coords/files_loaded above.
12135# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12136 real(wp), allocatable, dimension(:,:,:) :: stored_values274
12137# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12138 logical :: files_loaded274 = .false.
12139# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12140 integer :: f274, ix274, iy274, unit274, ios274
12141# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12142 integer :: local_ix_beg274, local_iy_beg274
12143# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12144 character(len=300) :: fname274
12145# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12146 character(len=20) :: file_num_str274
12147# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12148 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
12149# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12150 real(wp) :: file_dx274, file_dy274, r_align274
12151# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12152 ! Place any declaration of intermediate variables here
12153# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12154 real(wp) :: eps, eps_mhd, C_mhd
12155# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12156 real(wp) :: r, rmax, gam, umax, p0
12157# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12158 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
12159# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12160 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
12161# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12162 real(wp) :: r0, alpha, r2
12163# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12164 real(wp) :: sinA, cosA
12165# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12166 real(wp) :: r_sq
12167# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12168
12169# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12170 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
12171# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12172 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
12173# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12174 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
12175# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12176 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
12177# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12178 integer :: igq, jgq
12179# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12180
12181# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12182 ! # 291 - Shear/Thermal Layer Case
12183# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12184 real(wp) :: delta_shear, u_max, u_mean
12185# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12186 real(wp) :: T_wall, T_inf, P_atm, T_loc
12187# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12188 real(wp) :: delta_th, R_mix
12189# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12190 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
12191# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12192 real(wp) :: bottom_blend_u, bottom_blend_T
12193# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12194
12195# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12196 ! # 207
12197# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12198 real(wp) :: sigma, gauss1, gauss2
12199# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12200
12201# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12202 ! # 208
12203# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12204 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
12205# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12206 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
12207# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12208 integer :: v, idx_lo, idx_hi, idx_mid
12209# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12210 real(wp), parameter :: Ly_param = 0.00775735_wp
12211# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12212 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
12213# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12214 integer, parameter :: Nwaves = 6
12215# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12216 real(wp), parameter :: y0_ref = 0.0_wp
12217# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12218
12219# 475 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12220 eps = 1.e-9_wp
12221# 476 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12222
12223 ! Transferring the elliptical patch's radii, centroid, smearing patch identity, and smearing coefficient information
12224 x_centroid = patch_icpp(patch_id)%x_centroid
12225 y_centroid = patch_icpp(patch_id)%y_centroid
12226 a = patch_icpp(patch_id)%radii(1)
12227 b = patch_icpp(patch_id)%radii(2)
12228 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12229 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12230
12231 ! Initialize eta=1; modified if smoothing is enabled
12232 eta = 1._wp
12233
12234 ! Assign patch vars if cell is covered and patch has write permission
12235 do j = 0, n
12236 do i = 0, m
12237 if (patch_icpp(patch_id)%smoothen) then
12238 eta = tanh(smooth_coeff/min(dx_min, &
12239 & dy_min)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((y_cc(j) - y_centroid)/b)**2) - 1._wp))*(-0.5_wp) &
12240 & + 0.5_wp
12241 end if
12242
12243 if ((f_is_inside_ellipse(x_cc(i) - x_centroid, y_cc(j) - y_centroid, [2._wp*a, 2._wp*b, &
12244 & 0._wp]) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
12245 & 0) == smooth_patch_id) then
12246 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
12247
12248
12249# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12250 if (patch_icpp(patch_id)%hcid /= dflt_int) then
12251 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
12252# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12253 case (200) ! Two-fluid cubic interface
12254# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12255 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
12256# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12257 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
12258# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12259 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
12260# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12261 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
12262# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12263 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
12264# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12265 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
12266# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12267 end if
12268# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12269 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
12270# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12271 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
12272# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12273 rmax = 0.2_wp
12274# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12275
12276# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12277 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
12278# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12279 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
12280# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12281 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
12282# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12283
12284# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12285 if (r < rmax) then
12286# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12287 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
12288# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12289 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
12290# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12291 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
12292# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12293 else if (r < 2*rmax) then
12294# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12295 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
12296# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12297 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
12298# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12299 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)))
12300# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12301 else
12302# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12303 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
12304# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12305 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
12306# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12307 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
12308# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12309 end if
12310# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12311 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
12312# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12313 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
12314# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12315 rmax = 0.2_wp
12316# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12317
12318# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12319 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
12320# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12321 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
12322# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12323 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
12324# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12325
12326# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12327 if (r < rmax) then
12328# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12329 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
12330# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12331 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
12332# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12333 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
12334# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12335 else if (r < 2*rmax) then
12336# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12337 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
12338# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12339 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
12340# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12341 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)))
12342# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12343 else
12344# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12345 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
12346# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12347 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
12348# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12349 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
12350# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12351 end if
12352# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12353
12354# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12355 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
12356# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12357 case (204) ! Rayleigh-Taylor instability
12358# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12359 rhoh = 3._wp
12360# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12361 rhol = 1._wp
12362# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12363 pref = 1.e5_wp
12364# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12365 pint = pref
12366# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12367 h = 0.7_wp
12368# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12369 lam = 0.2_wp
12370# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12371 wl = 2._wp*pi/lam
12372# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12373 amp = 0.05_wp/wl
12374# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12375
12376# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12377 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
12378# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12379
12380# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12381 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
12382# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12383
12384# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12385 if (alph < eps) alph = eps
12386# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12387 if (alph > 1._wp - eps) alph = 1._wp - eps
12388# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12389
12390# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12391 if (y_cc(j) > inth) then
12392# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12393 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
12394# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12395 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
12396# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12397 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
12398# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12399 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
12400# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12401 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
12402# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12403 else
12404# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12405 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
12406# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12407 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
12408# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12409 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
12410# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12411 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
12412# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12413 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
12414# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12415 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
12416# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12417 end if
12418# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12419 case (205) ! 2D lung wave interaction problem
12420# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12421 h = 0.0_wp ! non dim origin y
12422# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12423 lam = 1.0_wp ! non dim lambda
12424# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12425 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
12426# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12427
12428# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12429 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
12430# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12431
12432# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12433 if (y_cc(j) > inth) then
12434# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12435 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
12436# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12437 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
12438# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12439 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
12440# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12441 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
12442# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12443 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
12444# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12445 end if
12446# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12447 case (206) ! 2D lung wave interaction problem - horizontal domain
12448# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12449 h = 0.0_wp ! non dim origin y
12450# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12451 lam = 1.0_wp ! non dim lambda
12452# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12453 amp = patch_icpp(patch_id)%a(2)
12454# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12455
12456# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12457 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
12458# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12459
12460# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12461 if (x_cc(i) > intl) then ! this is the liquid
12462# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12463 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
12464# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12465 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
12466# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12467 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
12468# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12469 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
12470# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12471 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
12472# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12473 end if
12474# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12475 case (207) ! Kelvin Helmholtz Instability
12476# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12477 sigma = 0.05_wp/sqrt(2.0_wp)
12478# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12479 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
12480# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12481 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
12482# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12483 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)
12484# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12485 case (208) ! Richtmeyer Meshkov Instability
12486# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12487 lam = 1.0_wp
12488# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12489 eps = 1.0e-6_wp
12490# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12491 ei = 5.0_wp
12492# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12493 ! Smoothening function to smooth out sharp discontinuity in the interface
12494# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12495 if (x_cc(i) <= 0.7_wp*lam) then
12496# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12497 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
12498# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12499 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
12500# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12501 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
12502# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12503 alpha_sf6 = 1.0_wp - alpha_air
12504# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12505 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
12506# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12507 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
12508# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12509 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
12510# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12511 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
12512# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12513 end if
12514# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12515 case (250) ! MHD Orszag-Tang vortex
12516# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12517 ! 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),
12518# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12519 ! sin(4*pi*x)/sqrt(4*pi), 0)
12520# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12521
12522# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12523 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
12524# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12525 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
12526# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12527
12528# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12529 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
12530# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12531 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
12532# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12533 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
12534# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12535 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
12536# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12537 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
12538# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12539 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
12540# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12541 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
12542# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12543 ! Linear interpolation between r=0.08 and r=1.0
12544# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12545 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
12546# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12547 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
12548# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12549 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
12550# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12551 else
12552# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12553 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
12554# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12555 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
12556# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12557 end if
12558# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12559
12560# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12561 ! case 252 is for the 2D MHD Rotor problem
12562# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12563 case (252) ! 2D MHD Rotor Problem
12564# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12565 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
12566# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12567 !
12568# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12569 ! 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
12570# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12571 ! velocity w=20, giving v_tan=2 at r=0.1
12572# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12573
12574# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12575 ! Calculate distance squared from the center
12576# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12577 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
12578# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12579
12580# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12581 ! inner radius of 0.1
12582# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12583 if (r_sq <= 0.1**2) then
12584# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12585 ! -- Inside the rotor -- Set density uniformly to 10
12586# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12587 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
12588# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12589
12590# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12591 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
12592# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12593 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
12594# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12595 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
12596# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12597
12598# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12599 ! taper width of 0.015
12600# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12601 else if (r_sq <= 0.115**2) then
12602# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12603 ! linearly smooth the function between r = 0.1 and 0.115
12604# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12605 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
12606# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12607
12608# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12609 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)
12610# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12611 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)
12612# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12613 end if
12614# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12615 case (253) ! MHD Smooth Magnetic Vortex
12616# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12617 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
12618# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12619 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
12620# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12621
12622# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12623 ! velocity
12624# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12625 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))
12626# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12627 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))
12628# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12629
12630# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12631 ! magnetic field
12632# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12633 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)
12634# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12635 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)
12636# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12637
12638# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12639 ! pressure
12640# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12641 q_prim_vf(eqn_idx%E)%sf(i, j, &
12642# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12643 & 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)
12644# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12645 case (260) ! Gaussian Divergence Pulse
12646# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12647 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
12648# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12649 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
12650# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12651 ! initialized to zero everywhere.
12652# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12653
12654# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12655 eps_mhd = patch_icpp(patch_id)%a(2)
12656# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12657 sigma = patch_icpp(patch_id)%a(3)
12658# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12659 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
12660# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12661
12662# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12663 ! B-field
12664# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12665 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
12666# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12667 case (261) ! Blob
12668# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12669 r0 = 1._wp/sqrt(8._wp)
12670# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12671 r2 = x_cc(i)**2 + y_cc(j)**2
12672# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12673 r = sqrt(r2)
12674# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12675 alpha = r/r0
12676# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12677 if (alpha < 1) then
12678# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12679 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)
12680# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12681 end if
12682# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12683 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
12684# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12685 ! rotate by \alpha = atan(2)
12686# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12687 alpha = atan(2._wp)
12688# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12689 cosa = cos(alpha)
12690# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12691 sina = sin(alpha)
12692# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12693 ! projection along shock normal
12694# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12695 r = x_cc(i)*cosa + y_cc(j)*sina
12696# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12697
12698# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12699 if (r <= 0.5_wp) then
12700# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12701 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
12702# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12703 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
12704# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12705 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
12706# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12707 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
12708# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12709 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
12710# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12711 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
12712# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12713 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
12714# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12715 else
12716# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12717 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
12718# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12719 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
12720# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12721 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
12722# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12723 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
12724# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12725 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
12726# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12727 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
12728# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12729 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
12730# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12731 end if
12732# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12733 ! v^z and B^z remain zero by default
12734# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12735 case (270) ! 2D extrusion of 1D profile from external data
12736# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12737 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
12738# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12739 if (.not. files_loaded) then
12740# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12741 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12742# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12743 do f = 1, max_files
12744# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12745 write (file_num_str, '(I0)') f
12746# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12747 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
12748# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12749 end do
12750# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12751
12752# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12753 ! Common file reading setup
12754# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12755 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12756# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12757 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
12758# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12759
12760# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12761 select case (num_dims)
12762# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12763 case (1, 2) ! 1D and 2D cases are similar
12764# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12765 ! Count lines
12766# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12767 line_count = 0
12768# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12769 do
12770# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12771 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12772# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12773 if (ios2 /= 0) exit
12774# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12775 line_count = line_count + 1
12776# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12777 end do
12778# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12779 close (unit2)
12780# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12781
12782# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12783 xrows = line_count
12784# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12785 yrows = 1
12786# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12787 index_x = 0
12788# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12789 if (num_dims == 2) index_x = i
12790# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12791#ifdef MFC_DEBUG
12792# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12793 block
12794# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12795 use iso_fortran_env, only: output_unit
12796# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12797
12798# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12799 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12800# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12801
12802# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12803 call flush (output_unit)
12804# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12805 end block
12806# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12807#endif
12808# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12809 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12810# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12811
12812# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12813
12814# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12815
12816# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12817#if defined(MFC_OpenACC)
12818# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12819!$acc enter data create(x_coords, stored_values)
12820# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12821#elif defined(MFC_OpenMP)
12822# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12823!$omp target enter data map(always,alloc:x_coords, stored_values)
12824# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12825#endif
12826# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12827
12828# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12829 ! Read data from all files
12830# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12831 do f = 1, max_files
12832# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12833 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12834# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12835 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12836# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12837
12838# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12839 do iter = 1, xrows
12840# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12841 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
12842# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12843 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
12844# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12845 end do
12846# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12847 close (unit)
12848# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12849 end do
12850# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12851
12852# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12853 ! Calculate offsets
12854# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12855 domain_xstart = x_coords(1)
12856# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12857 x_step = x_cc(1) - x_cc(0)
12858# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12859 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
12860# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12861 global_offset_x = nint(abs(delta_x)/x_step)
12862# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12863 case (3) ! 3D case - determine grid structure
12864# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12865 ! Find yRows by counting rows with same x
12866# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12867 read (unit2, *, iostat=ios2) x0, y0, dummy_z
12868# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12869 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
12870# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12871
12872# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12873 yrows = 1
12874# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12875 do
12876# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12877 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12878# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12879 if (ios2 /= 0) exit
12880# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12881 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
12882# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12883 yrows = yrows + 1
12884# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12885 else
12886# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12887 exit
12888# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12889 end if
12890# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12891 end do
12892# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12893 close (unit2)
12894# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12895
12896# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12897 ! Count total rows
12898# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12899 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12900# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12901 nrows = 0
12902# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12903 do
12904# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12905 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12906# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12907 if (ios2 /= 0) exit
12908# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12909 nrows = nrows + 1
12910# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12911 end do
12912# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12913 close (unit2)
12914# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12915
12916# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12917 xrows = nrows/yrows
12918# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12919#ifdef MFC_DEBUG
12920# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12921 block
12922# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12923 use iso_fortran_env, only: output_unit
12924# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12925
12926# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12927 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12928# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12929
12930# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12931 call flush (output_unit)
12932# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12933 end block
12934# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12935#endif
12936# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12937 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12938# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12939
12940# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12941
12942# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12943
12944# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12945
12946# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12947#if defined(MFC_OpenACC)
12948# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12949!$acc enter data create(x_coords, y_coords, stored_values)
12950# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12951#elif defined(MFC_OpenMP)
12952# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12953!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12954# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12955#endif
12956# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12957 index_x = i
12958# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12959 index_y = j
12960# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12961
12962# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12963 ! Read all files
12964# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12965 do f = 1, max_files
12966# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12967 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12968# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12969 if (ios /= 0) then
12970# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12971 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
12972# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12973 cycle
12974# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12975 end if
12976# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12977
12978# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12979 iter = 0
12980# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12981 do iix = 1, xrows
12982# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12983 do iiy = 1, yrows
12984# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12985 iter = iter + 1
12986# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12987 if (f == 1) then
12988# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12989 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12990# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12991 else
12992# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12993 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12994# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12995 end if
12996# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12997 if (ios /= 0) call s_mpi_abort("Error reading data")
12998# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12999 end do
13000# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13001 end do
13002# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13003 close (unit)
13004# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13005 end do
13006# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13007
13008# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13009 ! Calculate offsets
13010# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13011 x_step = x_cc(1) - x_cc(0)
13012# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13013 y_step = y_cc(1) - y_cc(0)
13014# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13015 delta_x = x_cc(index_x) - x_coords(1)
13016# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13017 delta_y = y_cc(index_y) - y_coords(1)
13018# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13019 global_offset_x = nint(abs(delta_x)/x_step)
13020# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13021 global_offset_y = nint(abs(delta_y)/y_step)
13022# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13023
13024# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13025 ! The index check below only catches overruns, so a file that is merely too
13026# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13027 ! FINE stays in range and silently supplies a corner of itself. Check spacing
13028# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13029 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
13030# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13031 ! consecutive x values sit yRows apart.
13032# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13033 if (nrows > yrows) then
13034# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13035 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
13036# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13037 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
13038# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13039 end if
13040# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13041 if (yrows > 1) then
13042# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13043 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
13044# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13045 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
13046# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13047 end if
13048# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13049 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
13050# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13051 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
13052# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13053 & wp)) > 1.e-6_wp) &
13054# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13055 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
13056# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13057 end select
13058# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13059
13060# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13061 files_loaded = .true.
13062# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13063 end if
13064# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13065
13066# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13067 ! Data assignment
13068# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13069 select case (num_dims)
13070# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13071 case (1)
13072# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13073 idx = i + 1 + global_offset_x
13074# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13075 ! idx must land inside the file's row range: this rank's subdomain offset
13076# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13077 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
13078# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13079 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
13080# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13081 if (idx < 1 .or. idx > xrows) &
13082# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13083 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
13084# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13085 do f = 1, sys_size
13086# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13087 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13088# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13089 end do
13090# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13091 case (2)
13092# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13093 idx = i + 1 + global_offset_x - index_x
13094# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13095 if (idx < 1 .or. idx > xrows) &
13096# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13097 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
13098# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13099 do f = 1, sys_size - 1
13100# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13101 jump = merge(1, 0, f >= eqn_idx%mom%end)
13102# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13103 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13104# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13105 end do
13106# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13107 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13108# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13109 case (3)
13110# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13111 idx = i + 1 + global_offset_x - index_x
13112# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13113 idy = j + 1 + global_offset_y - index_y
13114# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13115 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
13116# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13117 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
13118# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13119 do f = 1, sys_size - 1
13120# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13121 jump = merge(1, 0, f >= eqn_idx%mom%end)
13122# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13123 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13124# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13125 end do
13126# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13127 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
13128# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13129 end select
13130# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13131 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
13132# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13133 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
13134# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13135 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
13136# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13137 ! cross-stream-position profile (real cross-stream velocity is legitimately
13138# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13139 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
13140# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13141 ! zero out mom%beg's true physical value.
13142# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13143 if (.not. files_loaded) then
13144# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13145 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13146# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13147 do f = 1, max_files
13148# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13149 write (file_num_str, '(I0)') f
13150# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13151 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
13152# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13153 end do
13154# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13155
13156# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13157 ! Common file reading setup
13158# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13159 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13160# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13161 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
13162# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13163
13164# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13165 select case (num_dims)
13166# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13167 case (1, 2) ! 1D and 2D cases are similar
13168# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13169 ! Count lines
13170# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13171 line_count = 0
13172# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13173 do
13174# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13175 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13176# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13177 if (ios2 /= 0) exit
13178# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13179 line_count = line_count + 1
13180# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13181 end do
13182# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13183 close (unit2)
13184# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13185
13186# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13187 xrows = line_count
13188# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13189 yrows = 1
13190# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13191 index_x = 0
13192# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13193 if (num_dims == 2) index_x = i
13194# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13195#ifdef MFC_DEBUG
13196# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13197 block
13198# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13199 use iso_fortran_env, only: output_unit
13200# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13201
13202# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13203 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13204# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13205
13206# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13207 call flush (output_unit)
13208# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13209 end block
13210# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13211#endif
13212# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13213 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13214# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13215
13216# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13217
13218# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13219
13220# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13221#if defined(MFC_OpenACC)
13222# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13223!$acc enter data create(x_coords, stored_values)
13224# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13225#elif defined(MFC_OpenMP)
13226# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13227!$omp target enter data map(always,alloc:x_coords, stored_values)
13228# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13229#endif
13230# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13231
13232# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13233 ! Read data from all files
13234# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13235 do f = 1, max_files
13236# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13237 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13238# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13239 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13240# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13241
13242# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13243 do iter = 1, xrows
13244# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13245 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13246# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13247 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13248# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13249 end do
13250# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13251 close (unit)
13252# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13253 end do
13254# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13255
13256# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13257 ! Calculate offsets
13258# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13259 domain_xstart = x_coords(1)
13260# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13261 x_step = x_cc(1) - x_cc(0)
13262# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13263 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
13264# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13265 global_offset_x = nint(abs(delta_x)/x_step)
13266# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13267 case (3) ! 3D case - determine grid structure
13268# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13269 ! Find yRows by counting rows with same x
13270# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13271 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13272# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13273 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13274# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13275
13276# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13277 yrows = 1
13278# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13279 do
13280# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13281 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13282# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13283 if (ios2 /= 0) exit
13284# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13285 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13286# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13287 yrows = yrows + 1
13288# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13289 else
13290# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13291 exit
13292# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13293 end if
13294# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13295 end do
13296# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13297 close (unit2)
13298# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13299
13300# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13301 ! Count total rows
13302# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13303 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13304# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13305 nrows = 0
13306# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13307 do
13308# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13309 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13310# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13311 if (ios2 /= 0) exit
13312# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13313 nrows = nrows + 1
13314# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13315 end do
13316# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13317 close (unit2)
13318# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13319
13320# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13321 xrows = nrows/yrows
13322# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13323#ifdef MFC_DEBUG
13324# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13325 block
13326# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13327 use iso_fortran_env, only: output_unit
13328# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13329
13330# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13331 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13332# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13333
13334# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13335 call flush (output_unit)
13336# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13337 end block
13338# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13339#endif
13340# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13341 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13342# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13343
13344# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13345
13346# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13347
13348# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13349
13350# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13351#if defined(MFC_OpenACC)
13352# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13353!$acc enter data create(x_coords, y_coords, stored_values)
13354# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13355#elif defined(MFC_OpenMP)
13356# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13357!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13358# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13359#endif
13360# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13361 index_x = i
13362# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13363 index_y = j
13364# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13365
13366# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13367 ! Read all files
13368# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13369 do f = 1, max_files
13370# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13371 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13372# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13373 if (ios /= 0) then
13374# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13375 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13376# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13377 cycle
13378# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13379 end if
13380# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13381
13382# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13383 iter = 0
13384# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13385 do iix = 1, xrows
13386# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13387 do iiy = 1, yrows
13388# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13389 iter = iter + 1
13390# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13391 if (f == 1) then
13392# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13393 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13394# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13395 else
13396# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13397 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13398# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13399 end if
13400# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13401 if (ios /= 0) call s_mpi_abort("Error reading data")
13402# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13403 end do
13404# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13405 end do
13406# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13407 close (unit)
13408# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13409 end do
13410# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13411
13412# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13413 ! Calculate offsets
13414# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13415 x_step = x_cc(1) - x_cc(0)
13416# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13417 y_step = y_cc(1) - y_cc(0)
13418# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13419 delta_x = x_cc(index_x) - x_coords(1)
13420# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13421 delta_y = y_cc(index_y) - y_coords(1)
13422# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13423 global_offset_x = nint(abs(delta_x)/x_step)
13424# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13425 global_offset_y = nint(abs(delta_y)/y_step)
13426# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13427
13428# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13429 ! The index check below only catches overruns, so a file that is merely too
13430# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13431 ! FINE stays in range and silently supplies a corner of itself. Check spacing
13432# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13433 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
13434# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13435 ! consecutive x values sit yRows apart.
13436# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13437 if (nrows > yrows) then
13438# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13439 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
13440# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13441 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
13442# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13443 end if
13444# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13445 if (yrows > 1) then
13446# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13447 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
13448# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13449 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
13450# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13451 end if
13452# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13453 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
13454# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13455 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
13456# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13457 & wp)) > 1.e-6_wp) &
13458# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13459 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
13460# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13461 end select
13462# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13463
13464# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13465 files_loaded = .true.
13466# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13467 end if
13468# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13469
13470# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13471 ! Data assignment
13472# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13473 select case (num_dims)
13474# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13475 case (1)
13476# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13477 idx = i + 1 + global_offset_x
13478# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13479 ! idx must land inside the file's row range: this rank's subdomain offset
13480# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13481 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
13482# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13483 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
13484# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13485 if (idx < 1 .or. idx > xrows) &
13486# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13487 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
13488# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13489 do f = 1, sys_size
13490# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13491 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13492# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13493 end do
13494# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13495 case (2)
13496# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13497 idx = i + 1 + global_offset_x - index_x
13498# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13499 if (idx < 1 .or. idx > xrows) &
13500# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13501 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
13502# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13503 do f = 1, sys_size - 1
13504# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13505 jump = merge(1, 0, f >= eqn_idx%mom%end)
13506# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13507 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13508# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13509 end do
13510# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13511 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
13512# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13513 case (3)
13514# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13515 idx = i + 1 + global_offset_x - index_x
13516# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13517 idy = j + 1 + global_offset_y - index_y
13518# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13519 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
13520# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13521 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
13522# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13523 do f = 1, sys_size - 1
13524# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13525 jump = merge(1, 0, f >= eqn_idx%mom%end)
13526# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13527 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13528# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13529 end do
13530# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13531 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
13532# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13533 end select
13534# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13535 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
13536# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13537 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
13538# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13539 case (274) ! Full 2D field from external data (no extrusion)
13540# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13541 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
13542# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13543 ! extrusion direction and no zeroed component -- all sys_size variables are read and
13544# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13545 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
13546# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13547 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
13548# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13549 ! global grid exactly -- by construction, since the IC generator derives both the
13550# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13551 ! grid and the file contents from the same computation.
13552# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13553 !
13554# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13555 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
13556# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13557 ! file's own first coordinate and this rank's uniform grid spacing -- following the
13558# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13559 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
13560# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13561 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
13562# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13563 ! returns before allocating it otherwise), so a serial-IO run (the default for
13564# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13565 ! golden-file tests) would index into an unallocated array.
13566# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13567 !
13568# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13569 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
13570# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13571 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
13572# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13573 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
13574# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13575 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
13576# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13577 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
13578# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13579 ! global cell offset) are pinned from f274==1's very first record, before any other
13580# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13581 ! record is read, so every subsequent record -- across all variables -- can be tested
13582# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13583 ! against this rank's range and dropped if it falls outside it.
13584# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13585 x_step274 = x_cc(1) - x_cc(0)
13586# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13587 y_step274 = y_cc(1) - y_cc(0)
13588# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13589
13590# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13591 if (.not. files_loaded274) then
13592# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13593#ifdef MFC_DEBUG
13594# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13595 block
13596# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13597 use iso_fortran_env, only: output_unit
13598# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13599
13600# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13601 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
13602# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13603
13604# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13605 call flush (output_unit)
13606# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13607 end block
13608# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13609#endif
13610# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13611 allocate (stored_values274(0:m, 0:n, sys_size))
13612# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13613
13614# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13615
13616# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13617#if defined(MFC_OpenACC)
13618# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13619!$acc enter data create(stored_values274)
13620# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13621#elif defined(MFC_OpenMP)
13622# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13623!$omp target enter data map(always,alloc:stored_values274)
13624# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13625#endif
13626# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13627 do f274 = 1, sys_size
13628# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13629 write (file_num_str274, '(I0)') f274
13630# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13631 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
13632# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13633 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
13634# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13635 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
13636# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13637 do ix274 = 0, m_glb
13638# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13639 do iy274 = 0, n_glb
13640# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13641 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
13642# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13643 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
13644# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13645 ! Capture the file's own origin and spacing from its first records so we can
13646# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13647 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
13648# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13649 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
13650# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13651 if (f274 == 1) then
13652# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13653 if (ix274 == 0 .and. iy274 == 0) then
13654# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13655 x0_274 = dummy_x274
13656# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13657 y0_274 = dummy_y274
13658# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13659 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
13660# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13661 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
13662# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13663 end if
13664# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13665 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
13666# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13667 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
13668# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13669 end if
13670# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13671 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
13672# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13673 & .and. iy274 - local_iy_beg274 <= n) then
13674# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13675 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
13676# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13677 end if
13678# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13679 end do
13680# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13681 end do
13682# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13683 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
13684# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13685 ! read means it was generated for a larger grid and would be silently misread.
13686# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13687 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
13688# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13689 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
13690# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13691 close (unit274)
13692# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13693 end do
13694# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13695
13696# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13697 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
13698# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13699 ! Check alignment via the integer cell offset of this rank's first cell from the file
13700# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13701 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
13702# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13703 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
13704# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13705 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
13706# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13707 ! the global origin.) The spacing checks below must also hold.
13708# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13709 r_align274 = (x_cc(0) - x0_274)/x_step274
13710# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13711 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
13712# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13713 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
13714# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13715 if (m_glb >= 1) then
13716# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13717 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
13718# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13719 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
13720# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13721 end if
13722# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13723 if (n_glb >= 1) then
13724# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13725 r_align274 = (y_cc(0) - y0_274)/y_step274
13726# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13727 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
13728# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13729 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
13730# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13731 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
13732# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13733 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
13734# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13735 end if
13736# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13737
13738# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13739 files_loaded274 = .true.
13740# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13741 end if
13742# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13743 ! Alignment is verified above (or this rank would already have aborted), so the local
13744# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13745 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
13746# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13747 do f274 = 1, sys_size
13748# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13749 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
13750# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13751 end do
13752# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13753 case (271) ! Premixed Flame Vortices Interaction
13754# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13755 if (.not. files_loaded) then
13756# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13757 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13758# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13759 do f = 1, max_files
13760# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13761 write (file_num_str, '(I0)') f
13762# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13763 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
13764# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13765 end do
13766# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13767
13768# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13769 ! Common file reading setup
13770# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13771 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13772# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13773 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
13774# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13775
13776# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13777 select case (num_dims)
13778# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13779 case (1, 2) ! 1D and 2D cases are similar
13780# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13781 ! Count lines
13782# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13783 line_count = 0
13784# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13785 do
13786# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13787 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13788# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13789 if (ios2 /= 0) exit
13790# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13791 line_count = line_count + 1
13792# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13793 end do
13794# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13795 close (unit2)
13796# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13797
13798# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13799 xrows = line_count
13800# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13801 yrows = 1
13802# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13803 index_x = 0
13804# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13805 if (num_dims == 2) index_x = i
13806# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13807#ifdef MFC_DEBUG
13808# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13809 block
13810# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13811 use iso_fortran_env, only: output_unit
13812# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13813
13814# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13815 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13816# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13817
13818# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13819 call flush (output_unit)
13820# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13821 end block
13822# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13823#endif
13824# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13825 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13826# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13827
13828# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13829
13830# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13831
13832# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13833#if defined(MFC_OpenACC)
13834# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13835!$acc enter data create(x_coords, stored_values)
13836# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13837#elif defined(MFC_OpenMP)
13838# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13839!$omp target enter data map(always,alloc:x_coords, stored_values)
13840# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13841#endif
13842# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13843
13844# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13845 ! Read data from all files
13846# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13847 do f = 1, max_files
13848# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13849 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13850# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13851 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13852# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13853
13854# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13855 do iter = 1, xrows
13856# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13857 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13858# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13859 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
13860# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13861 end do
13862# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13863 close (unit)
13864# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13865 end do
13866# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13867
13868# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13869 ! Calculate offsets
13870# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13871 domain_xstart = x_coords(1)
13872# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13873 x_step = x_cc(1) - x_cc(0)
13874# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13875 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
13876# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13877 global_offset_x = nint(abs(delta_x)/x_step)
13878# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13879 case (3) ! 3D case - determine grid structure
13880# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13881 ! Find yRows by counting rows with same x
13882# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13883 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13884# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13885 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13886# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13887
13888# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13889 yrows = 1
13890# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13891 do
13892# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13893 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13894# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13895 if (ios2 /= 0) exit
13896# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13897 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
13898# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13899 yrows = yrows + 1
13900# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13901 else
13902# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13903 exit
13904# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13905 end if
13906# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13907 end do
13908# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13909 close (unit2)
13910# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13911
13912# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13913 ! Count total rows
13914# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13915 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13916# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13917 nrows = 0
13918# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13919 do
13920# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13921 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13922# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13923 if (ios2 /= 0) exit
13924# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13925 nrows = nrows + 1
13926# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13927 end do
13928# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13929 close (unit2)
13930# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13931
13932# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13933 xrows = nrows/yrows
13934# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13935#ifdef MFC_DEBUG
13936# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13937 block
13938# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13939 use iso_fortran_env, only: output_unit
13940# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13941
13942# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13943 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13944# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13945
13946# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13947 call flush (output_unit)
13948# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13949 end block
13950# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13951#endif
13952# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13953 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13954# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13955
13956# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13957
13958# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13959
13960# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13961
13962# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13963#if defined(MFC_OpenACC)
13964# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13965!$acc enter data create(x_coords, y_coords, stored_values)
13966# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13967#elif defined(MFC_OpenMP)
13968# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13969!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13970# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13971#endif
13972# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13973 index_x = i
13974# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13975 index_y = j
13976# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13977
13978# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13979 ! Read all files
13980# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13981 do f = 1, max_files
13982# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13983 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13984# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13985 if (ios /= 0) then
13986# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13987 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
13988# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13989 cycle
13990# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13991 end if
13992# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13993
13994# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13995 iter = 0
13996# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13997 do iix = 1, xrows
13998# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13999 do iiy = 1, yrows
14000# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14001 iter = iter + 1
14002# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14003 if (f == 1) then
14004# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14005 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14006# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14007 else
14008# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14009 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14010# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14011 end if
14012# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14013 if (ios /= 0) call s_mpi_abort("Error reading data")
14014# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14015 end do
14016# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14017 end do
14018# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14019 close (unit)
14020# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14021 end do
14022# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14023
14024# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14025 ! Calculate offsets
14026# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14027 x_step = x_cc(1) - x_cc(0)
14028# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14029 y_step = y_cc(1) - y_cc(0)
14030# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14031 delta_x = x_cc(index_x) - x_coords(1)
14032# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14033 delta_y = y_cc(index_y) - y_coords(1)
14034# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14035 global_offset_x = nint(abs(delta_x)/x_step)
14036# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14037 global_offset_y = nint(abs(delta_y)/y_step)
14038# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14039
14040# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14041 ! The index check below only catches overruns, so a file that is merely too
14042# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14043 ! FINE stays in range and silently supplies a corner of itself. Check spacing
14044# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14045 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
14046# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14047 ! consecutive x values sit yRows apart.
14048# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14049 if (nrows > yrows) then
14050# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14051 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
14052# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14053 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
14054# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14055 end if
14056# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14057 if (yrows > 1) then
14058# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14059 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
14060# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14061 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
14062# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14063 end if
14064# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14065 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
14066# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14067 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
14068# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14069 & wp)) > 1.e-6_wp) &
14070# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14071 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
14072# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14073 end select
14074# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14075
14076# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14077 files_loaded = .true.
14078# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14079 end if
14080# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14081
14082# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14083 ! Data assignment
14084# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14085 select case (num_dims)
14086# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14087 case (1)
14088# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14089 idx = i + 1 + global_offset_x
14090# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14091 ! idx must land inside the file's row range: this rank's subdomain offset
14092# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14093 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
14094# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14095 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
14096# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14097 if (idx < 1 .or. idx > xrows) &
14098# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14099 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
14100# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14101 do f = 1, sys_size
14102# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14103 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14104# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14105 end do
14106# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14107 case (2)
14108# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14109 idx = i + 1 + global_offset_x - index_x
14110# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14111 if (idx < 1 .or. idx > xrows) &
14112# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14113 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
14114# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14115 do f = 1, sys_size - 1
14116# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14117 jump = merge(1, 0, f >= eqn_idx%mom%end)
14118# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14119 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14120# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14121 end do
14122# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14123 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14124# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14125 case (3)
14126# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14127 idx = i + 1 + global_offset_x - index_x
14128# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14129 idy = j + 1 + global_offset_y - index_y
14130# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14131 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
14132# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14133 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
14134# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14135 do f = 1, sys_size - 1
14136# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14137 jump = merge(1, 0, f >= eqn_idx%mom%end)
14138# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14139 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14140# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14141 end do
14142# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14143 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
14144# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14145 end select
14146# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14147 x1c = 0.0027_wp
14148# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14149 y1c = 0.005_wp
14150# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14151 x2c = 0.0027_wp
14152# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14153 y2c = 0.003_wp
14154# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14155 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
14156# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14157 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
14158# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14159 rvortex = 0.0005_wp
14160# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14161 cvortex = 6000.0_wp
14162# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14163
14164# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14165 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
14166# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14167 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
14168# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14169
14170# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14171 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
14172# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14173 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
14174# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14175 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
14176# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14177 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
14178# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14179 case (272) ! Premixed Flame Instability
14180# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14181 if (.not. files_loaded) then
14182# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14183 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
14184# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14185 do f = 1, max_files
14186# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14187 write (file_num_str, '(I0)') f
14188# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14189 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
14190# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14191 end do
14192# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14193
14194# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14195 ! Common file reading setup
14196# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14197 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14198# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14199 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
14200# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14201
14202# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14203 select case (num_dims)
14204# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14205 case (1, 2) ! 1D and 2D cases are similar
14206# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14207 ! Count lines
14208# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14209 line_count = 0
14210# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14211 do
14212# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14213 read (unit2, *, iostat=ios2) dummy_x, dummy_y
14214# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14215 if (ios2 /= 0) exit
14216# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14217 line_count = line_count + 1
14218# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14219 end do
14220# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14221 close (unit2)
14222# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14223
14224# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14225 xrows = line_count
14226# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14227 yrows = 1
14228# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14229 index_x = 0
14230# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14231 if (num_dims == 2) index_x = i
14232# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14233#ifdef MFC_DEBUG
14234# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14235 block
14236# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14237 use iso_fortran_env, only: output_unit
14238# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14239
14240# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14241 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
14242# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14243
14244# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14245 call flush (output_unit)
14246# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14247 end block
14248# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14249#endif
14250# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14251 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
14252# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14253
14254# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14255
14256# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14257
14258# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14259#if defined(MFC_OpenACC)
14260# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14261!$acc enter data create(x_coords, stored_values)
14262# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14263#elif defined(MFC_OpenMP)
14264# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14265!$omp target enter data map(always,alloc:x_coords, stored_values)
14266# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14267#endif
14268# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14269
14270# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14271 ! Read data from all files
14272# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14273 do f = 1, max_files
14274# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14275 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14276# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14277 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14278# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14279
14280# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14281 do iter = 1, xrows
14282# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14283 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
14284# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14285 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
14286# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14287 end do
14288# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14289 close (unit)
14290# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14291 end do
14292# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14293
14294# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14295 ! Calculate offsets
14296# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14297 domain_xstart = x_coords(1)
14298# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14299 x_step = x_cc(1) - x_cc(0)
14300# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14301 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
14302# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14303 global_offset_x = nint(abs(delta_x)/x_step)
14304# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14305 case (3) ! 3D case - determine grid structure
14306# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14307 ! Find yRows by counting rows with same x
14308# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14309 read (unit2, *, iostat=ios2) x0, y0, dummy_z
14310# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14311 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
14312# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14313
14314# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14315 yrows = 1
14316# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14317 do
14318# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14319 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14320# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14321 if (ios2 /= 0) exit
14322# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14323 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
14324# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14325 yrows = yrows + 1
14326# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14327 else
14328# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14329 exit
14330# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14331 end if
14332# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14333 end do
14334# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14335 close (unit2)
14336# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14337
14338# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14339 ! Count total rows
14340# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14341 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14342# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14343 nrows = 0
14344# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14345 do
14346# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14347 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14348# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14349 if (ios2 /= 0) exit
14350# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14351 nrows = nrows + 1
14352# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14353 end do
14354# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14355 close (unit2)
14356# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14357
14358# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14359 xrows = nrows/yrows
14360# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14361#ifdef MFC_DEBUG
14362# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14363 block
14364# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14365 use iso_fortran_env, only: output_unit
14366# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14367
14368# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14369 print *, 'm_icpp_patches.fpp:504: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14370# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14371
14372# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14373 call flush (output_unit)
14374# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14375 end block
14376# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14377#endif
14378# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14379 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14380# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14381
14382# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14383
14384# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14385
14386# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14387
14388# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14389#if defined(MFC_OpenACC)
14390# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14391!$acc enter data create(x_coords, y_coords, stored_values)
14392# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14393#elif defined(MFC_OpenMP)
14394# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14395!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14396# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14397#endif
14398# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14399 index_x = i
14400# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14401 index_y = j
14402# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14403
14404# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14405 ! Read all files
14406# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14407 do f = 1, max_files
14408# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14409 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14410# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14411 if (ios /= 0) then
14412# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14413 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
14414# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14415 cycle
14416# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14417 end if
14418# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14419
14420# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14421 iter = 0
14422# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14423 do iix = 1, xrows
14424# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14425 do iiy = 1, yrows
14426# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14427 iter = iter + 1
14428# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14429 if (f == 1) then
14430# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14431 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14432# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14433 else
14434# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14435 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14436# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14437 end if
14438# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14439 if (ios /= 0) call s_mpi_abort("Error reading data")
14440# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14441 end do
14442# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14443 end do
14444# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14445 close (unit)
14446# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14447 end do
14448# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14449
14450# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14451 ! Calculate offsets
14452# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14453 x_step = x_cc(1) - x_cc(0)
14454# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14455 y_step = y_cc(1) - y_cc(0)
14456# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14457 delta_x = x_cc(index_x) - x_coords(1)
14458# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14459 delta_y = y_cc(index_y) - y_coords(1)
14460# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14461 global_offset_x = nint(abs(delta_x)/x_step)
14462# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14463 global_offset_y = nint(abs(delta_y)/y_step)
14464# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14465
14466# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14467 ! The index check below only catches overruns, so a file that is merely too
14468# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14469 ! FINE stays in range and silently supplies a corner of itself. Check spacing
14470# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14471 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
14472# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14473 ! consecutive x values sit yRows apart.
14474# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14475 if (nrows > yrows) then
14476# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14477 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
14478# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14479 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
14480# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14481 end if
14482# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14483 if (yrows > 1) then
14484# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14485 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
14486# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14487 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
14488# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14489 end if
14490# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14491 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
14492# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14493 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
14494# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14495 & wp)) > 1.e-6_wp) &
14496# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14497 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
14498# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14499 end select
14500# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14501
14502# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14503 files_loaded = .true.
14504# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14505 end if
14506# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14507
14508# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14509 ! Data assignment
14510# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14511 select case (num_dims)
14512# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14513 case (1)
14514# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14515 idx = i + 1 + global_offset_x
14516# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14517 ! idx must land inside the file's row range: this rank's subdomain offset
14518# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14519 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
14520# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14521 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
14522# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14523 if (idx < 1 .or. idx > xrows) &
14524# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14525 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
14526# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14527 do f = 1, sys_size
14528# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14529 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14530# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14531 end do
14532# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14533 case (2)
14534# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14535 idx = i + 1 + global_offset_x - index_x
14536# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14537 if (idx < 1 .or. idx > xrows) &
14538# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14539 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
14540# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14541 do f = 1, sys_size - 1
14542# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14543 jump = merge(1, 0, f >= eqn_idx%mom%end)
14544# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14545 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14546# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14547 end do
14548# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14549 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14550# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14551 case (3)
14552# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14553 idx = i + 1 + global_offset_x - index_x
14554# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14555 idy = j + 1 + global_offset_y - index_y
14556# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14557 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
14558# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14559 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
14560# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14561 do f = 1, sys_size - 1
14562# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14563 jump = merge(1, 0, f >= eqn_idx%mom%end)
14564# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14565 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14566# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14567 end do
14568# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14569 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
14570# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14571 end select
14572# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14573
14574# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14575 y_center = y0_ref
14576# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14577 y_dist = y_cc(j) - y_center
14578# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14579 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
14580# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14581 front_shift = a_param*sin(wave_phase)
14582# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14583
14584# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14585 x_mapped = x_cc(i) - front_shift
14586# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14587
14588# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14589 if (x_mapped <= x_coords(1)) then
14590# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14591 do v = 1, sys_size - 1
14592# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14593 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
14594# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14595 end do
14596# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14597 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14598# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14599 else if (x_mapped >= x_coords(xrows)) then
14600# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14601 do v = 1, sys_size - 1
14602# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14603 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
14604# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14605 end do
14606# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14607 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14608# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14609 else
14610# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14611 idx_lo = 1; idx_hi = xrows
14612# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14613 do while (idx_hi - idx_lo > 1)
14614# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14615 idx_mid = (idx_lo + idx_hi)/2
14616# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14617 if (x_coords(idx_mid) <= x_mapped) then
14618# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14619 idx_lo = idx_mid
14620# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14621 else
14622# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14623 idx_hi = idx_mid
14624# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14625 end if
14626# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14627 end do
14628# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14629
14630# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14631 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
14632# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14633
14634# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14635 do v = 1, sys_size - 1
14636# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14637 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, &
14638# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14639 & v) + interp_wt*stored_values(idx_hi, 1, v)
14640# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14641 end do
14642# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14643 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14644# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14645 end if
14646# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14647 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
14648# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14649 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
14650# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14651 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
14652# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14653 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
14654# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14655 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 &
14656# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14657 & - y_domain%beg))
14658# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14659 if (x_cc(i) > d) then
14660# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14661 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
14662# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14663 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
14664# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14665 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
14666# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14667 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
14668# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14669 do v = eqn_idx%species%beg, eqn_idx%species%end
14670# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14671 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
14672# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14673 end do
14674# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14675 end if
14676# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14677 case (280) ! Isentropic vortex
14678# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14679 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
14680# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14681 ! geometry 2
14682# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14683 if (patch_id == 1) then
14684# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14685 q_prim_vf(eqn_idx%E)%sf(i, j, &
14686# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14687 & 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) &
14688# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14689 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
14690# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14691 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
14692# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14693 & 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) &
14694# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14695 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
14696# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14697 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
14698# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14699 & 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) &
14700# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14701 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
14702# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14703 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
14704# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14705 & 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) &
14706# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14707 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
14708# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14709 end if
14710# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14711 case (281) ! Acoustic pulse
14712# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14713 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
14714# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14715 ! geometry 2
14716# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14717 if (patch_id == 2) then
14718# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14719 q_prim_vf(eqn_idx%E)%sf(i, j, &
14720# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14721 & 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))
14722# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14723 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
14724# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14725 & 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))
14726# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14727 end if
14728# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14729 case (282) ! Zero-circulation vortex
14730# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14731 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
14732# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14733 ! geometry 2
14734# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14735 if (patch_id == 2) then
14736# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14737 q_prim_vf(eqn_idx%E)%sf(i, j, &
14738# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14739 & 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))
14740# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14741 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
14742# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14743 & 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))
14744# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14745 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
14746# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14747 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
14748# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14749 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
14750# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14751 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
14752# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14753 end if
14754# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14755 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
14756# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14757 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
14758# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14759 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
14760# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14761 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
14762# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14763 ! patch_icpp(patch_id)%epsilon; defaults to 5.
14764# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14765 if (patch_id == 1) then
14766# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14767 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
14768# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14769 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
14770# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14771 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
14772# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14773 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
14774# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14775 do igq = 1, 3
14776# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14777 do jgq = 1, 3
14778# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14779 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
14780# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14781 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
14782# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14783 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
14784# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14785 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))
14786# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14787 wq = gauss_w(igq)*gauss_w(jgq)
14788# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14789 rhoq = t_facq**1.4_wp
14790# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14791 pq = t_facq**2.4_wp
14792# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14793 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
14794# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14795 & - r2q)
14796# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14797 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
14798# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14799 & - r2q)
14800# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14801 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
14802# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14803 rho_avg = rho_avg + wq*rhoq
14804# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14805 rhou_avg = rhou_avg + wq*(rhoq*uq)
14806# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14807 rhov_avg = rhov_avg + wq*(rhoq*vq)
14808# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14809 e_avg = e_avg + wq*eq
14810# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14811 end do
14812# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14813 end do
14814# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14815 rho_avg = rho_avg*0.25_wp
14816# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14817 rhou_avg = rhou_avg*0.25_wp
14818# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14819 rhov_avg = rhov_avg*0.25_wp
14820# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14821 e_avg = e_avg*0.25_wp
14822# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14823 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
14824# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14825 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
14826# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14827 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
14828# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14829 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
14830# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14831 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
14832# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14833 end if
14834# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14835 case (291) ! Isothermal Flat Plate
14836# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14837 t_inf = 1125.0_wp
14838# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14839 t_wall = 600.0_wp
14840# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14841 p_atm = 101325.0_wp
14842# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14843
14844# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14845 ! Boundary/Shear Layer thicknesses
14846# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14847 delta_th = 0.0003_wp ! Thermal BL thickness
14848# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14849 delta_shear = 8e-3_wp ! Velocity BL thickness
14850# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14851
14852# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14853 u_max = 50.0_wp ! Freestream Velocity (m/s)
14854# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14855
14856# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14857 mw_n2 = 28.0134e-3_wp
14858# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14859 mw_o2 = 31.999e-3_wp
14860# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14861 y_n2 = 0.767_wp
14862# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14863 y_o2 = 0.233_wp
14864# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14865 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
14866# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14867 bottom_blend_u = tanh(y_cc(j)/delta_shear)
14868# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14869 bottom_blend_t = tanh(y_cc(j)/delta_th)
14870# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14871 u_mean = u_max*bottom_blend_u
14872# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14873 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
14874# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14875 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
14876# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14877 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
14878# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14879 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
14880# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14881 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
14882# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14883 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
14884# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14885 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
14886# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14887 case default
14888# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14889 if (proc_rank == 0) then
14890# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14891 call s_int_to_str(patch_id, istr)
14892# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14893 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
14894# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14895 end if
14896# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14897 end select
14898# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14899 end if
14900
14901 ! Updating the patch identities bookkeeping variable
14902 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
14903 end if
14904 end do
14905 end do
14906 if (allocated(stored_values)) then
14907# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14908#ifdef MFC_DEBUG
14909# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14910 block
14911# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14912 use iso_fortran_env, only: output_unit
14913# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14914
14915# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14916 print *, 'm_icpp_patches.fpp:512: ', '@:DEALLOCATE(stored_values)'
14917# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14918
14919# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14920 call flush (output_unit)
14921# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14922 end block
14923# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14924#endif
14925# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14926
14927# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14928#if defined(MFC_OpenACC)
14929# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14930!$acc exit data delete(stored_values)
14931# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14932#elif defined(MFC_OpenMP)
14933# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14934!$omp target exit data map(release:stored_values)
14935# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14936#endif
14937# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14938 deallocate (stored_values)
14939# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14940#ifdef MFC_DEBUG
14941# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14942 block
14943# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14944 use iso_fortran_env, only: output_unit
14945# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14946
14947# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14948 print *, 'm_icpp_patches.fpp:512: ', '@:DEALLOCATE(x_coords)'
14949# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14950
14951# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14952 call flush (output_unit)
14953# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14954 end block
14955# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14956#endif
14957# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14958
14959# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14960#if defined(MFC_OpenACC)
14961# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14962!$acc exit data delete(x_coords)
14963# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14964#elif defined(MFC_OpenMP)
14965# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14966!$omp target exit data map(release:x_coords)
14967# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14968#endif
14969# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14970 deallocate (x_coords)
14971# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14972 end if
14973# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14974
14975# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14976 if (allocated(y_coords)) then
14977# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14978#ifdef MFC_DEBUG
14979# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14980 block
14981# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14982 use iso_fortran_env, only: output_unit
14983# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14984
14985# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14986 print *, 'm_icpp_patches.fpp:512: ', '@:DEALLOCATE(y_coords)'
14987# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14988
14989# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14990 call flush (output_unit)
14991# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14992 end block
14993# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14994#endif
14995# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14996
14997# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14998#if defined(MFC_OpenACC)
14999# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15000!$acc exit data delete(y_coords)
15001# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15002#elif defined(MFC_OpenMP)
15003# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15004!$omp target exit data map(release:y_coords)
15005# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15006#endif
15007# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15008 deallocate (y_coords)
15009# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15010 end if
15011# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15012
15013# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15014 files_loaded = .false.
15015# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15016
15017# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15018 if (allocated(stored_values274)) then
15019# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15020#ifdef MFC_DEBUG
15021# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15022 block
15023# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15024 use iso_fortran_env, only: output_unit
15025# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15026
15027# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15028 print *, 'm_icpp_patches.fpp:512: ', '@:DEALLOCATE(stored_values274)'
15029# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15030
15031# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15032 call flush (output_unit)
15033# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15034 end block
15035# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15036#endif
15037# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15038
15039# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15040#if defined(MFC_OpenACC)
15041# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15042!$acc exit data delete(stored_values274)
15043# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15044#elif defined(MFC_OpenMP)
15045# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15046!$omp target exit data map(release:stored_values274)
15047# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15048#endif
15049# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15050 deallocate (stored_values274)
15051# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15052 end if
15053# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15054
15055# 512 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15056 files_loaded274 = .false.
15057# 513 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15058
15059 end subroutine s_icpp_ellipse
15060
15061 !> The ellipsoidal patch is a 3D geometry. The geometry of the patch is well-defined when its centroid and radii are provided.
15062 !! Note that the ellipsoidal patch DOES allow for the smoothing of its boundary
15063 subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
15064
15065 ! Patch identifier
15066 integer, intent(in) :: patch_id
15067
15068#ifdef MFC_MIXED_PRECISION
15069 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15070#else
15071 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
15072#endif
15073 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
15074
15075 ! Generic loop iterators
15076 integer :: i, j, k
15077 real(wp) :: a, b, c
15078
15079 integer :: xRows, yRows, nRows, iix, iiy, max_files
15080# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15081 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
15082# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15083 real(wp) :: x_step, y_step
15084# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15085 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
15086# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15087 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
15088# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15089 real(wp) :: delta_x, delta_y
15090# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15091 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
15092# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15093 real(wp), allocatable :: stored_values(:,:,:)
15094# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15095 real(wp), allocatable :: x_coords(:), y_coords(:)
15096# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15097 logical :: files_loaded = .false.
15098# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15099 real(wp) :: domain_xstart
15100# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15101 character(len=20) :: file_num_str !< For storing the file number as a string
15102# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15103 integer :: ios
15104# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15105 integer :: ios2
15106# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15107
15108# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15109 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
15110# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15111 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
15112# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15113 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
15114# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15115 ! y_coords/files_loaded above.
15116# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15117 real(wp), allocatable, dimension(:,:,:) :: stored_values274
15118# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15119 logical :: files_loaded274 = .false.
15120# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15121 integer :: f274, ix274, iy274, unit274, ios274
15122# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15123 integer :: local_ix_beg274, local_iy_beg274
15124# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15125 character(len=300) :: fname274
15126# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15127 character(len=20) :: file_num_str274
15128# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15129 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
15130# 534 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15131 real(wp) :: file_dx274, file_dy274, r_align274
15132# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15133 ! Place any declaration of intermediate variables here
15134# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15135 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
15136# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15137 real(wp) :: eps
15138# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15139 real(wp) :: zlen371, kz371
15140# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15141
15142# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15143 ! IGR Jets Arrays to stor position and radii of jets from input file
15144# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15145 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
15146# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15147 ! Variables to describe initial condition of jet
15148# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15149 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
15150# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15151 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
15152# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15153 real(wp), dimension(0:n,0:p) :: rcut_arr
15154# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15155 integer :: l, q, s !< Iterators for reading input files
15156# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15157 integer :: start, end !< Ints to keep track of position in file
15158# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15159 character(len=100000) :: line ! String to store line in file
15160# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15161 character(len=25) :: value !< String to store value in line
15162# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15163 integer :: NJet !< Number of jets
15164# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15165 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
15166# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15167 logical :: file_exist ! Flag to check if file exists
15168# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15169
15170# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15171 eps = 1e-9_wp
15172# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15173
15174# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15175 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
15176# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15177 eps_smooth = 3._wp
15178# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15179 inquire (file="njet.txt", exist=file_exist)
15180# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15181 if (file_exist) then
15182# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15183 open (unit=10, file="njet.txt", status="old", action="read")
15184# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15185 read (10, *) njet
15186# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15187 close (10)
15188# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15189 else
15190# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15191 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
15192# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15193 end if
15194# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15195
15196# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15197#ifdef MFC_DEBUG
15198# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15199 block
15200# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15201 use iso_fortran_env, only: output_unit
15202# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15203
15204# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15205 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
15206# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15207
15208# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15209 call flush (output_unit)
15210# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15211 end block
15212# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15213#endif
15214# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15215 allocate (y_th_arr(0:njet - 1))
15216# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15217
15218# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15219
15220# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15221#if defined(MFC_OpenACC)
15222# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15223!$acc enter data create(y_th_arr)
15224# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15225#elif defined(MFC_OpenMP)
15226# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15227!$omp target enter data map(always,alloc:y_th_arr)
15228# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15229#endif
15230# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15231#ifdef MFC_DEBUG
15232# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15233 block
15234# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15235 use iso_fortran_env, only: output_unit
15236# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15237
15238# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15239 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
15240# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15241
15242# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15243 call flush (output_unit)
15244# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15245 end block
15246# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15247#endif
15248# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15249 allocate (z_th_arr(0:njet - 1))
15250# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15251
15252# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15253
15254# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15255#if defined(MFC_OpenACC)
15256# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15257!$acc enter data create(z_th_arr)
15258# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15259#elif defined(MFC_OpenMP)
15260# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15261!$omp target enter data map(always,alloc:z_th_arr)
15262# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15263#endif
15264# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15265#ifdef MFC_DEBUG
15266# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15267 block
15268# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15269 use iso_fortran_env, only: output_unit
15270# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15271
15272# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15273 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
15274# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15275
15276# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15277 call flush (output_unit)
15278# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15279 end block
15280# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15281#endif
15282# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15283 allocate (r_th_arr(0:njet - 1))
15284# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15285
15286# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15287
15288# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15289#if defined(MFC_OpenACC)
15290# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15291!$acc enter data create(r_th_arr)
15292# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15293#elif defined(MFC_OpenMP)
15294# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15295!$omp target enter data map(always,alloc:r_th_arr)
15296# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15297#endif
15298# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15299
15300# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15301 inquire (file="jets.csv", exist=file_exist)
15302# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15303 if (file_exist) then
15304# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15305 open (unit=10, file="jets.csv", status="old", action="read")
15306# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15307 do q = 0, njet - 1
15308# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15309 read (10, '(A)') line ! Read a full line as a string
15310# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15311 start = 1
15312# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15313
15314# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15315 do l = 0, 2
15316# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15317 end = index(line(start:), ',') ! Find the next comma
15318# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15319 if (end == 0) then
15320# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15321 value = trim(adjustl(line(start:))) ! Last value in the line
15322# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15323 else
15324# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15325 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
15326# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15327 start = start + end ! Move to next value
15328# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15329 end if
15330# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15331 if (l == 0) then
15332# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15333 read (value, *) y_th_arr(q) ! Convert string to numeric value
15334# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15335 else if (l == 1) then
15336# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15337 read (value, *) z_th_arr(q)
15338# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15339 else
15340# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15341 read (value, *) r_th_arr(q)
15342# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15343 end if
15344# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15345 end do
15346# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15347 end do
15348# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15349 close (10)
15350# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15351
15352# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15353 do q = 0, p
15354# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15355 do l = 0, n
15356# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15357 rcut = 0._wp
15358# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15359 do s = 0, njet - 1
15360# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15361 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
15362# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15363 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
15364# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15365 end do
15366# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15367 rcut_arr(l, q) = rcut
15368# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15369 end do
15370# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15371 end do
15372# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15373 else
15374# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15375 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
15376# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15377 end if
15378# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15379 end if
15380# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15381
15382# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15383 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
15384# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15385#ifdef MFC_DEBUG
15386# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15387 block
15388# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15389 use iso_fortran_env, only: output_unit
15390# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15391
15392# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15393 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
15394# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15395
15396# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15397 call flush (output_unit)
15398# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15399 end block
15400# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15401#endif
15402# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15403 allocate (ih(0:n_glb, 0:p_glb))
15404# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15405
15406# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15407
15408# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15409#if defined(MFC_OpenACC)
15410# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15411!$acc enter data create(ih)
15412# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15413#elif defined(MFC_OpenMP)
15414# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15415!$omp target enter data map(always,alloc:ih)
15416# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15417#endif
15418# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15419
15420# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15421 if (interface_file == '.') then
15422# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15423 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
15424# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15425 else
15426# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15427 inquire (file=trim(interface_file), exist=file_exist)
15428# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15429 if (file_exist) then
15430# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15431 open (unit=10, file=trim(interface_file), status="old", action="read")
15432# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15433 do i = 0, n_glb
15434# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15435 read (10, '(A)') line ! Read a full line as a string
15436# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15437 start = 1
15438# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15439
15440# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15441 do j = 0, p_glb
15442# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15443 end = index(line(start:), ',') ! Find the next comma
15444# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15445 if (end == 0) then
15446# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15447 value = trim(adjustl(line(start:))) ! Last value in the line
15448# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15449 else
15450# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15451 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
15452# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15453 start = start + end ! Move to next value
15454# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15455 end if
15456# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15457 read (value, *) ih(i, j) ! Convert string to numeric value
15458# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15459 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
15460# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15461 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
15462# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15463 end do
15464# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15465 end do
15466# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15467 close (10)
15468# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15469 else
15470# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15471 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
15472# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15473 end if
15474# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15475 end if
15476# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15477 end if
15478# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15479
15480# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15481 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
15482# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15483#ifdef MFC_DEBUG
15484# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15485 block
15486# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15487 use iso_fortran_env, only: output_unit
15488# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15489
15490# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15491 print *, 'm_icpp_patches.fpp:535: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
15492# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15493
15494# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15495 call flush (output_unit)
15496# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15497 end block
15498# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15499#endif
15500# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15501 allocate (ih(0:n_glb, 0:0))
15502# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15503
15504# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15505
15506# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15507#if defined(MFC_OpenACC)
15508# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15509!$acc enter data create(ih)
15510# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15511#elif defined(MFC_OpenMP)
15512# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15513!$omp target enter data map(always,alloc:ih)
15514# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15515#endif
15516# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15517 if (interface_file == '.') then
15518# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15519 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
15520# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15521 else
15522# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15523 inquire (file=trim(interface_file), exist=file_exist)
15524# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15525 if (file_exist) then
15526# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15527 open (unit=10, file=trim(interface_file), status="old", action="read")
15528# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15529 do i = 0, n_glb
15530# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15531 read (10, '(A)') line ! Read a full line as a string
15532# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15533 value = trim(line)
15534# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15535 read (value, *) ih(i, 0) ! Convert string to numeric value
15536# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15537 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
15538# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15539 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
15540# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15541 end do
15542# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15543 close (10)
15544# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15545 else
15546# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15547 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
15548# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15549 end if
15550# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15551 end if
15552# 535 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15553 end if
15554# 536 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15555
15556 ! Transferring the ellipsoidal patch's radii, centroid, smearing patch identity, and smearing coefficient information
15557 x_centroid = patch_icpp(patch_id)%x_centroid
15558 y_centroid = patch_icpp(patch_id)%y_centroid
15559 z_centroid = patch_icpp(patch_id)%z_centroid
15560 a = patch_icpp(patch_id)%radii(1)
15561 b = patch_icpp(patch_id)%radii(2)
15562 c = patch_icpp(patch_id)%radii(3)
15563 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
15564 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
15565
15566 ! Initialize eta=1; modified if smoothing is enabled
15567 eta = 1._wp
15568
15569 ! Assign patch vars if cell is covered and patch has write permission
15570 do k = 0, p
15571 do j = 0, n
15572 do i = 0, m
15573 if (grid_geometry == 3) then
15575 else
15576 cart_y = y_cc(j)
15577 cart_z = z_cc(k)
15578 end if
15579
15580 if (patch_icpp(patch_id)%smoothen) then
15581 eta = tanh(smooth_coeff/min(dx_min, dy_min, &
15582 & dz_min)*(sqrt(((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z &
15583 & - z_centroid)/c)**2) - 1._wp))*(-0.5_wp) + 0.5_wp
15584 end if
15585
15586 if ((((x_cc(i) - x_centroid)/a)**2 + ((cart_y - y_centroid)/b)**2 + ((cart_z - z_centroid)/c)**2 <= 1._wp &
15587 & .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
15588 & k) == smooth_patch_id) then
15589 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
15590
15591
15592# 573 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15593 if (patch_icpp(patch_id)%hcid /= dflt_int) then
15594 select case (patch_icpp(patch_id)%hcid)
15595# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15596 case (300) ! Rayleigh-Taylor instability
15597# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15598 rhoh = 3._wp
15599# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15600 rhol = 1._wp
15601# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15602 pref = 1.e5_wp
15603# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15604 pint = pref
15605# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15606 h = 0.7_wp
15607# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15608 lam = 0.2_wp
15609# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15610 wl = 2._wp*pi/lam
15611# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15612 amp = 0.025_wp/wl
15613# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15614
15615# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15616 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
15617# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15618
15619# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15620 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
15621# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15622
15623# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15624 if (alph < eps) alph = eps
15625# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15626 if (alph > 1._wp - eps) alph = 1._wp - eps
15627# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15628
15629# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15630 if (y_cc(j) > inth) then
15631# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15632 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15633# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15634 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15635# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15636 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
15637# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15638 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
15639# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15640 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
15641# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15642 else
15643# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15644 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15645# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15646 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15647# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15648 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
15649# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15650 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
15651# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15652 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
15653# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15654 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
15655# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15656 end if
15657# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15658 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
15659# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15660 h = 0.0_wp
15661# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15662 lam = 1.0_wp
15663# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15664 amp = patch_icpp(patch_id)%a(2)
15665# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15666 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
15667# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15668 if (x_cc(i) > inth) then
15669# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15670 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
15671# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15672 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
15673# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15674 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
15675# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15676 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
15677# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15678 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
15679# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15680 end if
15681# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15682 case (302) ! 3D Jet with IGR
15683# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15684 ux_th = 10*sqrt(1.4*0.4)
15685# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15686 ux_am = 0.0*sqrt(1.4)
15687# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15688 p_th = 2.0_wp
15689# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15690 p_am = 1.0_wp
15691# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15692 rho_th = 1._wp
15693# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15694 rho_am = 1._wp
15695# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15696 y_th = 0.0_wp
15697# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15698 z_th = 0.0_wp
15699# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15700 r_th = 1._wp
15701# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15702 eps_smooth = 1._wp
15703# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15704 eps = 1e-6
15705# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15706
15707# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15708 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
15709# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15710 rcut = f_cut_on(r - r_th, eps_smooth)
15711# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15712 xcut = f_cut_on(x_cc(i), eps_smooth)
15713# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15714
15715# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15716 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15717# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15718 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
15719# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15720 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
15721# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15722
15723# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15724 if (num_fluids == 1) then
15725# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15726 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15727# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15728 else
15729# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15730 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15731# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15732 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
15733# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15734 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))
15735# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15736 end if
15737# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15738
15739# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15740 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
15741# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15742 case (303) ! 3D Multijet
15743# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15744 eps_smooth = 3.0_wp
15745# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15746 ux_th = 10*sqrt(1.4*0.4)
15747# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15748 ux_am = 2.5*sqrt(1.4*0.4)
15749# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15750 p_th = 0.8_wp
15751# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15752 p_am = 0.4_wp
15753# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15754 rho_th = 1._wp
15755# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15756 rho_am = 1._wp
15757# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15758 eps = 1e-6
15759# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15760
15761# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15762 rcut = rcut_arr(j, k)
15763# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15764 xcut = f_cut_on(x_cc(i), eps_smooth)
15765# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15766
15767# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15768 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15769# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15770 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
15771# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15772 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
15773# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15774
15775# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15776 if (num_fluids == 1) then
15777# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15778 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15779# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15780 else
15781# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15782 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15783# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15784 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
15785# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15786 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))
15787# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15788 end if
15789# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15790
15791# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15792 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
15793# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15794 case (304) ! 3D Interface from file cartesian
15795# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15796 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)))
15797# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15798
15799# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15800 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15801# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15802 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15803# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15804
15805# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15806 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)
15807# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15808 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)
15809# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15810
15811# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15812 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, &
15813# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15814 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
15815# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15816
15817# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15818 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
15819# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15820 case (305) ! 3D Interface from file axisymmetric
15821# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15822 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)))
15823# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15824
15825# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15826 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
15827# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15828 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
15829# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15830
15831# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15832 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
15833# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15834 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)
15835# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15836
15837# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15838 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, &
15839# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15840 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
15841# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15842
15843# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15844 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
15845# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15846 case (370) ! 3D extrusion of 2D profile from external data
15847# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15848 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
15849# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15850 if (.not. files_loaded) then
15851# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15852 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
15853# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15854 do f = 1, max_files
15855# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15856 write (file_num_str, '(I0)') f
15857# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15858 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
15859# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15860 end do
15861# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15862
15863# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15864 ! Common file reading setup
15865# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15866 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15867# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15868 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
15869# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15870
15871# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15872 select case (num_dims)
15873# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15874 case (1, 2) ! 1D and 2D cases are similar
15875# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15876 ! Count lines
15877# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15878 line_count = 0
15879# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15880 do
15881# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15882 read (unit2, *, iostat=ios2) dummy_x, dummy_y
15883# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15884 if (ios2 /= 0) exit
15885# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15886 line_count = line_count + 1
15887# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15888 end do
15889# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15890 close (unit2)
15891# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15892
15893# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15894 xrows = line_count
15895# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15896 yrows = 1
15897# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15898 index_x = 0
15899# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15900 if (num_dims == 2) index_x = i
15901# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15902#ifdef MFC_DEBUG
15903# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15904 block
15905# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15906 use iso_fortran_env, only: output_unit
15907# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15908
15909# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15910 print *, 'm_icpp_patches.fpp:574: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
15911# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15912
15913# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15914 call flush (output_unit)
15915# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15916 end block
15917# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15918#endif
15919# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15920 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
15921# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15922
15923# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15924
15925# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15926
15927# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15928#if defined(MFC_OpenACC)
15929# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15930!$acc enter data create(x_coords, stored_values)
15931# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15932#elif defined(MFC_OpenMP)
15933# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15934!$omp target enter data map(always,alloc:x_coords, stored_values)
15935# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15936#endif
15937# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15938
15939# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15940 ! Read data from all files
15941# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15942 do f = 1, max_files
15943# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15944 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15945# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15946 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
15947# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15948
15949# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15950 do iter = 1, xrows
15951# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15952 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
15953# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15954 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
15955# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15956 end do
15957# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15958 close (unit)
15959# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15960 end do
15961# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15962
15963# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15964 ! Calculate offsets
15965# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15966 domain_xstart = x_coords(1)
15967# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15968 x_step = x_cc(1) - x_cc(0)
15969# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15970 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
15971# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15972 global_offset_x = nint(abs(delta_x)/x_step)
15973# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15974 case (3) ! 3D case - determine grid structure
15975# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15976 ! Find yRows by counting rows with same x
15977# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15978 read (unit2, *, iostat=ios2) x0, y0, dummy_z
15979# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15980 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
15981# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15982
15983# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15984 yrows = 1
15985# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15986 do
15987# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15988 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15989# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15990 if (ios2 /= 0) exit
15991# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15992 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
15993# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15994 yrows = yrows + 1
15995# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15996 else
15997# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15998 exit
15999# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16000 end if
16001# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16002 end do
16003# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16004 close (unit2)
16005# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16006
16007# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16008 ! Count total rows
16009# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16010 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
16011# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16012 nrows = 0
16013# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16014 do
16015# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16016 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
16017# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16018 if (ios2 /= 0) exit
16019# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16020 nrows = nrows + 1
16021# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16022 end do
16023# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16024 close (unit2)
16025# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16026
16027# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16028 xrows = nrows/yrows
16029# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16030#ifdef MFC_DEBUG
16031# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16032 block
16033# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16034 use iso_fortran_env, only: output_unit
16035# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16036
16037# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16038 print *, 'm_icpp_patches.fpp:574: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
16039# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16040
16041# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16042 call flush (output_unit)
16043# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16044 end block
16045# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16046#endif
16047# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16048 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
16049# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16050
16051# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16052
16053# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16054
16055# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16056
16057# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16058#if defined(MFC_OpenACC)
16059# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16060!$acc enter data create(x_coords, y_coords, stored_values)
16061# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16062#elif defined(MFC_OpenMP)
16063# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16064!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
16065# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16066#endif
16067# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16068 index_x = i
16069# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16070 index_y = j
16071# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16072
16073# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16074 ! Read all files
16075# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16076 do f = 1, max_files
16077# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16078 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
16079# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16080 if (ios /= 0) then
16081# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16082 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
16083# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16084 cycle
16085# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16086 end if
16087# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16088
16089# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16090 iter = 0
16091# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16092 do iix = 1, xrows
16093# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16094 do iiy = 1, yrows
16095# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16096 iter = iter + 1
16097# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16098 if (f == 1) then
16099# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16100 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
16101# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16102 else
16103# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16104 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
16105# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16106 end if
16107# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16108 if (ios /= 0) call s_mpi_abort("Error reading data")
16109# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16110 end do
16111# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16112 end do
16113# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16114 close (unit)
16115# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16116 end do
16117# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16118
16119# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16120 ! Calculate offsets
16121# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16122 x_step = x_cc(1) - x_cc(0)
16123# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16124 y_step = y_cc(1) - y_cc(0)
16125# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16126 delta_x = x_cc(index_x) - x_coords(1)
16127# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16128 delta_y = y_cc(index_y) - y_coords(1)
16129# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16130 global_offset_x = nint(abs(delta_x)/x_step)
16131# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16132 global_offset_y = nint(abs(delta_y)/y_step)
16133# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16134
16135# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16136 ! The index check below only catches overruns, so a file that is merely too
16137# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16138 ! FINE stays in range and silently supplies a corner of itself. Check spacing
16139# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16140 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
16141# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16142 ! consecutive x values sit yRows apart.
16143# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16144 if (nrows > yrows) then
16145# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16146 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
16147# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16148 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
16149# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16150 end if
16151# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16152 if (yrows > 1) then
16153# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16154 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
16155# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16156 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
16157# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16158 end if
16159# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16160 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
16161# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16162 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
16163# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16164 & wp)) > 1.e-6_wp) &
16165# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16166 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
16167# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16168 end select
16169# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16170
16171# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16172 files_loaded = .true.
16173# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16174 end if
16175# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16176
16177# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16178 ! Data assignment
16179# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16180 select case (num_dims)
16181# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16182 case (1)
16183# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16184 idx = i + 1 + global_offset_x
16185# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16186 ! idx must land inside the file's row range: this rank's subdomain offset
16187# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16188 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
16189# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16190 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
16191# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16192 if (idx < 1 .or. idx > xrows) &
16193# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16194 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
16195# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16196 do f = 1, sys_size
16197# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16198 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
16199# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16200 end do
16201# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16202 case (2)
16203# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16204 idx = i + 1 + global_offset_x - index_x
16205# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16206 if (idx < 1 .or. idx > xrows) &
16207# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16208 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
16209# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16210 do f = 1, sys_size - 1
16211# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16212 jump = merge(1, 0, f >= eqn_idx%mom%end)
16213# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16214 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
16215# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16216 end do
16217# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16218 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
16219# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16220 case (3)
16221# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16222 idx = i + 1 + global_offset_x - index_x
16223# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16224 idy = j + 1 + global_offset_y - index_y
16225# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16226 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
16227# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16228 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
16229# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16230 do f = 1, sys_size - 1
16231# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16232 jump = merge(1, 0, f >= eqn_idx%mom%end)
16233# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16234 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
16235# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16236 end do
16237# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16238 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
16239# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16240 end select
16241# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16242 case (371) ! hcid=370 + closed-form spanwise (z) modulation for genuine 3D content
16243# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16244 ! hcid=370's read extrudes the (x,y) file uniformly across z, leaving the flow
16245# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16246 ! z-invariant. Modulate the file's cross-stream (y) velocity by a z-dependent
16247# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16248 ! factor and set the spanwise (w) component from the result, so both inherit the
16249# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16250 ! file's shear-layer localization and amplitude scale. Streamwise (x) is left as
16251# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16252 ! read. This scales the whole y-velocity, which is the perturbation alone only
16253# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16254 ! when the base state has v == 0, as a temporal mixing layer does.
16255# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16256 !
16257# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16258 ! kz uses the GLOBAL z extent: p and z_cc(0:p) are per-rank under MPI, so a local
16259# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16260 ! extent would scale kz by num_procs_z and break periodicity at the z wrap.
16261# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16262 ! z_cc(k) is already absolute, so the phase needs no offset. Assumes uniform dz.
16263# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16264 if (.not. files_loaded) then
16265# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16266 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
16267# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16268 do f = 1, max_files
16269# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16270 write (file_num_str, '(I0)') f
16271# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16272 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
16273# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16274 end do
16275# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16276
16277# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16278 ! Common file reading setup
16279# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16280 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
16281# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16282 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
16283# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16284
16285# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16286 select case (num_dims)
16287# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16288 case (1, 2) ! 1D and 2D cases are similar
16289# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16290 ! Count lines
16291# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16292 line_count = 0
16293# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16294 do
16295# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16296 read (unit2, *, iostat=ios2) dummy_x, dummy_y
16297# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16298 if (ios2 /= 0) exit
16299# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16300 line_count = line_count + 1
16301# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16302 end do
16303# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16304 close (unit2)
16305# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16306
16307# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16308 xrows = line_count
16309# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16310 yrows = 1
16311# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16312 index_x = 0
16313# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16314 if (num_dims == 2) index_x = i
16315# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16316#ifdef MFC_DEBUG
16317# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16318 block
16319# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16320 use iso_fortran_env, only: output_unit
16321# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16322
16323# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16324 print *, 'm_icpp_patches.fpp:574: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
16325# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16326
16327# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16328 call flush (output_unit)
16329# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16330 end block
16331# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16332#endif
16333# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16334 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
16335# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16336
16337# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16338
16339# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16340
16341# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16342#if defined(MFC_OpenACC)
16343# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16344!$acc enter data create(x_coords, stored_values)
16345# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16346#elif defined(MFC_OpenMP)
16347# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16348!$omp target enter data map(always,alloc:x_coords, stored_values)
16349# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16350#endif
16351# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16352
16353# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16354 ! Read data from all files
16355# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16356 do f = 1, max_files
16357# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16358 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
16359# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16360 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
16361# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16362
16363# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16364 do iter = 1, xrows
16365# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16366 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
16367# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16368 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
16369# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16370 end do
16371# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16372 close (unit)
16373# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16374 end do
16375# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16376
16377# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16378 ! Calculate offsets
16379# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16380 domain_xstart = x_coords(1)
16381# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16382 x_step = x_cc(1) - x_cc(0)
16383# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16384 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
16385# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16386 global_offset_x = nint(abs(delta_x)/x_step)
16387# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16388 case (3) ! 3D case - determine grid structure
16389# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16390 ! Find yRows by counting rows with same x
16391# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16392 read (unit2, *, iostat=ios2) x0, y0, dummy_z
16393# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16394 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
16395# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16396
16397# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16398 yrows = 1
16399# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16400 do
16401# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16402 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
16403# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16404 if (ios2 /= 0) exit
16405# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16406 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
16407# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16408 yrows = yrows + 1
16409# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16410 else
16411# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16412 exit
16413# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16414 end if
16415# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16416 end do
16417# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16418 close (unit2)
16419# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16420
16421# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16422 ! Count total rows
16423# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16424 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
16425# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16426 nrows = 0
16427# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16428 do
16429# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16430 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
16431# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16432 if (ios2 /= 0) exit
16433# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16434 nrows = nrows + 1
16435# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16436 end do
16437# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16438 close (unit2)
16439# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16440
16441# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16442 xrows = nrows/yrows
16443# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16444#ifdef MFC_DEBUG
16445# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16446 block
16447# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16448 use iso_fortran_env, only: output_unit
16449# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16450
16451# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16452 print *, 'm_icpp_patches.fpp:574: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
16453# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16454
16455# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16456 call flush (output_unit)
16457# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16458 end block
16459# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16460#endif
16461# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16462 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
16463# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16464
16465# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16466
16467# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16468
16469# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16470
16471# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16472#if defined(MFC_OpenACC)
16473# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16474!$acc enter data create(x_coords, y_coords, stored_values)
16475# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16476#elif defined(MFC_OpenMP)
16477# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16478!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
16479# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16480#endif
16481# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16482 index_x = i
16483# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16484 index_y = j
16485# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16486
16487# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16488 ! Read all files
16489# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16490 do f = 1, max_files
16491# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16492 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
16493# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16494 if (ios /= 0) then
16495# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16496 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
16497# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16498 cycle
16499# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16500 end if
16501# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16502
16503# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16504 iter = 0
16505# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16506 do iix = 1, xrows
16507# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16508 do iiy = 1, yrows
16509# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16510 iter = iter + 1
16511# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16512 if (f == 1) then
16513# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16514 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
16515# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16516 else
16517# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16518 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
16519# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16520 end if
16521# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16522 if (ios /= 0) call s_mpi_abort("Error reading data")
16523# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16524 end do
16525# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16526 end do
16527# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16528 close (unit)
16529# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16530 end do
16531# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16532
16533# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16534 ! Calculate offsets
16535# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16536 x_step = x_cc(1) - x_cc(0)
16537# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16538 y_step = y_cc(1) - y_cc(0)
16539# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16540 delta_x = x_cc(index_x) - x_coords(1)
16541# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16542 delta_y = y_cc(index_y) - y_coords(1)
16543# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16544 global_offset_x = nint(abs(delta_x)/x_step)
16545# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16546 global_offset_y = nint(abs(delta_y)/y_step)
16547# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16548
16549# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16550 ! The index check below only catches overruns, so a file that is merely too
16551# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16552 ! FINE stays in range and silently supplies a corner of itself. Check spacing
16553# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16554 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
16555# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16556 ! consecutive x values sit yRows apart.
16557# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16558 if (nrows > yrows) then
16559# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16560 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
16561# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16562 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
16563# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16564 end if
16565# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16566 if (yrows > 1) then
16567# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16568 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
16569# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16570 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
16571# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16572 end if
16573# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16574 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
16575# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16576 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
16577# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16578 & wp)) > 1.e-6_wp) &
16579# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16580 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
16581# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16582 end select
16583# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16584
16585# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16586 files_loaded = .true.
16587# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16588 end if
16589# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16590
16591# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16592 ! Data assignment
16593# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16594 select case (num_dims)
16595# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16596 case (1)
16597# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16598 idx = i + 1 + global_offset_x
16599# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16600 ! idx must land inside the file's row range: this rank's subdomain offset
16601# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16602 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
16603# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16604 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
16605# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16606 if (idx < 1 .or. idx > xrows) &
16607# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16608 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
16609# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16610 do f = 1, sys_size
16611# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16612 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
16613# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16614 end do
16615# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16616 case (2)
16617# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16618 idx = i + 1 + global_offset_x - index_x
16619# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16620 if (idx < 1 .or. idx > xrows) &
16621# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16622 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
16623# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16624 do f = 1, sys_size - 1
16625# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16626 jump = merge(1, 0, f >= eqn_idx%mom%end)
16627# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16628 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
16629# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16630 end do
16631# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16632 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
16633# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16634 case (3)
16635# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16636 idx = i + 1 + global_offset_x - index_x
16637# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16638 idy = j + 1 + global_offset_y - index_y
16639# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16640 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
16641# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16642 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
16643# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16644 do f = 1, sys_size - 1
16645# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16646 jump = merge(1, 0, f >= eqn_idx%mom%end)
16647# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16648 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
16649# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16650 end do
16651# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16652 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
16653# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16654 end select
16655# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16656 zlen371 = real(p_glb + 1, wp)*(z_cb(0) - z_cb(-1))
16657# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16658 kz371 = 2._wp*pi/zlen371
16659# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16660 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*(1._wp + 0.5_wp*cos(kz371*z_cc(k)))
16661# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16662 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.5_wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*sin(kz371*z_cc(k) + pi/3._wp)
16663# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16664 case (380) ! Taylor-Green vortex
16665# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16666 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
16667# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16668 ! geometry 9
16669# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16670 mach = 0.1
16671# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16672 if (patch_id == 1) then
16673# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16674 q_prim_vf(eqn_idx%E)%sf(i, j, &
16675# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16676 & 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)
16677# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16678 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)
16679# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16680 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)
16681# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16682 end if
16683# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16684 case default
16685# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16686 call s_int_to_str(patch_id, istr)
16687# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16688 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
16689# 574 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16690 end select
16691# 575 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16692 end if
16693
16694 ! Updating the patch identities bookkeeping variable
16695 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
16696 end if
16697 end do
16698 end do
16699 end do
16700 if (allocated(stored_values)) then
16701# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16702#ifdef MFC_DEBUG
16703# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16704 block
16705# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16706 use iso_fortran_env, only: output_unit
16707# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16708
16709# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16710 print *, 'm_icpp_patches.fpp:583: ', '@:DEALLOCATE(stored_values)'
16711# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16712
16713# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16714 call flush (output_unit)
16715# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16716 end block
16717# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16718#endif
16719# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16720
16721# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16722#if defined(MFC_OpenACC)
16723# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16724!$acc exit data delete(stored_values)
16725# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16726#elif defined(MFC_OpenMP)
16727# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16728!$omp target exit data map(release:stored_values)
16729# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16730#endif
16731# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16732 deallocate (stored_values)
16733# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16734#ifdef MFC_DEBUG
16735# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16736 block
16737# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16738 use iso_fortran_env, only: output_unit
16739# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16740
16741# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16742 print *, 'm_icpp_patches.fpp:583: ', '@:DEALLOCATE(x_coords)'
16743# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16744
16745# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16746 call flush (output_unit)
16747# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16748 end block
16749# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16750#endif
16751# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16752
16753# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16754#if defined(MFC_OpenACC)
16755# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16756!$acc exit data delete(x_coords)
16757# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16758#elif defined(MFC_OpenMP)
16759# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16760!$omp target exit data map(release:x_coords)
16761# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16762#endif
16763# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16764 deallocate (x_coords)
16765# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16766 end if
16767# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16768
16769# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16770 if (allocated(y_coords)) then
16771# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16772#ifdef MFC_DEBUG
16773# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16774 block
16775# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16776 use iso_fortran_env, only: output_unit
16777# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16778
16779# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16780 print *, 'm_icpp_patches.fpp:583: ', '@:DEALLOCATE(y_coords)'
16781# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16782
16783# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16784 call flush (output_unit)
16785# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16786 end block
16787# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16788#endif
16789# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16790
16791# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16792#if defined(MFC_OpenACC)
16793# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16794!$acc exit data delete(y_coords)
16795# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16796#elif defined(MFC_OpenMP)
16797# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16798!$omp target exit data map(release:y_coords)
16799# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16800#endif
16801# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16802 deallocate (y_coords)
16803# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16804 end if
16805# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16806
16807# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16808 files_loaded = .false.
16809# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16810
16811# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16812 if (allocated(stored_values274)) then
16813# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16814#ifdef MFC_DEBUG
16815# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16816 block
16817# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16818 use iso_fortran_env, only: output_unit
16819# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16820
16821# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16822 print *, 'm_icpp_patches.fpp:583: ', '@:DEALLOCATE(stored_values274)'
16823# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16824
16825# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16826 call flush (output_unit)
16827# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16828 end block
16829# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16830#endif
16831# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16832
16833# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16834#if defined(MFC_OpenACC)
16835# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16836!$acc exit data delete(stored_values274)
16837# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16838#elif defined(MFC_OpenMP)
16839# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16840!$omp target exit data map(release:stored_values274)
16841# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16842#endif
16843# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16844 deallocate (stored_values274)
16845# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16846 end if
16847# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16848
16849# 583 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16850 files_loaded274 = .false.
16851# 584 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16852
16853 end subroutine s_icpp_ellipsoid
16854
16855 !> The rectangular patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
16856 !! region, in alignment with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
16857 !! centroid and lengths in the x- and y- coordinate directions are provided. Please note that the rectangular patch DOES NOT
16858 !! allow for the smoothing of its boundaries.
16859 subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
16860
16861 integer, intent(in) :: patch_id
16862
16863#ifdef MFC_MIXED_PRECISION
16864 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
16865#else
16866 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
16867#endif
16868 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
16869 integer :: i, j, k !< generic loop iterators
16870
16871 integer :: xRows, yRows, nRows, iix, iiy, max_files
16872# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16873 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
16874# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16875 real(wp) :: x_step, y_step
16876# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16877 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
16878# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16879 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
16880# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16881 real(wp) :: delta_x, delta_y
16882# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16883 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
16884# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16885 real(wp), allocatable :: stored_values(:,:,:)
16886# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16887 real(wp), allocatable :: x_coords(:), y_coords(:)
16888# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16889 logical :: files_loaded = .false.
16890# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16891 real(wp) :: domain_xstart
16892# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16893 character(len=20) :: file_num_str !< For storing the file number as a string
16894# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16895 integer :: ios
16896# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16897 integer :: ios2
16898# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16899
16900# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16901 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
16902# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16903 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
16904# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16905 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
16906# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16907 ! y_coords/files_loaded above.
16908# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16909 real(wp), allocatable, dimension(:,:,:) :: stored_values274
16910# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16911 logical :: files_loaded274 = .false.
16912# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16913 integer :: f274, ix274, iy274, unit274, ios274
16914# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16915 integer :: local_ix_beg274, local_iy_beg274
16916# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16917 character(len=300) :: fname274
16918# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16919 character(len=20) :: file_num_str274
16920# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16921 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
16922# 603 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16923 real(wp) :: file_dx274, file_dy274, r_align274
16924# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16925 ! Place any declaration of intermediate variables here
16926# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16927 real(wp) :: eps, eps_mhd, C_mhd
16928# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16929 real(wp) :: r, rmax, gam, umax, p0
16930# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16931 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
16932# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16933 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
16934# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16935 real(wp) :: r0, alpha, r2
16936# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16937 real(wp) :: sinA, cosA
16938# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16939 real(wp) :: r_sq
16940# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16941
16942# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16943 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
16944# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16945 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
16946# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16947 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
16948# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16949 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
16950# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16951 integer :: igq, jgq
16952# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16953
16954# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16955 ! # 291 - Shear/Thermal Layer Case
16956# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16957 real(wp) :: delta_shear, u_max, u_mean
16958# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16959 real(wp) :: T_wall, T_inf, P_atm, T_loc
16960# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16961 real(wp) :: delta_th, R_mix
16962# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16963 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
16964# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16965 real(wp) :: bottom_blend_u, bottom_blend_T
16966# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16967
16968# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16969 ! # 207
16970# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16971 real(wp) :: sigma, gauss1, gauss2
16972# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16973
16974# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16975 ! # 208
16976# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16977 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
16978# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16979 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
16980# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16981 integer :: v, idx_lo, idx_hi, idx_mid
16982# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16983 real(wp), parameter :: Ly_param = 0.00775735_wp
16984# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16985 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
16986# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16987 integer, parameter :: Nwaves = 6
16988# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16989 real(wp), parameter :: y0_ref = 0.0_wp
16990# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16991
16992# 604 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16993 eps = 1.e-9_wp
16994# 605 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16995
16996 ! Transferring the rectangle's centroid and length information
16997 x_centroid = patch_icpp(patch_id)%x_centroid
16998 y_centroid = patch_icpp(patch_id)%y_centroid
16999 length_x = patch_icpp(patch_id)%length_x
17000 length_y = patch_icpp(patch_id)%length_y
17001
17002 ! Computing the beginning and the end x- and y-coordinates of the rectangle based on its centroid and lengths
17003 x_boundary%beg = x_centroid - 0.5_wp*length_x
17004 x_boundary%end = x_centroid + 0.5_wp*length_x
17005 y_boundary%beg = y_centroid - 0.5_wp*length_y
17006 y_boundary%end = y_centroid + 0.5_wp*length_y
17007
17008 ! Set eta=1 (no smoothing for this patch type)
17009 eta = 1._wp
17010
17011 ! Assign patch vars if cell is covered and patch has write permission
17012 do j = 0, n
17013 do i = 0, m
17014 if (f_is_inside_cuboid(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, [length_x, length_y, 0._wp])) then
17015 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
17016 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
17017
17018
17019# 629 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17020
17021 if (patch_icpp(patch_id)%hcid /= dflt_int) then
17022 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
17023# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17024 case (200) ! Two-fluid cubic interface
17025# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17026 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
17027# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17028 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
17029# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17030 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
17031# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17032 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
17033# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17034 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
17035# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17036 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
17037# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17038 end if
17039# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17040 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
17041# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17042 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
17043# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17044 rmax = 0.2_wp
17045# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17046
17047# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17048 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
17049# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17050 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
17051# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17052 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
17053# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17054
17055# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17056 if (r < rmax) then
17057# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17058 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
17059# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17060 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
17061# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17062 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
17063# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17064 else if (r < 2*rmax) then
17065# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17066 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
17067# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17068 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
17069# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17070 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)))
17071# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17072 else
17073# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17074 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
17075# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17076 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
17077# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17078 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
17079# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17080 end if
17081# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17082 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
17083# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17084 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
17085# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17086 rmax = 0.2_wp
17087# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17088
17089# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17090 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
17091# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17092 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
17093# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17094 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
17095# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17096
17097# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17098 if (r < rmax) then
17099# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17100 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
17101# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17102 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
17103# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17104 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
17105# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17106 else if (r < 2*rmax) then
17107# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17108 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
17109# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17110 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
17111# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17112 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)))
17113# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17114 else
17115# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17116 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
17117# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17118 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
17119# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17120 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
17121# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17122 end if
17123# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17124
17125# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17126 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
17127# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17128 case (204) ! Rayleigh-Taylor instability
17129# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17130 rhoh = 3._wp
17131# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17132 rhol = 1._wp
17133# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17134 pref = 1.e5_wp
17135# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17136 pint = pref
17137# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17138 h = 0.7_wp
17139# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17140 lam = 0.2_wp
17141# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17142 wl = 2._wp*pi/lam
17143# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17144 amp = 0.05_wp/wl
17145# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17146
17147# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17148 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
17149# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17150
17151# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17152 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
17153# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17154
17155# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17156 if (alph < eps) alph = eps
17157# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17158 if (alph > 1._wp - eps) alph = 1._wp - eps
17159# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17160
17161# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17162 if (y_cc(j) > inth) then
17163# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17164 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
17165# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17166 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
17167# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17168 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
17169# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17170 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
17171# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17172 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
17173# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17174 else
17175# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17176 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
17177# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17178 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
17179# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17180 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
17181# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17182 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
17183# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17184 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
17185# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17186 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
17187# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17188 end if
17189# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17190 case (205) ! 2D lung wave interaction problem
17191# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17192 h = 0.0_wp ! non dim origin y
17193# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17194 lam = 1.0_wp ! non dim lambda
17195# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17196 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
17197# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17198
17199# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17200 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
17201# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17202
17203# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17204 if (y_cc(j) > inth) then
17205# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17206 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
17207# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17208 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
17209# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17210 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
17211# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17212 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
17213# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17214 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
17215# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17216 end if
17217# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17218 case (206) ! 2D lung wave interaction problem - horizontal domain
17219# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17220 h = 0.0_wp ! non dim origin y
17221# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17222 lam = 1.0_wp ! non dim lambda
17223# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17224 amp = patch_icpp(patch_id)%a(2)
17225# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17226
17227# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17228 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
17229# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17230
17231# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17232 if (x_cc(i) > intl) then ! this is the liquid
17233# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17234 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
17235# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17236 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
17237# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17238 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
17239# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17240 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
17241# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17242 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
17243# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17244 end if
17245# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17246 case (207) ! Kelvin Helmholtz Instability
17247# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17248 sigma = 0.05_wp/sqrt(2.0_wp)
17249# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17250 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
17251# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17252 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
17253# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17254 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)
17255# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17256 case (208) ! Richtmeyer Meshkov Instability
17257# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17258 lam = 1.0_wp
17259# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17260 eps = 1.0e-6_wp
17261# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17262 ei = 5.0_wp
17263# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17264 ! Smoothening function to smooth out sharp discontinuity in the interface
17265# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17266 if (x_cc(i) <= 0.7_wp*lam) then
17267# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17268 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
17269# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17270 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
17271# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17272 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
17273# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17274 alpha_sf6 = 1.0_wp - alpha_air
17275# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17276 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
17277# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17278 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
17279# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17280 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
17281# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17282 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
17283# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17284 end if
17285# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17286 case (250) ! MHD Orszag-Tang vortex
17287# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17288 ! 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),
17289# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17290 ! sin(4*pi*x)/sqrt(4*pi), 0)
17291# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17292
17293# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17294 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
17295# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17296 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
17297# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17298
17299# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17300 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
17301# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17302 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
17303# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17304 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
17305# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17306 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
17307# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17308 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
17309# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17310 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
17311# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17312 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
17313# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17314 ! Linear interpolation between r=0.08 and r=1.0
17315# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17316 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
17317# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17318 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
17319# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17320 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
17321# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17322 else
17323# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17324 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
17325# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17326 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
17327# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17328 end if
17329# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17330
17331# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17332 ! case 252 is for the 2D MHD Rotor problem
17333# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17334 case (252) ! 2D MHD Rotor Problem
17335# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17336 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
17337# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17338 !
17339# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17340 ! 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
17341# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17342 ! velocity w=20, giving v_tan=2 at r=0.1
17343# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17344
17345# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17346 ! Calculate distance squared from the center
17347# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17348 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
17349# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17350
17351# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17352 ! inner radius of 0.1
17353# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17354 if (r_sq <= 0.1**2) then
17355# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17356 ! -- Inside the rotor -- Set density uniformly to 10
17357# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17358 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
17359# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17360
17361# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17362 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
17363# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17364 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
17365# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17366 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
17367# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17368
17369# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17370 ! taper width of 0.015
17371# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17372 else if (r_sq <= 0.115**2) then
17373# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17374 ! linearly smooth the function between r = 0.1 and 0.115
17375# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17376 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
17377# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17378
17379# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17380 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)
17381# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17382 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)
17383# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17384 end if
17385# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17386 case (253) ! MHD Smooth Magnetic Vortex
17387# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17388 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
17389# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17390 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
17391# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17392
17393# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17394 ! velocity
17395# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17396 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))
17397# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17398 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))
17399# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17400
17401# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17402 ! magnetic field
17403# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17404 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)
17405# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17406 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)
17407# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17408
17409# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17410 ! pressure
17411# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17412 q_prim_vf(eqn_idx%E)%sf(i, j, &
17413# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17414 & 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)
17415# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17416 case (260) ! Gaussian Divergence Pulse
17417# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17418 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
17419# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17420 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
17421# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17422 ! initialized to zero everywhere.
17423# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17424
17425# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17426 eps_mhd = patch_icpp(patch_id)%a(2)
17427# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17428 sigma = patch_icpp(patch_id)%a(3)
17429# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17430 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
17431# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17432
17433# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17434 ! B-field
17435# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17436 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
17437# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17438 case (261) ! Blob
17439# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17440 r0 = 1._wp/sqrt(8._wp)
17441# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17442 r2 = x_cc(i)**2 + y_cc(j)**2
17443# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17444 r = sqrt(r2)
17445# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17446 alpha = r/r0
17447# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17448 if (alpha < 1) then
17449# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17450 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)
17451# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17452 end if
17453# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17454 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
17455# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17456 ! rotate by \alpha = atan(2)
17457# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17458 alpha = atan(2._wp)
17459# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17460 cosa = cos(alpha)
17461# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17462 sina = sin(alpha)
17463# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17464 ! projection along shock normal
17465# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17466 r = x_cc(i)*cosa + y_cc(j)*sina
17467# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17468
17469# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17470 if (r <= 0.5_wp) then
17471# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17472 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
17473# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17474 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
17475# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17476 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
17477# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17478 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
17479# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17480 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
17481# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17482 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
17483# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17484 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
17485# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17486 else
17487# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17488 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
17489# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17490 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
17491# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17492 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
17493# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17494 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
17495# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17496 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
17497# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17498 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
17499# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17500 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
17501# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17502 end if
17503# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17504 ! v^z and B^z remain zero by default
17505# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17506 case (270) ! 2D extrusion of 1D profile from external data
17507# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17508 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
17509# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17510 if (.not. files_loaded) then
17511# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17512 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
17513# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17514 do f = 1, max_files
17515# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17516 write (file_num_str, '(I0)') f
17517# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17518 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
17519# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17520 end do
17521# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17522
17523# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17524 ! Common file reading setup
17525# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17526 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
17527# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17528 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
17529# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17530
17531# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17532 select case (num_dims)
17533# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17534 case (1, 2) ! 1D and 2D cases are similar
17535# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17536 ! Count lines
17537# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17538 line_count = 0
17539# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17540 do
17541# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17542 read (unit2, *, iostat=ios2) dummy_x, dummy_y
17543# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17544 if (ios2 /= 0) exit
17545# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17546 line_count = line_count + 1
17547# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17548 end do
17549# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17550 close (unit2)
17551# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17552
17553# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17554 xrows = line_count
17555# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17556 yrows = 1
17557# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17558 index_x = 0
17559# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17560 if (num_dims == 2) index_x = i
17561# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17562#ifdef MFC_DEBUG
17563# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17564 block
17565# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17566 use iso_fortran_env, only: output_unit
17567# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17568
17569# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17570 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
17571# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17572
17573# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17574 call flush (output_unit)
17575# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17576 end block
17577# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17578#endif
17579# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17580 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
17581# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17582
17583# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17584
17585# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17586
17587# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17588#if defined(MFC_OpenACC)
17589# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17590!$acc enter data create(x_coords, stored_values)
17591# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17592#elif defined(MFC_OpenMP)
17593# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17594!$omp target enter data map(always,alloc:x_coords, stored_values)
17595# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17596#endif
17597# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17598
17599# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17600 ! Read data from all files
17601# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17602 do f = 1, max_files
17603# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17604 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
17605# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17606 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
17607# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17608
17609# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17610 do iter = 1, xrows
17611# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17612 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
17613# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17614 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
17615# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17616 end do
17617# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17618 close (unit)
17619# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17620 end do
17621# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17622
17623# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17624 ! Calculate offsets
17625# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17626 domain_xstart = x_coords(1)
17627# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17628 x_step = x_cc(1) - x_cc(0)
17629# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17630 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
17631# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17632 global_offset_x = nint(abs(delta_x)/x_step)
17633# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17634 case (3) ! 3D case - determine grid structure
17635# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17636 ! Find yRows by counting rows with same x
17637# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17638 read (unit2, *, iostat=ios2) x0, y0, dummy_z
17639# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17640 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
17641# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17642
17643# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17644 yrows = 1
17645# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17646 do
17647# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17648 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
17649# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17650 if (ios2 /= 0) exit
17651# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17652 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
17653# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17654 yrows = yrows + 1
17655# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17656 else
17657# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17658 exit
17659# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17660 end if
17661# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17662 end do
17663# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17664 close (unit2)
17665# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17666
17667# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17668 ! Count total rows
17669# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17670 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
17671# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17672 nrows = 0
17673# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17674 do
17675# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17676 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
17677# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17678 if (ios2 /= 0) exit
17679# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17680 nrows = nrows + 1
17681# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17682 end do
17683# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17684 close (unit2)
17685# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17686
17687# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17688 xrows = nrows/yrows
17689# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17690#ifdef MFC_DEBUG
17691# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17692 block
17693# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17694 use iso_fortran_env, only: output_unit
17695# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17696
17697# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17698 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
17699# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17700
17701# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17702 call flush (output_unit)
17703# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17704 end block
17705# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17706#endif
17707# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17708 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
17709# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17710
17711# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17712
17713# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17714
17715# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17716
17717# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17718#if defined(MFC_OpenACC)
17719# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17720!$acc enter data create(x_coords, y_coords, stored_values)
17721# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17722#elif defined(MFC_OpenMP)
17723# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17724!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
17725# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17726#endif
17727# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17728 index_x = i
17729# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17730 index_y = j
17731# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17732
17733# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17734 ! Read all files
17735# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17736 do f = 1, max_files
17737# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17738 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
17739# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17740 if (ios /= 0) then
17741# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17742 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
17743# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17744 cycle
17745# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17746 end if
17747# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17748
17749# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17750 iter = 0
17751# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17752 do iix = 1, xrows
17753# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17754 do iiy = 1, yrows
17755# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17756 iter = iter + 1
17757# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17758 if (f == 1) then
17759# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17760 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
17761# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17762 else
17763# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17764 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
17765# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17766 end if
17767# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17768 if (ios /= 0) call s_mpi_abort("Error reading data")
17769# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17770 end do
17771# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17772 end do
17773# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17774 close (unit)
17775# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17776 end do
17777# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17778
17779# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17780 ! Calculate offsets
17781# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17782 x_step = x_cc(1) - x_cc(0)
17783# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17784 y_step = y_cc(1) - y_cc(0)
17785# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17786 delta_x = x_cc(index_x) - x_coords(1)
17787# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17788 delta_y = y_cc(index_y) - y_coords(1)
17789# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17790 global_offset_x = nint(abs(delta_x)/x_step)
17791# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17792 global_offset_y = nint(abs(delta_y)/y_step)
17793# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17794
17795# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17796 ! The index check below only catches overruns, so a file that is merely too
17797# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17798 ! FINE stays in range and silently supplies a corner of itself. Check spacing
17799# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17800 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
17801# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17802 ! consecutive x values sit yRows apart.
17803# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17804 if (nrows > yrows) then
17805# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17806 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
17807# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17808 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
17809# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17810 end if
17811# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17812 if (yrows > 1) then
17813# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17814 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
17815# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17816 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
17817# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17818 end if
17819# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17820 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
17821# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17822 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
17823# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17824 & wp)) > 1.e-6_wp) &
17825# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17826 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
17827# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17828 end select
17829# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17830
17831# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17832 files_loaded = .true.
17833# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17834 end if
17835# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17836
17837# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17838 ! Data assignment
17839# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17840 select case (num_dims)
17841# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17842 case (1)
17843# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17844 idx = i + 1 + global_offset_x
17845# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17846 ! idx must land inside the file's row range: this rank's subdomain offset
17847# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17848 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
17849# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17850 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
17851# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17852 if (idx < 1 .or. idx > xrows) &
17853# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17854 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
17855# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17856 do f = 1, sys_size
17857# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17858 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
17859# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17860 end do
17861# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17862 case (2)
17863# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17864 idx = i + 1 + global_offset_x - index_x
17865# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17866 if (idx < 1 .or. idx > xrows) &
17867# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17868 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
17869# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17870 do f = 1, sys_size - 1
17871# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17872 jump = merge(1, 0, f >= eqn_idx%mom%end)
17873# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17874 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
17875# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17876 end do
17877# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17878 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
17879# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17880 case (3)
17881# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17882 idx = i + 1 + global_offset_x - index_x
17883# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17884 idy = j + 1 + global_offset_y - index_y
17885# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17886 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
17887# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17888 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
17889# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17890 do f = 1, sys_size - 1
17891# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17892 jump = merge(1, 0, f >= eqn_idx%mom%end)
17893# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17894 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
17895# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17896 end do
17897# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17898 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
17899# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17900 end select
17901# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17902 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
17903# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17904 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
17905# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17906 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
17907# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17908 ! cross-stream-position profile (real cross-stream velocity is legitimately
17909# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17910 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
17911# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17912 ! zero out mom%beg's true physical value.
17913# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17914 if (.not. files_loaded) then
17915# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17916 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
17917# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17918 do f = 1, max_files
17919# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17920 write (file_num_str, '(I0)') f
17921# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17922 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
17923# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17924 end do
17925# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17926
17927# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17928 ! Common file reading setup
17929# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17930 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
17931# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17932 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
17933# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17934
17935# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17936 select case (num_dims)
17937# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17938 case (1, 2) ! 1D and 2D cases are similar
17939# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17940 ! Count lines
17941# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17942 line_count = 0
17943# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17944 do
17945# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17946 read (unit2, *, iostat=ios2) dummy_x, dummy_y
17947# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17948 if (ios2 /= 0) exit
17949# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17950 line_count = line_count + 1
17951# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17952 end do
17953# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17954 close (unit2)
17955# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17956
17957# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17958 xrows = line_count
17959# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17960 yrows = 1
17961# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17962 index_x = 0
17963# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17964 if (num_dims == 2) index_x = i
17965# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17966#ifdef MFC_DEBUG
17967# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17968 block
17969# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17970 use iso_fortran_env, only: output_unit
17971# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17972
17973# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17974 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
17975# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17976
17977# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17978 call flush (output_unit)
17979# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17980 end block
17981# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17982#endif
17983# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17984 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
17985# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17986
17987# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17988
17989# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17990
17991# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17992#if defined(MFC_OpenACC)
17993# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17994!$acc enter data create(x_coords, stored_values)
17995# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17996#elif defined(MFC_OpenMP)
17997# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
17998!$omp target enter data map(always,alloc:x_coords, stored_values)
17999# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18000#endif
18001# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18002
18003# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18004 ! Read data from all files
18005# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18006 do f = 1, max_files
18007# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18008 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
18009# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18010 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
18011# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18012
18013# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18014 do iter = 1, xrows
18015# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18016 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
18017# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18018 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
18019# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18020 end do
18021# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18022 close (unit)
18023# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18024 end do
18025# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18026
18027# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18028 ! Calculate offsets
18029# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18030 domain_xstart = x_coords(1)
18031# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18032 x_step = x_cc(1) - x_cc(0)
18033# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18034 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
18035# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18036 global_offset_x = nint(abs(delta_x)/x_step)
18037# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18038 case (3) ! 3D case - determine grid structure
18039# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18040 ! Find yRows by counting rows with same x
18041# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18042 read (unit2, *, iostat=ios2) x0, y0, dummy_z
18043# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18044 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
18045# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18046
18047# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18048 yrows = 1
18049# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18050 do
18051# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18052 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
18053# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18054 if (ios2 /= 0) exit
18055# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18056 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
18057# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18058 yrows = yrows + 1
18059# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18060 else
18061# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18062 exit
18063# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18064 end if
18065# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18066 end do
18067# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18068 close (unit2)
18069# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18070
18071# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18072 ! Count total rows
18073# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18074 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
18075# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18076 nrows = 0
18077# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18078 do
18079# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18080 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
18081# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18082 if (ios2 /= 0) exit
18083# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18084 nrows = nrows + 1
18085# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18086 end do
18087# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18088 close (unit2)
18089# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18090
18091# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18092 xrows = nrows/yrows
18093# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18094#ifdef MFC_DEBUG
18095# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18096 block
18097# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18098 use iso_fortran_env, only: output_unit
18099# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18100
18101# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18102 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
18103# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18104
18105# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18106 call flush (output_unit)
18107# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18108 end block
18109# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18110#endif
18111# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18112 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
18113# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18114
18115# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18116
18117# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18118
18119# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18120
18121# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18122#if defined(MFC_OpenACC)
18123# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18124!$acc enter data create(x_coords, y_coords, stored_values)
18125# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18126#elif defined(MFC_OpenMP)
18127# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18128!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
18129# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18130#endif
18131# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18132 index_x = i
18133# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18134 index_y = j
18135# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18136
18137# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18138 ! Read all files
18139# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18140 do f = 1, max_files
18141# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18142 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
18143# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18144 if (ios /= 0) then
18145# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18146 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
18147# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18148 cycle
18149# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18150 end if
18151# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18152
18153# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18154 iter = 0
18155# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18156 do iix = 1, xrows
18157# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18158 do iiy = 1, yrows
18159# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18160 iter = iter + 1
18161# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18162 if (f == 1) then
18163# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18164 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
18165# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18166 else
18167# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18168 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
18169# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18170 end if
18171# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18172 if (ios /= 0) call s_mpi_abort("Error reading data")
18173# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18174 end do
18175# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18176 end do
18177# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18178 close (unit)
18179# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18180 end do
18181# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18182
18183# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18184 ! Calculate offsets
18185# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18186 x_step = x_cc(1) - x_cc(0)
18187# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18188 y_step = y_cc(1) - y_cc(0)
18189# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18190 delta_x = x_cc(index_x) - x_coords(1)
18191# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18192 delta_y = y_cc(index_y) - y_coords(1)
18193# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18194 global_offset_x = nint(abs(delta_x)/x_step)
18195# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18196 global_offset_y = nint(abs(delta_y)/y_step)
18197# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18198
18199# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18200 ! The index check below only catches overruns, so a file that is merely too
18201# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18202 ! FINE stays in range and silently supplies a corner of itself. Check spacing
18203# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18204 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
18205# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18206 ! consecutive x values sit yRows apart.
18207# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18208 if (nrows > yrows) then
18209# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18210 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
18211# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18212 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
18213# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18214 end if
18215# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18216 if (yrows > 1) then
18217# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18218 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
18219# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18220 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
18221# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18222 end if
18223# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18224 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
18225# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18226 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
18227# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18228 & wp)) > 1.e-6_wp) &
18229# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18230 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
18231# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18232 end select
18233# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18234
18235# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18236 files_loaded = .true.
18237# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18238 end if
18239# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18240
18241# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18242 ! Data assignment
18243# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18244 select case (num_dims)
18245# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18246 case (1)
18247# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18248 idx = i + 1 + global_offset_x
18249# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18250 ! idx must land inside the file's row range: this rank's subdomain offset
18251# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18252 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
18253# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18254 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
18255# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18256 if (idx < 1 .or. idx > xrows) &
18257# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18258 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
18259# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18260 do f = 1, sys_size
18261# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18262 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
18263# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18264 end do
18265# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18266 case (2)
18267# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18268 idx = i + 1 + global_offset_x - index_x
18269# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18270 if (idx < 1 .or. idx > xrows) &
18271# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18272 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
18273# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18274 do f = 1, sys_size - 1
18275# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18276 jump = merge(1, 0, f >= eqn_idx%mom%end)
18277# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18278 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
18279# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18280 end do
18281# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18282 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
18283# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18284 case (3)
18285# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18286 idx = i + 1 + global_offset_x - index_x
18287# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18288 idy = j + 1 + global_offset_y - index_y
18289# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18290 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
18291# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18292 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
18293# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18294 do f = 1, sys_size - 1
18295# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18296 jump = merge(1, 0, f >= eqn_idx%mom%end)
18297# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18298 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
18299# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18300 end do
18301# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18302 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
18303# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18304 end select
18305# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18306 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
18307# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18308 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
18309# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18310 case (274) ! Full 2D field from external data (no extrusion)
18311# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18312 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
18313# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18314 ! extrusion direction and no zeroed component -- all sys_size variables are read and
18315# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18316 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
18317# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18318 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
18319# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18320 ! global grid exactly -- by construction, since the IC generator derives both the
18321# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18322 ! grid and the file contents from the same computation.
18323# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18324 !
18325# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18326 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
18327# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18328 ! file's own first coordinate and this rank's uniform grid spacing -- following the
18329# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18330 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
18331# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18332 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
18333# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18334 ! returns before allocating it otherwise), so a serial-IO run (the default for
18335# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18336 ! golden-file tests) would index into an unallocated array.
18337# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18338 !
18339# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18340 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
18341# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18342 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
18343# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18344 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
18345# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18346 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
18347# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18348 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
18349# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18350 ! global cell offset) are pinned from f274==1's very first record, before any other
18351# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18352 ! record is read, so every subsequent record -- across all variables -- can be tested
18353# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18354 ! against this rank's range and dropped if it falls outside it.
18355# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18356 x_step274 = x_cc(1) - x_cc(0)
18357# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18358 y_step274 = y_cc(1) - y_cc(0)
18359# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18360
18361# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18362 if (.not. files_loaded274) then
18363# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18364#ifdef MFC_DEBUG
18365# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18366 block
18367# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18368 use iso_fortran_env, only: output_unit
18369# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18370
18371# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18372 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
18373# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18374
18375# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18376 call flush (output_unit)
18377# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18378 end block
18379# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18380#endif
18381# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18382 allocate (stored_values274(0:m, 0:n, sys_size))
18383# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18384
18385# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18386
18387# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18388#if defined(MFC_OpenACC)
18389# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18390!$acc enter data create(stored_values274)
18391# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18392#elif defined(MFC_OpenMP)
18393# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18394!$omp target enter data map(always,alloc:stored_values274)
18395# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18396#endif
18397# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18398 do f274 = 1, sys_size
18399# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18400 write (file_num_str274, '(I0)') f274
18401# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18402 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
18403# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18404 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
18405# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18406 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
18407# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18408 do ix274 = 0, m_glb
18409# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18410 do iy274 = 0, n_glb
18411# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18412 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
18413# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18414 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
18415# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18416 ! Capture the file's own origin and spacing from its first records so we can
18417# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18418 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
18419# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18420 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
18421# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18422 if (f274 == 1) then
18423# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18424 if (ix274 == 0 .and. iy274 == 0) then
18425# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18426 x0_274 = dummy_x274
18427# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18428 y0_274 = dummy_y274
18429# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18430 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
18431# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18432 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
18433# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18434 end if
18435# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18436 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
18437# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18438 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
18439# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18440 end if
18441# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18442 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
18443# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18444 & .and. iy274 - local_iy_beg274 <= n) then
18445# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18446 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
18447# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18448 end if
18449# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18450 end do
18451# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18452 end do
18453# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18454 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
18455# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18456 ! read means it was generated for a larger grid and would be silently misread.
18457# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18458 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
18459# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18460 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
18461# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18462 close (unit274)
18463# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18464 end do
18465# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18466
18467# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18468 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
18469# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18470 ! Check alignment via the integer cell offset of this rank's first cell from the file
18471# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18472 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
18473# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18474 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
18475# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18476 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
18477# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18478 ! the global origin.) The spacing checks below must also hold.
18479# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18480 r_align274 = (x_cc(0) - x0_274)/x_step274
18481# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18482 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
18483# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18484 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
18485# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18486 if (m_glb >= 1) then
18487# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18488 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
18489# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18490 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
18491# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18492 end if
18493# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18494 if (n_glb >= 1) then
18495# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18496 r_align274 = (y_cc(0) - y0_274)/y_step274
18497# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18498 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
18499# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18500 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
18501# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18502 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
18503# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18504 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
18505# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18506 end if
18507# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18508
18509# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18510 files_loaded274 = .true.
18511# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18512 end if
18513# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18514 ! Alignment is verified above (or this rank would already have aborted), so the local
18515# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18516 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
18517# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18518 do f274 = 1, sys_size
18519# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18520 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
18521# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18522 end do
18523# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18524 case (271) ! Premixed Flame Vortices Interaction
18525# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18526 if (.not. files_loaded) then
18527# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18528 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
18529# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18530 do f = 1, max_files
18531# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18532 write (file_num_str, '(I0)') f
18533# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18534 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
18535# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18536 end do
18537# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18538
18539# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18540 ! Common file reading setup
18541# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18542 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
18543# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18544 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
18545# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18546
18547# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18548 select case (num_dims)
18549# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18550 case (1, 2) ! 1D and 2D cases are similar
18551# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18552 ! Count lines
18553# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18554 line_count = 0
18555# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18556 do
18557# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18558 read (unit2, *, iostat=ios2) dummy_x, dummy_y
18559# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18560 if (ios2 /= 0) exit
18561# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18562 line_count = line_count + 1
18563# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18564 end do
18565# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18566 close (unit2)
18567# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18568
18569# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18570 xrows = line_count
18571# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18572 yrows = 1
18573# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18574 index_x = 0
18575# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18576 if (num_dims == 2) index_x = i
18577# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18578#ifdef MFC_DEBUG
18579# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18580 block
18581# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18582 use iso_fortran_env, only: output_unit
18583# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18584
18585# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18586 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
18587# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18588
18589# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18590 call flush (output_unit)
18591# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18592 end block
18593# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18594#endif
18595# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18596 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
18597# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18598
18599# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18600
18601# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18602
18603# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18604#if defined(MFC_OpenACC)
18605# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18606!$acc enter data create(x_coords, stored_values)
18607# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18608#elif defined(MFC_OpenMP)
18609# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18610!$omp target enter data map(always,alloc:x_coords, stored_values)
18611# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18612#endif
18613# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18614
18615# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18616 ! Read data from all files
18617# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18618 do f = 1, max_files
18619# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18620 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
18621# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18622 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
18623# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18624
18625# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18626 do iter = 1, xrows
18627# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18628 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
18629# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18630 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
18631# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18632 end do
18633# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18634 close (unit)
18635# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18636 end do
18637# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18638
18639# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18640 ! Calculate offsets
18641# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18642 domain_xstart = x_coords(1)
18643# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18644 x_step = x_cc(1) - x_cc(0)
18645# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18646 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
18647# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18648 global_offset_x = nint(abs(delta_x)/x_step)
18649# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18650 case (3) ! 3D case - determine grid structure
18651# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18652 ! Find yRows by counting rows with same x
18653# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18654 read (unit2, *, iostat=ios2) x0, y0, dummy_z
18655# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18656 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
18657# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18658
18659# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18660 yrows = 1
18661# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18662 do
18663# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18664 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
18665# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18666 if (ios2 /= 0) exit
18667# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18668 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
18669# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18670 yrows = yrows + 1
18671# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18672 else
18673# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18674 exit
18675# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18676 end if
18677# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18678 end do
18679# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18680 close (unit2)
18681# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18682
18683# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18684 ! Count total rows
18685# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18686 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
18687# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18688 nrows = 0
18689# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18690 do
18691# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18692 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
18693# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18694 if (ios2 /= 0) exit
18695# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18696 nrows = nrows + 1
18697# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18698 end do
18699# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18700 close (unit2)
18701# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18702
18703# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18704 xrows = nrows/yrows
18705# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18706#ifdef MFC_DEBUG
18707# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18708 block
18709# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18710 use iso_fortran_env, only: output_unit
18711# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18712
18713# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18714 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
18715# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18716
18717# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18718 call flush (output_unit)
18719# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18720 end block
18721# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18722#endif
18723# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18724 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
18725# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18726
18727# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18728
18729# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18730
18731# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18732
18733# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18734#if defined(MFC_OpenACC)
18735# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18736!$acc enter data create(x_coords, y_coords, stored_values)
18737# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18738#elif defined(MFC_OpenMP)
18739# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18740!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
18741# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18742#endif
18743# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18744 index_x = i
18745# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18746 index_y = j
18747# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18748
18749# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18750 ! Read all files
18751# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18752 do f = 1, max_files
18753# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18754 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
18755# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18756 if (ios /= 0) then
18757# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18758 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
18759# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18760 cycle
18761# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18762 end if
18763# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18764
18765# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18766 iter = 0
18767# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18768 do iix = 1, xrows
18769# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18770 do iiy = 1, yrows
18771# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18772 iter = iter + 1
18773# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18774 if (f == 1) then
18775# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18776 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
18777# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18778 else
18779# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18780 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
18781# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18782 end if
18783# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18784 if (ios /= 0) call s_mpi_abort("Error reading data")
18785# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18786 end do
18787# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18788 end do
18789# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18790 close (unit)
18791# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18792 end do
18793# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18794
18795# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18796 ! Calculate offsets
18797# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18798 x_step = x_cc(1) - x_cc(0)
18799# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18800 y_step = y_cc(1) - y_cc(0)
18801# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18802 delta_x = x_cc(index_x) - x_coords(1)
18803# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18804 delta_y = y_cc(index_y) - y_coords(1)
18805# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18806 global_offset_x = nint(abs(delta_x)/x_step)
18807# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18808 global_offset_y = nint(abs(delta_y)/y_step)
18809# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18810
18811# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18812 ! The index check below only catches overruns, so a file that is merely too
18813# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18814 ! FINE stays in range and silently supplies a corner of itself. Check spacing
18815# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18816 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
18817# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18818 ! consecutive x values sit yRows apart.
18819# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18820 if (nrows > yrows) then
18821# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18822 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
18823# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18824 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
18825# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18826 end if
18827# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18828 if (yrows > 1) then
18829# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18830 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
18831# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18832 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
18833# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18834 end if
18835# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18836 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
18837# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18838 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
18839# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18840 & wp)) > 1.e-6_wp) &
18841# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18842 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
18843# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18844 end select
18845# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18846
18847# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18848 files_loaded = .true.
18849# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18850 end if
18851# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18852
18853# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18854 ! Data assignment
18855# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18856 select case (num_dims)
18857# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18858 case (1)
18859# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18860 idx = i + 1 + global_offset_x
18861# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18862 ! idx must land inside the file's row range: this rank's subdomain offset
18863# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18864 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
18865# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18866 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
18867# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18868 if (idx < 1 .or. idx > xrows) &
18869# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18870 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
18871# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18872 do f = 1, sys_size
18873# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18874 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
18875# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18876 end do
18877# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18878 case (2)
18879# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18880 idx = i + 1 + global_offset_x - index_x
18881# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18882 if (idx < 1 .or. idx > xrows) &
18883# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18884 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
18885# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18886 do f = 1, sys_size - 1
18887# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18888 jump = merge(1, 0, f >= eqn_idx%mom%end)
18889# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18890 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
18891# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18892 end do
18893# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18894 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
18895# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18896 case (3)
18897# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18898 idx = i + 1 + global_offset_x - index_x
18899# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18900 idy = j + 1 + global_offset_y - index_y
18901# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18902 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
18903# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18904 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
18905# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18906 do f = 1, sys_size - 1
18907# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18908 jump = merge(1, 0, f >= eqn_idx%mom%end)
18909# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18910 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
18911# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18912 end do
18913# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18914 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
18915# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18916 end select
18917# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18918 x1c = 0.0027_wp
18919# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18920 y1c = 0.005_wp
18921# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18922 x2c = 0.0027_wp
18923# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18924 y2c = 0.003_wp
18925# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18926 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
18927# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18928 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
18929# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18930 rvortex = 0.0005_wp
18931# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18932 cvortex = 6000.0_wp
18933# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18934
18935# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18936 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
18937# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18938 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
18939# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18940
18941# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18942 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
18943# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18944 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
18945# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18946 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
18947# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18948 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
18949# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18950 case (272) ! Premixed Flame Instability
18951# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18952 if (.not. files_loaded) then
18953# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18954 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
18955# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18956 do f = 1, max_files
18957# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18958 write (file_num_str, '(I0)') f
18959# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18960 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
18961# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18962 end do
18963# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18964
18965# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18966 ! Common file reading setup
18967# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18968 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
18969# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18970 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
18971# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18972
18973# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18974 select case (num_dims)
18975# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18976 case (1, 2) ! 1D and 2D cases are similar
18977# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18978 ! Count lines
18979# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18980 line_count = 0
18981# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18982 do
18983# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18984 read (unit2, *, iostat=ios2) dummy_x, dummy_y
18985# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18986 if (ios2 /= 0) exit
18987# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18988 line_count = line_count + 1
18989# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18990 end do
18991# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18992 close (unit2)
18993# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18994
18995# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18996 xrows = line_count
18997# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
18998 yrows = 1
18999# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19000 index_x = 0
19001# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19002 if (num_dims == 2) index_x = i
19003# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19004#ifdef MFC_DEBUG
19005# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19006 block
19007# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19008 use iso_fortran_env, only: output_unit
19009# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19010
19011# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19012 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
19013# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19014
19015# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19016 call flush (output_unit)
19017# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19018 end block
19019# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19020#endif
19021# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19022 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
19023# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19024
19025# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19026
19027# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19028
19029# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19030#if defined(MFC_OpenACC)
19031# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19032!$acc enter data create(x_coords, stored_values)
19033# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19034#elif defined(MFC_OpenMP)
19035# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19036!$omp target enter data map(always,alloc:x_coords, stored_values)
19037# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19038#endif
19039# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19040
19041# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19042 ! Read data from all files
19043# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19044 do f = 1, max_files
19045# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19046 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
19047# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19048 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
19049# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19050
19051# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19052 do iter = 1, xrows
19053# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19054 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
19055# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19056 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
19057# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19058 end do
19059# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19060 close (unit)
19061# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19062 end do
19063# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19064
19065# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19066 ! Calculate offsets
19067# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19068 domain_xstart = x_coords(1)
19069# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19070 x_step = x_cc(1) - x_cc(0)
19071# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19072 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
19073# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19074 global_offset_x = nint(abs(delta_x)/x_step)
19075# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19076 case (3) ! 3D case - determine grid structure
19077# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19078 ! Find yRows by counting rows with same x
19079# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19080 read (unit2, *, iostat=ios2) x0, y0, dummy_z
19081# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19082 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
19083# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19084
19085# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19086 yrows = 1
19087# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19088 do
19089# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19090 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
19091# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19092 if (ios2 /= 0) exit
19093# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19094 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
19095# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19096 yrows = yrows + 1
19097# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19098 else
19099# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19100 exit
19101# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19102 end if
19103# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19104 end do
19105# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19106 close (unit2)
19107# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19108
19109# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19110 ! Count total rows
19111# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19112 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
19113# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19114 nrows = 0
19115# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19116 do
19117# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19118 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
19119# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19120 if (ios2 /= 0) exit
19121# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19122 nrows = nrows + 1
19123# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19124 end do
19125# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19126 close (unit2)
19127# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19128
19129# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19130 xrows = nrows/yrows
19131# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19132#ifdef MFC_DEBUG
19133# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19134 block
19135# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19136 use iso_fortran_env, only: output_unit
19137# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19138
19139# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19140 print *, 'm_icpp_patches.fpp:631: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
19141# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19142
19143# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19144 call flush (output_unit)
19145# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19146 end block
19147# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19148#endif
19149# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19150 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
19151# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19152
19153# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19154
19155# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19156
19157# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19158
19159# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19160#if defined(MFC_OpenACC)
19161# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19162!$acc enter data create(x_coords, y_coords, stored_values)
19163# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19164#elif defined(MFC_OpenMP)
19165# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19166!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
19167# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19168#endif
19169# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19170 index_x = i
19171# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19172 index_y = j
19173# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19174
19175# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19176 ! Read all files
19177# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19178 do f = 1, max_files
19179# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19180 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
19181# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19182 if (ios /= 0) then
19183# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19184 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
19185# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19186 cycle
19187# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19188 end if
19189# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19190
19191# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19192 iter = 0
19193# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19194 do iix = 1, xrows
19195# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19196 do iiy = 1, yrows
19197# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19198 iter = iter + 1
19199# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19200 if (f == 1) then
19201# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19202 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
19203# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19204 else
19205# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19206 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
19207# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19208 end if
19209# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19210 if (ios /= 0) call s_mpi_abort("Error reading data")
19211# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19212 end do
19213# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19214 end do
19215# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19216 close (unit)
19217# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19218 end do
19219# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19220
19221# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19222 ! Calculate offsets
19223# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19224 x_step = x_cc(1) - x_cc(0)
19225# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19226 y_step = y_cc(1) - y_cc(0)
19227# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19228 delta_x = x_cc(index_x) - x_coords(1)
19229# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19230 delta_y = y_cc(index_y) - y_coords(1)
19231# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19232 global_offset_x = nint(abs(delta_x)/x_step)
19233# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19234 global_offset_y = nint(abs(delta_y)/y_step)
19235# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19236
19237# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19238 ! The index check below only catches overruns, so a file that is merely too
19239# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19240 ! FINE stays in range and silently supplies a corner of itself. Check spacing
19241# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19242 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
19243# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19244 ! consecutive x values sit yRows apart.
19245# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19246 if (nrows > yrows) then
19247# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19248 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
19249# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19250 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
19251# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19252 end if
19253# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19254 if (yrows > 1) then
19255# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19256 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
19257# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19258 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
19259# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19260 end if
19261# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19262 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
19263# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19264 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
19265# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19266 & wp)) > 1.e-6_wp) &
19267# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19268 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
19269# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19270 end select
19271# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19272
19273# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19274 files_loaded = .true.
19275# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19276 end if
19277# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19278
19279# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19280 ! Data assignment
19281# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19282 select case (num_dims)
19283# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19284 case (1)
19285# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19286 idx = i + 1 + global_offset_x
19287# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19288 ! idx must land inside the file's row range: this rank's subdomain offset
19289# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19290 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
19291# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19292 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
19293# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19294 if (idx < 1 .or. idx > xrows) &
19295# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19296 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
19297# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19298 do f = 1, sys_size
19299# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19300 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
19301# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19302 end do
19303# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19304 case (2)
19305# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19306 idx = i + 1 + global_offset_x - index_x
19307# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19308 if (idx < 1 .or. idx > xrows) &
19309# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19310 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
19311# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19312 do f = 1, sys_size - 1
19313# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19314 jump = merge(1, 0, f >= eqn_idx%mom%end)
19315# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19316 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
19317# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19318 end do
19319# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19320 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
19321# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19322 case (3)
19323# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19324 idx = i + 1 + global_offset_x - index_x
19325# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19326 idy = j + 1 + global_offset_y - index_y
19327# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19328 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
19329# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19330 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
19331# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19332 do f = 1, sys_size - 1
19333# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19334 jump = merge(1, 0, f >= eqn_idx%mom%end)
19335# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19336 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
19337# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19338 end do
19339# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19340 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
19341# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19342 end select
19343# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19344
19345# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19346 y_center = y0_ref
19347# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19348 y_dist = y_cc(j) - y_center
19349# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19350 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
19351# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19352 front_shift = a_param*sin(wave_phase)
19353# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19354
19355# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19356 x_mapped = x_cc(i) - front_shift
19357# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19358
19359# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19360 if (x_mapped <= x_coords(1)) then
19361# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19362 do v = 1, sys_size - 1
19363# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19364 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
19365# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19366 end do
19367# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19368 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
19369# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19370 else if (x_mapped >= x_coords(xrows)) then
19371# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19372 do v = 1, sys_size - 1
19373# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19374 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
19375# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19376 end do
19377# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19378 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
19379# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19380 else
19381# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19382 idx_lo = 1; idx_hi = xrows
19383# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19384 do while (idx_hi - idx_lo > 1)
19385# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19386 idx_mid = (idx_lo + idx_hi)/2
19387# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19388 if (x_coords(idx_mid) <= x_mapped) then
19389# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19390 idx_lo = idx_mid
19391# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19392 else
19393# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19394 idx_hi = idx_mid
19395# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19396 end if
19397# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19398 end do
19399# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19400
19401# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19402 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
19403# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19404
19405# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19406 do v = 1, sys_size - 1
19407# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19408 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, &
19409# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19410 & v) + interp_wt*stored_values(idx_hi, 1, v)
19411# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19412 end do
19413# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19414 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
19415# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19416 end if
19417# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19418 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
19419# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19420 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
19421# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19422 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
19423# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19424 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
19425# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19426 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 &
19427# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19428 & - y_domain%beg))
19429# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19430 if (x_cc(i) > d) then
19431# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19432 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
19433# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19434 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
19435# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19436 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
19437# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19438 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
19439# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19440 do v = eqn_idx%species%beg, eqn_idx%species%end
19441# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19442 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
19443# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19444 end do
19445# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19446 end if
19447# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19448 case (280) ! Isentropic vortex
19449# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19450 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
19451# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19452 ! geometry 2
19453# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19454 if (patch_id == 1) then
19455# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19456 q_prim_vf(eqn_idx%E)%sf(i, j, &
19457# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19458 & 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) &
19459# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19460 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
19461# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19462 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
19463# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19464 & 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) &
19465# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19466 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
19467# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19468 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
19469# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19470 & 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) &
19471# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19472 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
19473# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19474 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
19475# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19476 & 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) &
19477# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19478 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
19479# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19480 end if
19481# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19482 case (281) ! Acoustic pulse
19483# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19484 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
19485# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19486 ! geometry 2
19487# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19488 if (patch_id == 2) then
19489# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19490 q_prim_vf(eqn_idx%E)%sf(i, j, &
19491# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19492 & 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))
19493# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19494 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
19495# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19496 & 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))
19497# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19498 end if
19499# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19500 case (282) ! Zero-circulation vortex
19501# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19502 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
19503# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19504 ! geometry 2
19505# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19506 if (patch_id == 2) then
19507# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19508 q_prim_vf(eqn_idx%E)%sf(i, j, &
19509# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19510 & 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))
19511# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19512 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
19513# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19514 & 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))
19515# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19516 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
19517# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19518 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
19519# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19520 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
19521# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19522 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
19523# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19524 end if
19525# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19526 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
19527# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19528 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
19529# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19530 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
19531# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19532 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
19533# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19534 ! patch_icpp(patch_id)%epsilon; defaults to 5.
19535# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19536 if (patch_id == 1) then
19537# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19538 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
19539# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19540 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
19541# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19542 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
19543# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19544 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
19545# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19546 do igq = 1, 3
19547# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19548 do jgq = 1, 3
19549# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19550 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
19551# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19552 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
19553# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19554 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
19555# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19556 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))
19557# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19558 wq = gauss_w(igq)*gauss_w(jgq)
19559# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19560 rhoq = t_facq**1.4_wp
19561# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19562 pq = t_facq**2.4_wp
19563# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19564 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
19565# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19566 & - r2q)
19567# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19568 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
19569# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19570 & - r2q)
19571# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19572 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
19573# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19574 rho_avg = rho_avg + wq*rhoq
19575# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19576 rhou_avg = rhou_avg + wq*(rhoq*uq)
19577# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19578 rhov_avg = rhov_avg + wq*(rhoq*vq)
19579# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19580 e_avg = e_avg + wq*eq
19581# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19582 end do
19583# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19584 end do
19585# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19586 rho_avg = rho_avg*0.25_wp
19587# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19588 rhou_avg = rhou_avg*0.25_wp
19589# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19590 rhov_avg = rhov_avg*0.25_wp
19591# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19592 e_avg = e_avg*0.25_wp
19593# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19594 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
19595# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19596 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
19597# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19598 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
19599# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19600 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
19601# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19602 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
19603# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19604 end if
19605# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19606 case (291) ! Isothermal Flat Plate
19607# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19608 t_inf = 1125.0_wp
19609# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19610 t_wall = 600.0_wp
19611# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19612 p_atm = 101325.0_wp
19613# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19614
19615# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19616 ! Boundary/Shear Layer thicknesses
19617# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19618 delta_th = 0.0003_wp ! Thermal BL thickness
19619# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19620 delta_shear = 8e-3_wp ! Velocity BL thickness
19621# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19622
19623# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19624 u_max = 50.0_wp ! Freestream Velocity (m/s)
19625# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19626
19627# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19628 mw_n2 = 28.0134e-3_wp
19629# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19630 mw_o2 = 31.999e-3_wp
19631# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19632 y_n2 = 0.767_wp
19633# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19634 y_o2 = 0.233_wp
19635# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19636 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
19637# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19638 bottom_blend_u = tanh(y_cc(j)/delta_shear)
19639# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19640 bottom_blend_t = tanh(y_cc(j)/delta_th)
19641# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19642 u_mean = u_max*bottom_blend_u
19643# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19644 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
19645# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19646 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
19647# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19648 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
19649# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19650 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
19651# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19652 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
19653# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19654 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
19655# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19656 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
19657# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19658 case default
19659# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19660 if (proc_rank == 0) then
19661# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19662 call s_int_to_str(patch_id, istr)
19663# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19664 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
19665# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19666 end if
19667# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19668 end select
19669# 632 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19670 end if
19671
19672 ! Updating the patch identities bookkeeping variable
19673 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
19674 end if
19675 end if
19676 end do
19677 end do
19678 if (allocated(stored_values)) then
19679# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19680#ifdef MFC_DEBUG
19681# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19682 block
19683# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19684 use iso_fortran_env, only: output_unit
19685# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19686
19687# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19688 print *, 'm_icpp_patches.fpp:640: ', '@:DEALLOCATE(stored_values)'
19689# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19690
19691# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19692 call flush (output_unit)
19693# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19694 end block
19695# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19696#endif
19697# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19698
19699# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19700#if defined(MFC_OpenACC)
19701# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19702!$acc exit data delete(stored_values)
19703# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19704#elif defined(MFC_OpenMP)
19705# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19706!$omp target exit data map(release:stored_values)
19707# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19708#endif
19709# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19710 deallocate (stored_values)
19711# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19712#ifdef MFC_DEBUG
19713# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19714 block
19715# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19716 use iso_fortran_env, only: output_unit
19717# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19718
19719# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19720 print *, 'm_icpp_patches.fpp:640: ', '@:DEALLOCATE(x_coords)'
19721# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19722
19723# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19724 call flush (output_unit)
19725# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19726 end block
19727# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19728#endif
19729# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19730
19731# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19732#if defined(MFC_OpenACC)
19733# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19734!$acc exit data delete(x_coords)
19735# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19736#elif defined(MFC_OpenMP)
19737# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19738!$omp target exit data map(release:x_coords)
19739# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19740#endif
19741# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19742 deallocate (x_coords)
19743# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19744 end if
19745# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19746
19747# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19748 if (allocated(y_coords)) then
19749# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19750#ifdef MFC_DEBUG
19751# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19752 block
19753# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19754 use iso_fortran_env, only: output_unit
19755# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19756
19757# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19758 print *, 'm_icpp_patches.fpp:640: ', '@:DEALLOCATE(y_coords)'
19759# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19760
19761# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19762 call flush (output_unit)
19763# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19764 end block
19765# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19766#endif
19767# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19768
19769# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19770#if defined(MFC_OpenACC)
19771# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19772!$acc exit data delete(y_coords)
19773# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19774#elif defined(MFC_OpenMP)
19775# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19776!$omp target exit data map(release:y_coords)
19777# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19778#endif
19779# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19780 deallocate (y_coords)
19781# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19782 end if
19783# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19784
19785# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19786 files_loaded = .false.
19787# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19788
19789# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19790 if (allocated(stored_values274)) then
19791# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19792#ifdef MFC_DEBUG
19793# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19794 block
19795# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19796 use iso_fortran_env, only: output_unit
19797# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19798
19799# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19800 print *, 'm_icpp_patches.fpp:640: ', '@:DEALLOCATE(stored_values274)'
19801# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19802
19803# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19804 call flush (output_unit)
19805# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19806 end block
19807# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19808#endif
19809# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19810
19811# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19812#if defined(MFC_OpenACC)
19813# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19814!$acc exit data delete(stored_values274)
19815# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19816#elif defined(MFC_OpenMP)
19817# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19818!$omp target exit data map(release:stored_values274)
19819# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19820#endif
19821# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19822 deallocate (stored_values274)
19823# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19824 end if
19825# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19826
19827# 640 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19828 files_loaded274 = .false.
19829# 641 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19830
19831 end subroutine s_icpp_rectangle
19832
19833 !> The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
19834 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
19835 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep line patch DOES allow
19836 !! the smoothing of its boundary.
19837 subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
19838
19839 integer, intent(in) :: patch_id
19840
19841#ifdef MFC_MIXED_PRECISION
19842 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
19843#else
19844 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
19845#endif
19846 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
19847 integer :: i, j, k !< Generic loop operators
19848 real(wp) :: a, b, c
19849
19850 integer :: xRows, yRows, nRows, iix, iiy, max_files
19851# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19852 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
19853# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19854 real(wp) :: x_step, y_step
19855# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19856 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
19857# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19858 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
19859# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19860 real(wp) :: delta_x, delta_y
19861# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19862 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
19863# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19864 real(wp), allocatable :: stored_values(:,:,:)
19865# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19866 real(wp), allocatable :: x_coords(:), y_coords(:)
19867# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19868 logical :: files_loaded = .false.
19869# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19870 real(wp) :: domain_xstart
19871# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19872 character(len=20) :: file_num_str !< For storing the file number as a string
19873# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19874 integer :: ios
19875# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19876 integer :: ios2
19877# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19878
19879# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19880 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
19881# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19882 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
19883# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19884 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
19885# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19886 ! y_coords/files_loaded above.
19887# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19888 real(wp), allocatable, dimension(:,:,:) :: stored_values274
19889# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19890 logical :: files_loaded274 = .false.
19891# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19892 integer :: f274, ix274, iy274, unit274, ios274
19893# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19894 integer :: local_ix_beg274, local_iy_beg274
19895# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19896 character(len=300) :: fname274
19897# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19898 character(len=20) :: file_num_str274
19899# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19900 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
19901# 661 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19902 real(wp) :: file_dx274, file_dy274, r_align274
19903# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19904 ! Place any declaration of intermediate variables here
19905# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19906 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
19907# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19908 real(wp) :: eps
19909# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19910 real(wp) :: zlen371, kz371
19911# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19912
19913# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19914 ! IGR Jets Arrays to stor position and radii of jets from input file
19915# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19916 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
19917# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19918 ! Variables to describe initial condition of jet
19919# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19920 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
19921# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19922 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
19923# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19924 real(wp), dimension(0:n,0:p) :: rcut_arr
19925# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19926 integer :: l, q, s !< Iterators for reading input files
19927# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19928 integer :: start, end !< Ints to keep track of position in file
19929# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19930 character(len=100000) :: line ! String to store line in file
19931# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19932 character(len=25) :: value !< String to store value in line
19933# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19934 integer :: NJet !< Number of jets
19935# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19936 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
19937# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19938 logical :: file_exist ! Flag to check if file exists
19939# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19940
19941# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19942 eps = 1e-9_wp
19943# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19944
19945# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19946 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
19947# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19948 eps_smooth = 3._wp
19949# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19950 inquire (file="njet.txt", exist=file_exist)
19951# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19952 if (file_exist) then
19953# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19954 open (unit=10, file="njet.txt", status="old", action="read")
19955# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19956 read (10, *) njet
19957# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19958 close (10)
19959# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19960 else
19961# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19962 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
19963# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19964 end if
19965# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19966
19967# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19968#ifdef MFC_DEBUG
19969# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19970 block
19971# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19972 use iso_fortran_env, only: output_unit
19973# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19974
19975# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19976 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
19977# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19978
19979# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19980 call flush (output_unit)
19981# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19982 end block
19983# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19984#endif
19985# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19986 allocate (y_th_arr(0:njet - 1))
19987# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19988
19989# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19990
19991# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19992#if defined(MFC_OpenACC)
19993# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19994!$acc enter data create(y_th_arr)
19995# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19996#elif defined(MFC_OpenMP)
19997# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
19998!$omp target enter data map(always,alloc:y_th_arr)
19999# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20000#endif
20001# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20002#ifdef MFC_DEBUG
20003# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20004 block
20005# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20006 use iso_fortran_env, only: output_unit
20007# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20008
20009# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20010 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
20011# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20012
20013# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20014 call flush (output_unit)
20015# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20016 end block
20017# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20018#endif
20019# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20020 allocate (z_th_arr(0:njet - 1))
20021# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20022
20023# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20024
20025# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20026#if defined(MFC_OpenACC)
20027# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20028!$acc enter data create(z_th_arr)
20029# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20030#elif defined(MFC_OpenMP)
20031# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20032!$omp target enter data map(always,alloc:z_th_arr)
20033# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20034#endif
20035# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20036#ifdef MFC_DEBUG
20037# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20038 block
20039# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20040 use iso_fortran_env, only: output_unit
20041# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20042
20043# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20044 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
20045# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20046
20047# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20048 call flush (output_unit)
20049# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20050 end block
20051# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20052#endif
20053# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20054 allocate (r_th_arr(0:njet - 1))
20055# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20056
20057# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20058
20059# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20060#if defined(MFC_OpenACC)
20061# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20062!$acc enter data create(r_th_arr)
20063# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20064#elif defined(MFC_OpenMP)
20065# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20066!$omp target enter data map(always,alloc:r_th_arr)
20067# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20068#endif
20069# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20070
20071# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20072 inquire (file="jets.csv", exist=file_exist)
20073# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20074 if (file_exist) then
20075# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20076 open (unit=10, file="jets.csv", status="old", action="read")
20077# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20078 do q = 0, njet - 1
20079# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20080 read (10, '(A)') line ! Read a full line as a string
20081# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20082 start = 1
20083# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20084
20085# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20086 do l = 0, 2
20087# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20088 end = index(line(start:), ',') ! Find the next comma
20089# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20090 if (end == 0) then
20091# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20092 value = trim(adjustl(line(start:))) ! Last value in the line
20093# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20094 else
20095# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20096 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
20097# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20098 start = start + end ! Move to next value
20099# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20100 end if
20101# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20102 if (l == 0) then
20103# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20104 read (value, *) y_th_arr(q) ! Convert string to numeric value
20105# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20106 else if (l == 1) then
20107# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20108 read (value, *) z_th_arr(q)
20109# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20110 else
20111# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20112 read (value, *) r_th_arr(q)
20113# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20114 end if
20115# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20116 end do
20117# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20118 end do
20119# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20120 close (10)
20121# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20122
20123# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20124 do q = 0, p
20125# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20126 do l = 0, n
20127# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20128 rcut = 0._wp
20129# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20130 do s = 0, njet - 1
20131# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20132 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
20133# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20134 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
20135# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20136 end do
20137# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20138 rcut_arr(l, q) = rcut
20139# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20140 end do
20141# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20142 end do
20143# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20144 else
20145# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20146 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
20147# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20148 end if
20149# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20150 end if
20151# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20152
20153# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20154 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
20155# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20156#ifdef MFC_DEBUG
20157# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20158 block
20159# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20160 use iso_fortran_env, only: output_unit
20161# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20162
20163# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20164 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
20165# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20166
20167# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20168 call flush (output_unit)
20169# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20170 end block
20171# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20172#endif
20173# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20174 allocate (ih(0:n_glb, 0:p_glb))
20175# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20176
20177# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20178
20179# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20180#if defined(MFC_OpenACC)
20181# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20182!$acc enter data create(ih)
20183# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20184#elif defined(MFC_OpenMP)
20185# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20186!$omp target enter data map(always,alloc:ih)
20187# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20188#endif
20189# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20190
20191# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20192 if (interface_file == '.') then
20193# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20194 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
20195# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20196 else
20197# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20198 inquire (file=trim(interface_file), exist=file_exist)
20199# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20200 if (file_exist) then
20201# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20202 open (unit=10, file=trim(interface_file), status="old", action="read")
20203# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20204 do i = 0, n_glb
20205# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20206 read (10, '(A)') line ! Read a full line as a string
20207# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20208 start = 1
20209# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20210
20211# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20212 do j = 0, p_glb
20213# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20214 end = index(line(start:), ',') ! Find the next comma
20215# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20216 if (end == 0) then
20217# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20218 value = trim(adjustl(line(start:))) ! Last value in the line
20219# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20220 else
20221# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20222 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
20223# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20224 start = start + end ! Move to next value
20225# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20226 end if
20227# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20228 read (value, *) ih(i, j) ! Convert string to numeric value
20229# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20230 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
20231# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20232 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
20233# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20234 end do
20235# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20236 end do
20237# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20238 close (10)
20239# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20240 else
20241# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20242 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
20243# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20244 end if
20245# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20246 end if
20247# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20248 end if
20249# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20250
20251# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20252 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
20253# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20254#ifdef MFC_DEBUG
20255# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20256 block
20257# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20258 use iso_fortran_env, only: output_unit
20259# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20260
20261# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20262 print *, 'm_icpp_patches.fpp:662: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
20263# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20264
20265# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20266 call flush (output_unit)
20267# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20268 end block
20269# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20270#endif
20271# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20272 allocate (ih(0:n_glb, 0:0))
20273# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20274
20275# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20276
20277# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20278#if defined(MFC_OpenACC)
20279# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20280!$acc enter data create(ih)
20281# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20282#elif defined(MFC_OpenMP)
20283# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20284!$omp target enter data map(always,alloc:ih)
20285# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20286#endif
20287# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20288 if (interface_file == '.') then
20289# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20290 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
20291# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20292 else
20293# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20294 inquire (file=trim(interface_file), exist=file_exist)
20295# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20296 if (file_exist) then
20297# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20298 open (unit=10, file=trim(interface_file), status="old", action="read")
20299# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20300 do i = 0, n_glb
20301# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20302 read (10, '(A)') line ! Read a full line as a string
20303# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20304 value = trim(line)
20305# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20306 read (value, *) ih(i, 0) ! Convert string to numeric value
20307# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20308 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
20309# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20310 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
20311# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20312 end do
20313# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20314 close (10)
20315# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20316 else
20317# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20318 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
20319# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20320 end if
20321# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20322 end if
20323# 662 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20324 end if
20325# 663 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20326
20327 ! Transferring the centroid information of the line to be swept
20328 x_centroid = patch_icpp(patch_id)%x_centroid
20329 y_centroid = patch_icpp(patch_id)%y_centroid
20330 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
20331 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
20332
20333 ! Obtaining coefficients of the equation describing the sweep line
20334 a = patch_icpp(patch_id)%normal(1)
20335 b = patch_icpp(patch_id)%normal(2)
20336 c = -a*x_centroid - b*y_centroid
20337
20338 ! Initialize eta=1; modified if smoothing is enabled
20339 eta = 1._wp
20340
20341 ! Assign patch vars if cell is covered and patch has write permission
20342 do j = 0, n
20343 do i = 0, m
20344 if (patch_icpp(patch_id)%smoothen) then
20345 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))
20346 end if
20347
20348 if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, &
20349 & 0))) .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
20350 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
20351
20352
20353# 690 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20354 if (patch_icpp(patch_id)%hcid /= dflt_int) then
20355 select case (patch_icpp(patch_id)%hcid)
20356# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20357 case (300) ! Rayleigh-Taylor instability
20358# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20359 rhoh = 3._wp
20360# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20361 rhol = 1._wp
20362# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20363 pref = 1.e5_wp
20364# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20365 pint = pref
20366# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20367 h = 0.7_wp
20368# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20369 lam = 0.2_wp
20370# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20371 wl = 2._wp*pi/lam
20372# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20373 amp = 0.025_wp/wl
20374# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20375
20376# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20377 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
20378# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20379
20380# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20381 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
20382# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20383
20384# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20385 if (alph < eps) alph = eps
20386# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20387 if (alph > 1._wp - eps) alph = 1._wp - eps
20388# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20389
20390# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20391 if (y_cc(j) > inth) then
20392# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20393 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
20394# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20395 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
20396# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20397 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
20398# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20399 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
20400# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20401 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
20402# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20403 else
20404# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20405 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
20406# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20407 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
20408# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20409 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
20410# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20411 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
20412# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20413 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
20414# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20415 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
20416# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20417 end if
20418# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20419 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
20420# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20421 h = 0.0_wp
20422# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20423 lam = 1.0_wp
20424# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20425 amp = patch_icpp(patch_id)%a(2)
20426# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20427 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
20428# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20429 if (x_cc(i) > inth) then
20430# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20431 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
20432# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20433 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
20434# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20435 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
20436# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20437 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
20438# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20439 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
20440# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20441 end if
20442# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20443 case (302) ! 3D Jet with IGR
20444# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20445 ux_th = 10*sqrt(1.4*0.4)
20446# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20447 ux_am = 0.0*sqrt(1.4)
20448# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20449 p_th = 2.0_wp
20450# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20451 p_am = 1.0_wp
20452# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20453 rho_th = 1._wp
20454# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20455 rho_am = 1._wp
20456# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20457 y_th = 0.0_wp
20458# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20459 z_th = 0.0_wp
20460# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20461 r_th = 1._wp
20462# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20463 eps_smooth = 1._wp
20464# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20465 eps = 1e-6
20466# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20467
20468# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20469 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
20470# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20471 rcut = f_cut_on(r - r_th, eps_smooth)
20472# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20473 xcut = f_cut_on(x_cc(i), eps_smooth)
20474# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20475
20476# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20477 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
20478# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20479 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
20480# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20481 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
20482# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20483
20484# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20485 if (num_fluids == 1) then
20486# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20487 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
20488# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20489 else
20490# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20491 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
20492# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20493 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
20494# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20495 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))
20496# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20497 end if
20498# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20499
20500# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20501 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
20502# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20503 case (303) ! 3D Multijet
20504# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20505 eps_smooth = 3.0_wp
20506# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20507 ux_th = 10*sqrt(1.4*0.4)
20508# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20509 ux_am = 2.5*sqrt(1.4*0.4)
20510# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20511 p_th = 0.8_wp
20512# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20513 p_am = 0.4_wp
20514# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20515 rho_th = 1._wp
20516# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20517 rho_am = 1._wp
20518# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20519 eps = 1e-6
20520# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20521
20522# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20523 rcut = rcut_arr(j, k)
20524# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20525 xcut = f_cut_on(x_cc(i), eps_smooth)
20526# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20527
20528# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20529 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
20530# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20531 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
20532# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20533 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
20534# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20535
20536# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20537 if (num_fluids == 1) then
20538# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20539 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
20540# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20541 else
20542# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20543 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
20544# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20545 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
20546# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20547 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))
20548# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20549 end if
20550# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20551
20552# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20553 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
20554# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20555 case (304) ! 3D Interface from file cartesian
20556# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20557 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)))
20558# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20559
20560# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20561 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
20562# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20563 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
20564# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20565
20566# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20567 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)
20568# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20569 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)
20570# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20571
20572# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20573 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, &
20574# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20575 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
20576# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20577
20578# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20579 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
20580# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20581 case (305) ! 3D Interface from file axisymmetric
20582# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20583 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)))
20584# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20585
20586# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20587 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
20588# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20589 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
20590# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20591
20592# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20593 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
20594# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20595 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)
20596# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20597
20598# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20599 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, &
20600# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20601 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
20602# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20603
20604# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20605 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
20606# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20607 case (370) ! 3D extrusion of 2D profile from external data
20608# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20609 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
20610# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20611 if (.not. files_loaded) then
20612# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20613 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
20614# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20615 do f = 1, max_files
20616# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20617 write (file_num_str, '(I0)') f
20618# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20619 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
20620# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20621 end do
20622# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20623
20624# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20625 ! Common file reading setup
20626# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20627 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
20628# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20629 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
20630# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20631
20632# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20633 select case (num_dims)
20634# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20635 case (1, 2) ! 1D and 2D cases are similar
20636# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20637 ! Count lines
20638# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20639 line_count = 0
20640# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20641 do
20642# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20643 read (unit2, *, iostat=ios2) dummy_x, dummy_y
20644# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20645 if (ios2 /= 0) exit
20646# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20647 line_count = line_count + 1
20648# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20649 end do
20650# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20651 close (unit2)
20652# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20653
20654# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20655 xrows = line_count
20656# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20657 yrows = 1
20658# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20659 index_x = 0
20660# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20661 if (num_dims == 2) index_x = i
20662# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20663#ifdef MFC_DEBUG
20664# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20665 block
20666# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20667 use iso_fortran_env, only: output_unit
20668# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20669
20670# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20671 print *, 'm_icpp_patches.fpp:691: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
20672# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20673
20674# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20675 call flush (output_unit)
20676# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20677 end block
20678# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20679#endif
20680# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20681 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
20682# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20683
20684# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20685
20686# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20687
20688# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20689#if defined(MFC_OpenACC)
20690# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20691!$acc enter data create(x_coords, stored_values)
20692# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20693#elif defined(MFC_OpenMP)
20694# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20695!$omp target enter data map(always,alloc:x_coords, stored_values)
20696# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20697#endif
20698# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20699
20700# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20701 ! Read data from all files
20702# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20703 do f = 1, max_files
20704# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20705 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
20706# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20707 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
20708# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20709
20710# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20711 do iter = 1, xrows
20712# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20713 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
20714# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20715 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
20716# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20717 end do
20718# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20719 close (unit)
20720# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20721 end do
20722# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20723
20724# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20725 ! Calculate offsets
20726# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20727 domain_xstart = x_coords(1)
20728# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20729 x_step = x_cc(1) - x_cc(0)
20730# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20731 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
20732# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20733 global_offset_x = nint(abs(delta_x)/x_step)
20734# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20735 case (3) ! 3D case - determine grid structure
20736# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20737 ! Find yRows by counting rows with same x
20738# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20739 read (unit2, *, iostat=ios2) x0, y0, dummy_z
20740# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20741 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
20742# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20743
20744# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20745 yrows = 1
20746# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20747 do
20748# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20749 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
20750# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20751 if (ios2 /= 0) exit
20752# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20753 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
20754# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20755 yrows = yrows + 1
20756# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20757 else
20758# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20759 exit
20760# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20761 end if
20762# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20763 end do
20764# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20765 close (unit2)
20766# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20767
20768# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20769 ! Count total rows
20770# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20771 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
20772# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20773 nrows = 0
20774# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20775 do
20776# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20777 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
20778# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20779 if (ios2 /= 0) exit
20780# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20781 nrows = nrows + 1
20782# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20783 end do
20784# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20785 close (unit2)
20786# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20787
20788# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20789 xrows = nrows/yrows
20790# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20791#ifdef MFC_DEBUG
20792# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20793 block
20794# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20795 use iso_fortran_env, only: output_unit
20796# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20797
20798# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20799 print *, 'm_icpp_patches.fpp:691: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
20800# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20801
20802# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20803 call flush (output_unit)
20804# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20805 end block
20806# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20807#endif
20808# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20809 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
20810# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20811
20812# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20813
20814# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20815
20816# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20817
20818# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20819#if defined(MFC_OpenACC)
20820# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20821!$acc enter data create(x_coords, y_coords, stored_values)
20822# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20823#elif defined(MFC_OpenMP)
20824# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20825!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
20826# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20827#endif
20828# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20829 index_x = i
20830# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20831 index_y = j
20832# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20833
20834# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20835 ! Read all files
20836# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20837 do f = 1, max_files
20838# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20839 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
20840# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20841 if (ios /= 0) then
20842# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20843 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
20844# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20845 cycle
20846# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20847 end if
20848# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20849
20850# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20851 iter = 0
20852# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20853 do iix = 1, xrows
20854# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20855 do iiy = 1, yrows
20856# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20857 iter = iter + 1
20858# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20859 if (f == 1) then
20860# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20861 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
20862# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20863 else
20864# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20865 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
20866# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20867 end if
20868# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20869 if (ios /= 0) call s_mpi_abort("Error reading data")
20870# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20871 end do
20872# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20873 end do
20874# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20875 close (unit)
20876# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20877 end do
20878# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20879
20880# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20881 ! Calculate offsets
20882# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20883 x_step = x_cc(1) - x_cc(0)
20884# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20885 y_step = y_cc(1) - y_cc(0)
20886# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20887 delta_x = x_cc(index_x) - x_coords(1)
20888# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20889 delta_y = y_cc(index_y) - y_coords(1)
20890# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20891 global_offset_x = nint(abs(delta_x)/x_step)
20892# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20893 global_offset_y = nint(abs(delta_y)/y_step)
20894# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20895
20896# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20897 ! The index check below only catches overruns, so a file that is merely too
20898# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20899 ! FINE stays in range and silently supplies a corner of itself. Check spacing
20900# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20901 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
20902# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20903 ! consecutive x values sit yRows apart.
20904# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20905 if (nrows > yrows) then
20906# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20907 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
20908# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20909 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
20910# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20911 end if
20912# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20913 if (yrows > 1) then
20914# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20915 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
20916# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20917 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
20918# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20919 end if
20920# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20921 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
20922# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20923 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
20924# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20925 & wp)) > 1.e-6_wp) &
20926# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20927 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
20928# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20929 end select
20930# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20931
20932# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20933 files_loaded = .true.
20934# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20935 end if
20936# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20937
20938# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20939 ! Data assignment
20940# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20941 select case (num_dims)
20942# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20943 case (1)
20944# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20945 idx = i + 1 + global_offset_x
20946# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20947 ! idx must land inside the file's row range: this rank's subdomain offset
20948# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20949 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
20950# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20951 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
20952# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20953 if (idx < 1 .or. idx > xrows) &
20954# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20955 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
20956# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20957 do f = 1, sys_size
20958# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20959 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
20960# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20961 end do
20962# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20963 case (2)
20964# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20965 idx = i + 1 + global_offset_x - index_x
20966# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20967 if (idx < 1 .or. idx > xrows) &
20968# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20969 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
20970# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20971 do f = 1, sys_size - 1
20972# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20973 jump = merge(1, 0, f >= eqn_idx%mom%end)
20974# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20975 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
20976# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20977 end do
20978# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20979 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
20980# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20981 case (3)
20982# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20983 idx = i + 1 + global_offset_x - index_x
20984# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20985 idy = j + 1 + global_offset_y - index_y
20986# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20987 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
20988# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20989 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
20990# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20991 do f = 1, sys_size - 1
20992# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20993 jump = merge(1, 0, f >= eqn_idx%mom%end)
20994# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20995 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
20996# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20997 end do
20998# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
20999 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
21000# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21001 end select
21002# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21003 case (371) ! hcid=370 + closed-form spanwise (z) modulation for genuine 3D content
21004# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21005 ! hcid=370's read extrudes the (x,y) file uniformly across z, leaving the flow
21006# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21007 ! z-invariant. Modulate the file's cross-stream (y) velocity by a z-dependent
21008# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21009 ! factor and set the spanwise (w) component from the result, so both inherit the
21010# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21011 ! file's shear-layer localization and amplitude scale. Streamwise (x) is left as
21012# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21013 ! read. This scales the whole y-velocity, which is the perturbation alone only
21014# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21015 ! when the base state has v == 0, as a temporal mixing layer does.
21016# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21017 !
21018# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21019 ! kz uses the GLOBAL z extent: p and z_cc(0:p) are per-rank under MPI, so a local
21020# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21021 ! extent would scale kz by num_procs_z and break periodicity at the z wrap.
21022# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21023 ! z_cc(k) is already absolute, so the phase needs no offset. Assumes uniform dz.
21024# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21025 if (.not. files_loaded) then
21026# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21027 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
21028# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21029 do f = 1, max_files
21030# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21031 write (file_num_str, '(I0)') f
21032# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21033 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
21034# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21035 end do
21036# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21037
21038# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21039 ! Common file reading setup
21040# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21041 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
21042# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21043 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
21044# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21045
21046# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21047 select case (num_dims)
21048# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21049 case (1, 2) ! 1D and 2D cases are similar
21050# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21051 ! Count lines
21052# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21053 line_count = 0
21054# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21055 do
21056# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21057 read (unit2, *, iostat=ios2) dummy_x, dummy_y
21058# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21059 if (ios2 /= 0) exit
21060# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21061 line_count = line_count + 1
21062# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21063 end do
21064# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21065 close (unit2)
21066# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21067
21068# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21069 xrows = line_count
21070# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21071 yrows = 1
21072# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21073 index_x = 0
21074# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21075 if (num_dims == 2) index_x = i
21076# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21077#ifdef MFC_DEBUG
21078# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21079 block
21080# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21081 use iso_fortran_env, only: output_unit
21082# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21083
21084# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21085 print *, 'm_icpp_patches.fpp:691: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
21086# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21087
21088# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21089 call flush (output_unit)
21090# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21091 end block
21092# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21093#endif
21094# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21095 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
21096# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21097
21098# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21099
21100# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21101
21102# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21103#if defined(MFC_OpenACC)
21104# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21105!$acc enter data create(x_coords, stored_values)
21106# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21107#elif defined(MFC_OpenMP)
21108# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21109!$omp target enter data map(always,alloc:x_coords, stored_values)
21110# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21111#endif
21112# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21113
21114# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21115 ! Read data from all files
21116# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21117 do f = 1, max_files
21118# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21119 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
21120# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21121 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
21122# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21123
21124# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21125 do iter = 1, xrows
21126# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21127 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
21128# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21129 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
21130# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21131 end do
21132# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21133 close (unit)
21134# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21135 end do
21136# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21137
21138# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21139 ! Calculate offsets
21140# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21141 domain_xstart = x_coords(1)
21142# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21143 x_step = x_cc(1) - x_cc(0)
21144# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21145 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
21146# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21147 global_offset_x = nint(abs(delta_x)/x_step)
21148# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21149 case (3) ! 3D case - determine grid structure
21150# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21151 ! Find yRows by counting rows with same x
21152# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21153 read (unit2, *, iostat=ios2) x0, y0, dummy_z
21154# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21155 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
21156# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21157
21158# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21159 yrows = 1
21160# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21161 do
21162# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21163 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
21164# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21165 if (ios2 /= 0) exit
21166# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21167 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
21168# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21169 yrows = yrows + 1
21170# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21171 else
21172# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21173 exit
21174# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21175 end if
21176# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21177 end do
21178# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21179 close (unit2)
21180# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21181
21182# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21183 ! Count total rows
21184# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21185 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
21186# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21187 nrows = 0
21188# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21189 do
21190# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21191 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
21192# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21193 if (ios2 /= 0) exit
21194# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21195 nrows = nrows + 1
21196# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21197 end do
21198# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21199 close (unit2)
21200# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21201
21202# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21203 xrows = nrows/yrows
21204# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21205#ifdef MFC_DEBUG
21206# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21207 block
21208# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21209 use iso_fortran_env, only: output_unit
21210# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21211
21212# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21213 print *, 'm_icpp_patches.fpp:691: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
21214# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21215
21216# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21217 call flush (output_unit)
21218# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21219 end block
21220# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21221#endif
21222# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21223 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
21224# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21225
21226# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21227
21228# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21229
21230# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21231
21232# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21233#if defined(MFC_OpenACC)
21234# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21235!$acc enter data create(x_coords, y_coords, stored_values)
21236# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21237#elif defined(MFC_OpenMP)
21238# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21239!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
21240# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21241#endif
21242# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21243 index_x = i
21244# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21245 index_y = j
21246# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21247
21248# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21249 ! Read all files
21250# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21251 do f = 1, max_files
21252# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21253 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
21254# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21255 if (ios /= 0) then
21256# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21257 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
21258# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21259 cycle
21260# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21261 end if
21262# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21263
21264# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21265 iter = 0
21266# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21267 do iix = 1, xrows
21268# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21269 do iiy = 1, yrows
21270# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21271 iter = iter + 1
21272# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21273 if (f == 1) then
21274# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21275 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
21276# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21277 else
21278# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21279 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
21280# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21281 end if
21282# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21283 if (ios /= 0) call s_mpi_abort("Error reading data")
21284# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21285 end do
21286# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21287 end do
21288# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21289 close (unit)
21290# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21291 end do
21292# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21293
21294# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21295 ! Calculate offsets
21296# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21297 x_step = x_cc(1) - x_cc(0)
21298# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21299 y_step = y_cc(1) - y_cc(0)
21300# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21301 delta_x = x_cc(index_x) - x_coords(1)
21302# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21303 delta_y = y_cc(index_y) - y_coords(1)
21304# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21305 global_offset_x = nint(abs(delta_x)/x_step)
21306# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21307 global_offset_y = nint(abs(delta_y)/y_step)
21308# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21309
21310# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21311 ! The index check below only catches overruns, so a file that is merely too
21312# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21313 ! FINE stays in range and silently supplies a corner of itself. Check spacing
21314# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21315 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
21316# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21317 ! consecutive x values sit yRows apart.
21318# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21319 if (nrows > yrows) then
21320# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21321 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
21322# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21323 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
21324# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21325 end if
21326# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21327 if (yrows > 1) then
21328# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21329 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
21330# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21331 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
21332# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21333 end if
21334# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21335 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
21336# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21337 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
21338# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21339 & wp)) > 1.e-6_wp) &
21340# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21341 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
21342# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21343 end select
21344# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21345
21346# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21347 files_loaded = .true.
21348# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21349 end if
21350# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21351
21352# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21353 ! Data assignment
21354# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21355 select case (num_dims)
21356# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21357 case (1)
21358# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21359 idx = i + 1 + global_offset_x
21360# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21361 ! idx must land inside the file's row range: this rank's subdomain offset
21362# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21363 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
21364# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21365 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
21366# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21367 if (idx < 1 .or. idx > xrows) &
21368# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21369 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
21370# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21371 do f = 1, sys_size
21372# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21373 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
21374# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21375 end do
21376# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21377 case (2)
21378# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21379 idx = i + 1 + global_offset_x - index_x
21380# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21381 if (idx < 1 .or. idx > xrows) &
21382# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21383 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
21384# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21385 do f = 1, sys_size - 1
21386# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21387 jump = merge(1, 0, f >= eqn_idx%mom%end)
21388# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21389 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
21390# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21391 end do
21392# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21393 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
21394# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21395 case (3)
21396# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21397 idx = i + 1 + global_offset_x - index_x
21398# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21399 idy = j + 1 + global_offset_y - index_y
21400# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21401 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
21402# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21403 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
21404# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21405 do f = 1, sys_size - 1
21406# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21407 jump = merge(1, 0, f >= eqn_idx%mom%end)
21408# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21409 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
21410# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21411 end do
21412# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21413 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
21414# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21415 end select
21416# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21417 zlen371 = real(p_glb + 1, wp)*(z_cb(0) - z_cb(-1))
21418# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21419 kz371 = 2._wp*pi/zlen371
21420# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21421 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*(1._wp + 0.5_wp*cos(kz371*z_cc(k)))
21422# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21423 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.5_wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*sin(kz371*z_cc(k) + pi/3._wp)
21424# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21425 case (380) ! Taylor-Green vortex
21426# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21427 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
21428# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21429 ! geometry 9
21430# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21431 mach = 0.1
21432# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21433 if (patch_id == 1) then
21434# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21435 q_prim_vf(eqn_idx%E)%sf(i, j, &
21436# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21437 & 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)
21438# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21439 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)
21440# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21441 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)
21442# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21443 end if
21444# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21445 case default
21446# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21447 call s_int_to_str(patch_id, istr)
21448# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21449 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
21450# 691 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21451 end select
21452# 692 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21453 end if
21454
21455 ! Updating the patch identities bookkeeping variable
21456 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
21457 end if
21458 end do
21459 end do
21460 if (allocated(stored_values)) then
21461# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21462#ifdef MFC_DEBUG
21463# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21464 block
21465# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21466 use iso_fortran_env, only: output_unit
21467# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21468
21469# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21470 print *, 'm_icpp_patches.fpp:699: ', '@:DEALLOCATE(stored_values)'
21471# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21472
21473# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21474 call flush (output_unit)
21475# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21476 end block
21477# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21478#endif
21479# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21480
21481# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21482#if defined(MFC_OpenACC)
21483# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21484!$acc exit data delete(stored_values)
21485# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21486#elif defined(MFC_OpenMP)
21487# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21488!$omp target exit data map(release:stored_values)
21489# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21490#endif
21491# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21492 deallocate (stored_values)
21493# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21494#ifdef MFC_DEBUG
21495# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21496 block
21497# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21498 use iso_fortran_env, only: output_unit
21499# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21500
21501# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21502 print *, 'm_icpp_patches.fpp:699: ', '@:DEALLOCATE(x_coords)'
21503# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21504
21505# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21506 call flush (output_unit)
21507# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21508 end block
21509# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21510#endif
21511# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21512
21513# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21514#if defined(MFC_OpenACC)
21515# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21516!$acc exit data delete(x_coords)
21517# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21518#elif defined(MFC_OpenMP)
21519# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21520!$omp target exit data map(release:x_coords)
21521# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21522#endif
21523# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21524 deallocate (x_coords)
21525# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21526 end if
21527# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21528
21529# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21530 if (allocated(y_coords)) then
21531# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21532#ifdef MFC_DEBUG
21533# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21534 block
21535# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21536 use iso_fortran_env, only: output_unit
21537# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21538
21539# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21540 print *, 'm_icpp_patches.fpp:699: ', '@:DEALLOCATE(y_coords)'
21541# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21542
21543# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21544 call flush (output_unit)
21545# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21546 end block
21547# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21548#endif
21549# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21550
21551# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21552#if defined(MFC_OpenACC)
21553# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21554!$acc exit data delete(y_coords)
21555# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21556#elif defined(MFC_OpenMP)
21557# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21558!$omp target exit data map(release:y_coords)
21559# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21560#endif
21561# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21562 deallocate (y_coords)
21563# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21564 end if
21565# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21566
21567# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21568 files_loaded = .false.
21569# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21570
21571# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21572 if (allocated(stored_values274)) then
21573# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21574#ifdef MFC_DEBUG
21575# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21576 block
21577# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21578 use iso_fortran_env, only: output_unit
21579# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21580
21581# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21582 print *, 'm_icpp_patches.fpp:699: ', '@:DEALLOCATE(stored_values274)'
21583# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21584
21585# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21586 call flush (output_unit)
21587# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21588 end block
21589# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21590#endif
21591# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21592
21593# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21594#if defined(MFC_OpenACC)
21595# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21596!$acc exit data delete(stored_values274)
21597# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21598#elif defined(MFC_OpenMP)
21599# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21600!$omp target exit data map(release:stored_values274)
21601# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21602#endif
21603# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21604 deallocate (stored_values274)
21605# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21606 end if
21607# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21608
21609# 699 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21610 files_loaded274 = .false.
21611# 700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21612
21613 end subroutine s_icpp_sweep_line
21614
21615 !> The Taylor Green vortex is 2D decaying vortex that may be used, for example, to verify the effects of viscous attenuation.
21616 !! Geometry of the patch is well-defined when its centroid are provided.
21617 subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
21618
21619 integer, intent(in) :: patch_id
21620
21621#ifdef MFC_MIXED_PRECISION
21622 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
21623#else
21624 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
21625#endif
21626 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
21627 integer :: i, j, k !< generic loop iterators
21628 real(wp) :: L0, U0 !< Taylor Green Vortex parameters
21629
21630 integer :: xRows, yRows, nRows, iix, iiy, max_files
21631# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21632 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
21633# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21634 real(wp) :: x_step, y_step
21635# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21636 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
21637# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21638 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
21639# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21640 real(wp) :: delta_x, delta_y
21641# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21642 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
21643# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21644 real(wp), allocatable :: stored_values(:,:,:)
21645# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21646 real(wp), allocatable :: x_coords(:), y_coords(:)
21647# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21648 logical :: files_loaded = .false.
21649# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21650 real(wp) :: domain_xstart
21651# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21652 character(len=20) :: file_num_str !< For storing the file number as a string
21653# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21654 integer :: ios
21655# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21656 integer :: ios2
21657# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21658
21659# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21660 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
21661# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21662 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
21663# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21664 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
21665# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21666 ! y_coords/files_loaded above.
21667# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21668 real(wp), allocatable, dimension(:,:,:) :: stored_values274
21669# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21670 logical :: files_loaded274 = .false.
21671# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21672 integer :: f274, ix274, iy274, unit274, ios274
21673# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21674 integer :: local_ix_beg274, local_iy_beg274
21675# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21676 character(len=300) :: fname274
21677# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21678 character(len=20) :: file_num_str274
21679# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21680 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
21681# 718 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21682 real(wp) :: file_dx274, file_dy274, r_align274
21683# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21684 ! Place any declaration of intermediate variables here
21685# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21686 real(wp) :: eps, eps_mhd, C_mhd
21687# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21688 real(wp) :: r, rmax, gam, umax, p0
21689# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21690 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
21691# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21692 real(wp) :: factor, x1c, y1c, x2c, y2c, r1c, r2c, cvortex, u1c, u2c, v1c, v2c, rvortex
21693# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21694 real(wp) :: r0, alpha, r2
21695# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21696 real(wp) :: sinA, cosA
21697# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21698 real(wp) :: r_sq
21699# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21700
21701# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21702 ! # 283 - Gauss-averaged isentropic vortex (conserved-variable cell averages)
21703# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21704 real(wp) :: gauss_xi(3), gauss_w(3), xq, yq, r2q, T_facq, wq
21705# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21706 real(wp) :: rho_avg, rhou_avg, rhov_avg, E_avg
21707# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21708 real(wp) :: rhoq, pq, uq, vq, Eq, vortex_eps
21709# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21710 integer :: igq, jgq
21711# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21712
21713# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21714 ! # 291 - Shear/Thermal Layer Case
21715# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21716 real(wp) :: delta_shear, u_max, u_mean
21717# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21718 real(wp) :: T_wall, T_inf, P_atm, T_loc
21719# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21720 real(wp) :: delta_th, R_mix
21721# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21722 real(wp) :: Y_N2, Y_O2, MW_N2, MW_O2
21723# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21724 real(wp) :: bottom_blend_u, bottom_blend_T
21725# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21726
21727# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21728 ! # 207
21729# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21730 real(wp) :: sigma, gauss1, gauss2
21731# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21732
21733# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21734 ! # 208
21735# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21736 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
21737# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21738 real(wp) :: y_center, y_dist, wave_phase, front_shift, x_mapped, interp_wt
21739# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21740 integer :: v, idx_lo, idx_hi, idx_mid
21741# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21742 real(wp), parameter :: Ly_param = 0.00775735_wp
21743# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21744 real(wp), parameter :: A_param = 0.1_wp*96.9880867_wp*10.0_wp**(-6.0_wp)
21745# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21746 integer, parameter :: Nwaves = 6
21747# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21748 real(wp), parameter :: y0_ref = 0.0_wp
21749# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21750
21751# 719 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21752 eps = 1.e-9_wp
21753# 720 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21754
21755 ! Transferring the patch's centroid and length information
21756 x_centroid = patch_icpp(patch_id)%x_centroid
21757 y_centroid = patch_icpp(patch_id)%y_centroid
21758 length_x = patch_icpp(patch_id)%length_x
21759 length_y = patch_icpp(patch_id)%length_y
21760
21761 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
21762 x_boundary%beg = x_centroid - 0.5_wp*length_x
21763 x_boundary%end = x_centroid + 0.5_wp*length_x
21764 y_boundary%beg = y_centroid - 0.5_wp*length_y
21765 y_boundary%end = y_centroid + 0.5_wp*length_y
21766
21767 ! Set eta=1 (no smoothing for this patch type)
21768 eta = 1._wp
21769 ! U0 is the characteristic velocity of the vortex
21770 u0 = patch_icpp(patch_id)%vel(1)
21771 ! L0 is the characteristic length of the vortex
21772 l0 = patch_icpp(patch_id)%vel(2)
21773 ! Assign patch vars if cell is covered and patch has write permission
21774 do j = 0, n
21775 do i = 0, m
21776 if (f_is_inside_cuboid(x_cc(i) - x_centroid, y_cc(j) - y_centroid, 0._wp, [length_x, length_y, &
21777 & 0._wp]) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
21778 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
21779
21780
21781# 747 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21782 if (patch_icpp(patch_id)%hcid /= dflt_int) then
21783 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
21784# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21785 case (200) ! Two-fluid cubic interface
21786# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21787 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
21788# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21789 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = eps
21790# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21791 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - eps
21792# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21793 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = eps*1000._wp
21794# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21795 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - eps)*1._wp
21796# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21797 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1000._wp
21798# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21799 end if
21800# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21801 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
21802# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21803 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
21804# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21805 rmax = 0.2_wp
21806# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21807
21808# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21809 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
21810# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21811 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
21812# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21813 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
21814# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21815
21816# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21817 if (r < rmax) then
21818# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21819 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
21820# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21821 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
21822# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21823 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
21824# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21825 else if (r < 2*rmax) then
21826# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21827 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
21828# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21829 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
21830# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21831 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)))
21832# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21833 else
21834# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21835 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
21836# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21837 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
21838# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21839 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
21840# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21841 end if
21842# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21843 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
21844# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21845 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
21846# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21847 rmax = 0.2_wp
21848# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21849
21850# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21851 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
21852# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21853 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
21854# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21855 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
21856# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21857
21858# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21859 if (r < rmax) then
21860# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21861 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
21862# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21863 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
21864# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21865 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
21866# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21867 else if (r < 2*rmax) then
21868# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21869 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
21870# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21871 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
21872# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21873 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)))
21874# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21875 else
21876# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21877 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0._wp
21878# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21879 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0._wp
21880# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21881 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
21882# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21883 end if
21884# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21885
21886# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21887 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%E)%sf(i, j, 0)**(1._wp/gam)
21888# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21889 case (204) ! Rayleigh-Taylor instability
21890# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21891 rhoh = 3._wp
21892# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21893 rhol = 1._wp
21894# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21895 pref = 1.e5_wp
21896# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21897 pint = pref
21898# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21899 h = 0.7_wp
21900# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21901 lam = 0.2_wp
21902# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21903 wl = 2._wp*pi/lam
21904# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21905 amp = 0.05_wp/wl
21906# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21907
21908# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21909 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
21910# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21911
21912# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21913 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
21914# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21915
21916# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21917 if (alph < eps) alph = eps
21918# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21919 if (alph > 1._wp - eps) alph = 1._wp - eps
21920# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21921
21922# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21923 if (y_cc(j) > inth) then
21924# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21925 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
21926# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21927 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
21928# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21929 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
21930# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21931 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
21932# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21933 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
21934# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21935 else
21936# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21937 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alph
21938# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21939 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = 1._wp - alph
21940# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21941 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alph*rhoh
21942# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21943 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = (1._wp - alph)*rhol
21944# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21945 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
21946# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21947 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
21948# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21949 end if
21950# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21951 case (205) ! 2D lung wave interaction problem
21952# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21953 h = 0.0_wp ! non dim origin y
21954# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21955 lam = 1.0_wp ! non dim lambda
21956# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21957 amp = patch_icpp(patch_id)%a(2) ! to be changed later! !non dim amplitude
21958# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21959
21960# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21961 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
21962# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21963
21964# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21965 if (y_cc(j) > inth) then
21966# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21967 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
21968# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21969 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
21970# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21971 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
21972# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21973 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
21974# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21975 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
21976# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21977 end if
21978# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21979 case (206) ! 2D lung wave interaction problem - horizontal domain
21980# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21981 h = 0.0_wp ! non dim origin y
21982# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21983 lam = 1.0_wp ! non dim lambda
21984# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21985 amp = patch_icpp(patch_id)%a(2)
21986# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21987
21988# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21989 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
21990# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21991
21992# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21993 if (x_cc(i) > intl) then ! this is the liquid
21994# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21995 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
21996# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21997 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
21998# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
21999 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
22000# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22001 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
22002# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22003 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
22004# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22005 end if
22006# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22007 case (207) ! Kelvin Helmholtz Instability
22008# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22009 sigma = 0.05_wp/sqrt(2.0_wp)
22010# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22011 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
22012# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22013 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
22014# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22015 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)
22016# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22017 case (208) ! Richtmeyer Meshkov Instability
22018# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22019 lam = 1.0_wp
22020# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22021 eps = 1.0e-6_wp
22022# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22023 ei = 5.0_wp
22024# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22025 ! Smoothening function to smooth out sharp discontinuity in the interface
22026# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22027 if (x_cc(i) <= 0.7_wp*lam) then
22028# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22029 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
22030# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22031 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx_min*dy_min))))
22032# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22033 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
22034# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22035 alpha_sf6 = 1.0_wp - alpha_air
22036# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22037 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = alpha_sf6*5.04_wp
22038# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22039 q_prim_vf(eqn_idx%cont%end)%sf(i, j, 0) = alpha_air*1.0_wp
22040# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22041 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, 0) = alpha_sf6
22042# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22043 q_prim_vf(eqn_idx%adv%end)%sf(i, j, 0) = alpha_air
22044# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22045 end if
22046# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22047 case (250) ! MHD Orszag-Tang vortex
22048# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22049 ! 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),
22050# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22051 ! sin(4*pi*x)/sqrt(4*pi), 0)
22052# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22053
22054# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22055 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
22056# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22057 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
22058# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22059
22060# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22061 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
22062# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22063 q_prim_vf(eqn_idx%B%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
22064# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22065 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
22066# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22067 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
22068# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22069 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01
22070# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22071 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0
22072# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22073 else if (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
22074# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22075 ! Linear interpolation between r=0.08 and r=1.0
22076# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22077 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
22078# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22079 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
22080# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22081 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
22082# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22083 else
22084# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22085 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1.e-4_wp
22086# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22087 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 3.e-5_wp
22088# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22089 end if
22090# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22091
22092# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22093 ! case 252 is for the 2D MHD Rotor problem
22094# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22095 case (252) ! 2D MHD Rotor Problem
22096# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22097 ! Ambient conditions are set in the JSON file. This case imposes the dense, rotating cylinder.
22098# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22099 !
22100# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22101 ! 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
22102# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22103 ! velocity w=20, giving v_tan=2 at r=0.1
22104# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22105
22106# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22107 ! Calculate distance squared from the center
22108# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22109 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
22110# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22111
22112# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22113 ! inner radius of 0.1
22114# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22115 if (r_sq <= 0.1**2) then
22116# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22117 ! -- Inside the rotor -- Set density uniformly to 10
22118# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22119 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 10._wp
22120# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22121
22122# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22123 ! Set vup constant rotation of rate v=2 v_x = -omega * (y - y_c) v_y = omega * (x - x_c)
22124# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22125 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
22126# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22127 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
22128# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22129
22130# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22131 ! taper width of 0.015
22132# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22133 else if (r_sq <= 0.115**2) then
22134# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22135 ! linearly smooth the function between r = 0.1 and 0.115
22136# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22137 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
22138# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22139
22140# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22141 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)
22142# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22143 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)
22144# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22145 end if
22146# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22147 case (253) ! MHD Smooth Magnetic Vortex
22148# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22149 ! Section 5.2 of Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics C. Ciuca, P.
22150# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22151 ! Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
22152# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22153
22154# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22155 ! velocity
22156# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22157 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))
22158# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22159 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))
22160# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22161
22162# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22163 ! magnetic field
22164# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22165 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)
22166# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22167 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)
22168# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22169
22170# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22171 ! pressure
22172# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22173 q_prim_vf(eqn_idx%E)%sf(i, j, &
22174# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22175 & 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)
22176# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22177 case (260) ! Gaussian Divergence Pulse
22178# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22179 ! Bx(x) = 1 + C * erf((x-0.5)/\sigma) => \partialBx/\partialx = C * (2/\sqrt\pi) * exp[-((x-0.5)/\sigma)**2] * (1/\sigma)
22180# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22181 ! Choose C = \epsilon * \sigma * \sqrt\pi / 2 => \partialBx/\partialx = \epsilon * exp[-((x-0.5)/\sigma)**2] \psi is
22182# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22183 ! initialized to zero everywhere.
22184# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22185
22186# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22187 eps_mhd = patch_icpp(patch_id)%a(2)
22188# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22189 sigma = patch_icpp(patch_id)%a(3)
22190# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22191 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
22192# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22193
22194# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22195 ! B-field
22196# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22197 q_prim_vf(eqn_idx%B%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
22198# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22199 case (261) ! Blob
22200# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22201 r0 = 1._wp/sqrt(8._wp)
22202# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22203 r2 = x_cc(i)**2 + y_cc(j)**2
22204# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22205 r = sqrt(r2)
22206# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22207 alpha = r/r0
22208# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22209 if (alpha < 1) then
22210# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22211 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)
22212# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22213 end if
22214# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22215 case (262) ! Tilted 2D MHD shock-tube at \alpha = arctan2 (\approx63.4 deg)
22216# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22217 ! rotate by \alpha = atan(2)
22218# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22219 alpha = atan(2._wp)
22220# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22221 cosa = cos(alpha)
22222# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22223 sina = sin(alpha)
22224# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22225 ! projection along shock normal
22226# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22227 r = x_cc(i)*cosa + y_cc(j)*sina
22228# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22229
22230# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22231 if (r <= 0.5_wp) then
22232# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22233 ! LEFT state: \rho=1, v\parallel=+10, v\perp=0, p=20, B\parallel=B\perp=5/\sqrt(4\pi)
22234# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22235 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
22236# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22237 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 10._wp*cosa
22238# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22239 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = 10._wp*sina
22240# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22241 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 20._wp
22242# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22243 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
22244# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22245 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
22246# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22247 else
22248# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22249 ! RIGHT state: \rho=1, v\parallel=-10, v\perp=0, p=1, B\parallel=B\perp=5/\sqrt(4\pi)
22250# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22251 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = 1._wp
22252# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22253 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = -10._wp*cosa
22254# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22255 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = -10._wp*sina
22256# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22257 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = 1._wp
22258# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22259 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
22260# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22261 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
22262# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22263 end if
22264# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22265 ! v^z and B^z remain zero by default
22266# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22267 case (270) ! 2D extrusion of 1D profile from external data
22268# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22269 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
22270# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22271 if (.not. files_loaded) then
22272# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22273 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
22274# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22275 do f = 1, max_files
22276# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22277 write (file_num_str, '(I0)') f
22278# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22279 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
22280# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22281 end do
22282# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22283
22284# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22285 ! Common file reading setup
22286# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22287 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
22288# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22289 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
22290# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22291
22292# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22293 select case (num_dims)
22294# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22295 case (1, 2) ! 1D and 2D cases are similar
22296# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22297 ! Count lines
22298# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22299 line_count = 0
22300# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22301 do
22302# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22303 read (unit2, *, iostat=ios2) dummy_x, dummy_y
22304# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22305 if (ios2 /= 0) exit
22306# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22307 line_count = line_count + 1
22308# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22309 end do
22310# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22311 close (unit2)
22312# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22313
22314# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22315 xrows = line_count
22316# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22317 yrows = 1
22318# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22319 index_x = 0
22320# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22321 if (num_dims == 2) index_x = i
22322# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22323#ifdef MFC_DEBUG
22324# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22325 block
22326# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22327 use iso_fortran_env, only: output_unit
22328# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22329
22330# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22331 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
22332# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22333
22334# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22335 call flush (output_unit)
22336# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22337 end block
22338# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22339#endif
22340# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22341 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
22342# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22343
22344# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22345
22346# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22347
22348# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22349#if defined(MFC_OpenACC)
22350# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22351!$acc enter data create(x_coords, stored_values)
22352# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22353#elif defined(MFC_OpenMP)
22354# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22355!$omp target enter data map(always,alloc:x_coords, stored_values)
22356# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22357#endif
22358# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22359
22360# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22361 ! Read data from all files
22362# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22363 do f = 1, max_files
22364# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22365 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
22366# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22367 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
22368# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22369
22370# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22371 do iter = 1, xrows
22372# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22373 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
22374# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22375 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
22376# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22377 end do
22378# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22379 close (unit)
22380# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22381 end do
22382# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22383
22384# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22385 ! Calculate offsets
22386# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22387 domain_xstart = x_coords(1)
22388# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22389 x_step = x_cc(1) - x_cc(0)
22390# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22391 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
22392# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22393 global_offset_x = nint(abs(delta_x)/x_step)
22394# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22395 case (3) ! 3D case - determine grid structure
22396# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22397 ! Find yRows by counting rows with same x
22398# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22399 read (unit2, *, iostat=ios2) x0, y0, dummy_z
22400# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22401 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
22402# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22403
22404# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22405 yrows = 1
22406# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22407 do
22408# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22409 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
22410# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22411 if (ios2 /= 0) exit
22412# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22413 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
22414# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22415 yrows = yrows + 1
22416# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22417 else
22418# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22419 exit
22420# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22421 end if
22422# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22423 end do
22424# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22425 close (unit2)
22426# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22427
22428# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22429 ! Count total rows
22430# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22431 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
22432# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22433 nrows = 0
22434# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22435 do
22436# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22437 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
22438# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22439 if (ios2 /= 0) exit
22440# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22441 nrows = nrows + 1
22442# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22443 end do
22444# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22445 close (unit2)
22446# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22447
22448# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22449 xrows = nrows/yrows
22450# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22451#ifdef MFC_DEBUG
22452# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22453 block
22454# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22455 use iso_fortran_env, only: output_unit
22456# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22457
22458# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22459 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
22460# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22461
22462# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22463 call flush (output_unit)
22464# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22465 end block
22466# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22467#endif
22468# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22469 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
22470# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22471
22472# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22473
22474# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22475
22476# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22477
22478# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22479#if defined(MFC_OpenACC)
22480# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22481!$acc enter data create(x_coords, y_coords, stored_values)
22482# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22483#elif defined(MFC_OpenMP)
22484# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22485!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
22486# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22487#endif
22488# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22489 index_x = i
22490# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22491 index_y = j
22492# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22493
22494# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22495 ! Read all files
22496# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22497 do f = 1, max_files
22498# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22499 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
22500# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22501 if (ios /= 0) then
22502# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22503 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
22504# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22505 cycle
22506# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22507 end if
22508# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22509
22510# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22511 iter = 0
22512# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22513 do iix = 1, xrows
22514# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22515 do iiy = 1, yrows
22516# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22517 iter = iter + 1
22518# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22519 if (f == 1) then
22520# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22521 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
22522# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22523 else
22524# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22525 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
22526# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22527 end if
22528# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22529 if (ios /= 0) call s_mpi_abort("Error reading data")
22530# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22531 end do
22532# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22533 end do
22534# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22535 close (unit)
22536# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22537 end do
22538# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22539
22540# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22541 ! Calculate offsets
22542# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22543 x_step = x_cc(1) - x_cc(0)
22544# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22545 y_step = y_cc(1) - y_cc(0)
22546# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22547 delta_x = x_cc(index_x) - x_coords(1)
22548# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22549 delta_y = y_cc(index_y) - y_coords(1)
22550# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22551 global_offset_x = nint(abs(delta_x)/x_step)
22552# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22553 global_offset_y = nint(abs(delta_y)/y_step)
22554# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22555
22556# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22557 ! The index check below only catches overruns, so a file that is merely too
22558# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22559 ! FINE stays in range and silently supplies a corner of itself. Check spacing
22560# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22561 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
22562# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22563 ! consecutive x values sit yRows apart.
22564# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22565 if (nrows > yrows) then
22566# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22567 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
22568# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22569 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
22570# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22571 end if
22572# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22573 if (yrows > 1) then
22574# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22575 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
22576# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22577 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
22578# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22579 end if
22580# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22581 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
22582# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22583 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
22584# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22585 & wp)) > 1.e-6_wp) &
22586# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22587 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
22588# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22589 end select
22590# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22591
22592# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22593 files_loaded = .true.
22594# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22595 end if
22596# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22597
22598# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22599 ! Data assignment
22600# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22601 select case (num_dims)
22602# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22603 case (1)
22604# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22605 idx = i + 1 + global_offset_x
22606# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22607 ! idx must land inside the file's row range: this rank's subdomain offset
22608# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22609 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
22610# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22611 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
22612# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22613 if (idx < 1 .or. idx > xrows) &
22614# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22615 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
22616# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22617 do f = 1, sys_size
22618# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22619 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
22620# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22621 end do
22622# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22623 case (2)
22624# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22625 idx = i + 1 + global_offset_x - index_x
22626# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22627 if (idx < 1 .or. idx > xrows) &
22628# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22629 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
22630# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22631 do f = 1, sys_size - 1
22632# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22633 jump = merge(1, 0, f >= eqn_idx%mom%end)
22634# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22635 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
22636# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22637 end do
22638# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22639 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
22640# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22641 case (3)
22642# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22643 idx = i + 1 + global_offset_x - index_x
22644# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22645 idy = j + 1 + global_offset_y - index_y
22646# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22647 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
22648# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22649 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
22650# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22651 do f = 1, sys_size - 1
22652# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22653 jump = merge(1, 0, f >= eqn_idx%mom%end)
22654# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22655 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
22656# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22657 end do
22658# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22659 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
22660# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22661 end select
22662# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22663 case (273) ! Temporal reacting mixing layer: 2D extrusion + streamwise velocity
22664# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22665 ! @:HardcodedReadValues() always zeros mom%end (the extruded-axis velocity).
22666# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22667 ! The mom%beg file slot is repurposed to carry the streamwise-velocity-vs-
22668# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22669 ! cross-stream-position profile (real cross-stream velocity is legitimately
22670# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22671 ! zero everywhere in the unperturbed base state), so swap it into mom%end and
22672# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22673 ! zero out mom%beg's true physical value.
22674# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22675 if (.not. files_loaded) then
22676# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22677 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
22678# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22679 do f = 1, max_files
22680# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22681 write (file_num_str, '(I0)') f
22682# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22683 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
22684# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22685 end do
22686# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22687
22688# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22689 ! Common file reading setup
22690# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22691 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
22692# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22693 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
22694# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22695
22696# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22697 select case (num_dims)
22698# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22699 case (1, 2) ! 1D and 2D cases are similar
22700# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22701 ! Count lines
22702# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22703 line_count = 0
22704# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22705 do
22706# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22707 read (unit2, *, iostat=ios2) dummy_x, dummy_y
22708# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22709 if (ios2 /= 0) exit
22710# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22711 line_count = line_count + 1
22712# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22713 end do
22714# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22715 close (unit2)
22716# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22717
22718# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22719 xrows = line_count
22720# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22721 yrows = 1
22722# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22723 index_x = 0
22724# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22725 if (num_dims == 2) index_x = i
22726# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22727#ifdef MFC_DEBUG
22728# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22729 block
22730# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22731 use iso_fortran_env, only: output_unit
22732# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22733
22734# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22735 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
22736# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22737
22738# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22739 call flush (output_unit)
22740# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22741 end block
22742# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22743#endif
22744# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22745 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
22746# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22747
22748# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22749
22750# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22751
22752# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22753#if defined(MFC_OpenACC)
22754# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22755!$acc enter data create(x_coords, stored_values)
22756# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22757#elif defined(MFC_OpenMP)
22758# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22759!$omp target enter data map(always,alloc:x_coords, stored_values)
22760# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22761#endif
22762# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22763
22764# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22765 ! Read data from all files
22766# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22767 do f = 1, max_files
22768# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22769 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
22770# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22771 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
22772# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22773
22774# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22775 do iter = 1, xrows
22776# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22777 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
22778# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22779 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
22780# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22781 end do
22782# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22783 close (unit)
22784# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22785 end do
22786# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22787
22788# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22789 ! Calculate offsets
22790# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22791 domain_xstart = x_coords(1)
22792# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22793 x_step = x_cc(1) - x_cc(0)
22794# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22795 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
22796# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22797 global_offset_x = nint(abs(delta_x)/x_step)
22798# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22799 case (3) ! 3D case - determine grid structure
22800# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22801 ! Find yRows by counting rows with same x
22802# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22803 read (unit2, *, iostat=ios2) x0, y0, dummy_z
22804# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22805 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
22806# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22807
22808# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22809 yrows = 1
22810# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22811 do
22812# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22813 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
22814# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22815 if (ios2 /= 0) exit
22816# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22817 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
22818# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22819 yrows = yrows + 1
22820# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22821 else
22822# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22823 exit
22824# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22825 end if
22826# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22827 end do
22828# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22829 close (unit2)
22830# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22831
22832# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22833 ! Count total rows
22834# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22835 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
22836# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22837 nrows = 0
22838# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22839 do
22840# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22841 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
22842# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22843 if (ios2 /= 0) exit
22844# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22845 nrows = nrows + 1
22846# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22847 end do
22848# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22849 close (unit2)
22850# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22851
22852# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22853 xrows = nrows/yrows
22854# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22855#ifdef MFC_DEBUG
22856# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22857 block
22858# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22859 use iso_fortran_env, only: output_unit
22860# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22861
22862# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22863 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
22864# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22865
22866# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22867 call flush (output_unit)
22868# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22869 end block
22870# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22871#endif
22872# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22873 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
22874# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22875
22876# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22877
22878# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22879
22880# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22881
22882# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22883#if defined(MFC_OpenACC)
22884# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22885!$acc enter data create(x_coords, y_coords, stored_values)
22886# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22887#elif defined(MFC_OpenMP)
22888# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22889!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
22890# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22891#endif
22892# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22893 index_x = i
22894# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22895 index_y = j
22896# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22897
22898# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22899 ! Read all files
22900# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22901 do f = 1, max_files
22902# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22903 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
22904# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22905 if (ios /= 0) then
22906# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22907 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
22908# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22909 cycle
22910# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22911 end if
22912# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22913
22914# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22915 iter = 0
22916# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22917 do iix = 1, xrows
22918# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22919 do iiy = 1, yrows
22920# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22921 iter = iter + 1
22922# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22923 if (f == 1) then
22924# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22925 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
22926# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22927 else
22928# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22929 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
22930# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22931 end if
22932# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22933 if (ios /= 0) call s_mpi_abort("Error reading data")
22934# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22935 end do
22936# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22937 end do
22938# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22939 close (unit)
22940# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22941 end do
22942# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22943
22944# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22945 ! Calculate offsets
22946# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22947 x_step = x_cc(1) - x_cc(0)
22948# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22949 y_step = y_cc(1) - y_cc(0)
22950# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22951 delta_x = x_cc(index_x) - x_coords(1)
22952# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22953 delta_y = y_cc(index_y) - y_coords(1)
22954# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22955 global_offset_x = nint(abs(delta_x)/x_step)
22956# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22957 global_offset_y = nint(abs(delta_y)/y_step)
22958# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22959
22960# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22961 ! The index check below only catches overruns, so a file that is merely too
22962# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22963 ! FINE stays in range and silently supplies a corner of itself. Check spacing
22964# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22965 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
22966# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22967 ! consecutive x values sit yRows apart.
22968# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22969 if (nrows > yrows) then
22970# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22971 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
22972# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22973 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
22974# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22975 end if
22976# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22977 if (yrows > 1) then
22978# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22979 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
22980# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22981 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
22982# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22983 end if
22984# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22985 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
22986# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22987 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
22988# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22989 & wp)) > 1.e-6_wp) &
22990# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22991 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
22992# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22993 end select
22994# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22995
22996# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22997 files_loaded = .true.
22998# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
22999 end if
23000# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23001
23002# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23003 ! Data assignment
23004# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23005 select case (num_dims)
23006# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23007 case (1)
23008# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23009 idx = i + 1 + global_offset_x
23010# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23011 ! idx must land inside the file's row range: this rank's subdomain offset
23012# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23013 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
23014# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23015 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
23016# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23017 if (idx < 1 .or. idx > xrows) &
23018# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23019 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
23020# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23021 do f = 1, sys_size
23022# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23023 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
23024# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23025 end do
23026# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23027 case (2)
23028# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23029 idx = i + 1 + global_offset_x - index_x
23030# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23031 if (idx < 1 .or. idx > xrows) &
23032# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23033 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
23034# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23035 do f = 1, sys_size - 1
23036# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23037 jump = merge(1, 0, f >= eqn_idx%mom%end)
23038# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23039 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
23040# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23041 end do
23042# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23043 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
23044# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23045 case (3)
23046# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23047 idx = i + 1 + global_offset_x - index_x
23048# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23049 idy = j + 1 + global_offset_y - index_y
23050# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23051 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
23052# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23053 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
23054# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23055 do f = 1, sys_size - 1
23056# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23057 jump = merge(1, 0, f >= eqn_idx%mom%end)
23058# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23059 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
23060# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23061 end do
23062# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23063 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
23064# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23065 end select
23066# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23067 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0)
23068# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23069 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = 0.0_wp
23070# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23071 case (274) ! Full 2D field from external data (no extrusion)
23072# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23073 ! Unlike case(270-273), this reads a genuinely 2D (x,y) field per variable, with no
23074# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23075 ! extrusion direction and no zeroed component -- all sys_size variables are read and
23076# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23077 ! assigned directly. Data files must have exactly (m_glb+1)*(n_glb+1) lines per
23078# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23079 ! variable, in x-major order (outer loop x, inner loop y), matching this rank's
23080# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23081 ! global grid exactly -- by construction, since the IC generator derives both the
23082# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23083 ! grid and the file contents from the same computation.
23084# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23085 !
23086# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23087 ! A local cell's global (x, y) index is derived from x_cc(i)/y_cc(j) against the
23088# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23089 ! file's own first coordinate and this rank's uniform grid spacing -- following the
23090# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23091 ! same pattern as case(270)'s global_offset_x/y above -- rather than from start_idx:
23092# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23093 ! start_idx is only allocated when parallel_io=T (s_initialize_parallel_io_common
23094# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23095 ! returns before allocating it otherwise), so a serial-IO run (the default for
23096# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23097 ! golden-file tests) would index into an unallocated array.
23098# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23099 !
23100# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23101 ! Every rank still scans the whole file (matching case(270)'s existing per-rank-reads-
23102# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23103 ! everything pattern), but stored_values274 only holds this rank's LOCAL (0:m, 0:n)
23104# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23105 ! slice rather than the full global grid -- a full-grid copy on every rank would scale
23106# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23107 ! as O(m_glb*n_glb*sys_size) per rank, which is the wrong axis to duplicate work on for
23108# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23109 ! a genuinely 2D (not 1D-profile) field. local_ix_beg274/local_iy_beg274 (this rank's
23110# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23111 ! global cell offset) are pinned from f274==1's very first record, before any other
23112# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23113 ! record is read, so every subsequent record -- across all variables -- can be tested
23114# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23115 ! against this rank's range and dropped if it falls outside it.
23116# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23117 x_step274 = x_cc(1) - x_cc(0)
23118# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23119 y_step274 = y_cc(1) - y_cc(0)
23120# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23121
23122# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23123 if (.not. files_loaded274) then
23124# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23125#ifdef MFC_DEBUG
23126# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23127 block
23128# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23129 use iso_fortran_env, only: output_unit
23130# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23131
23132# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23133 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(stored_values274(0:m, 0:n, sys_size))'
23134# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23135
23136# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23137 call flush (output_unit)
23138# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23139 end block
23140# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23141#endif
23142# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23143 allocate (stored_values274(0:m, 0:n, sys_size))
23144# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23145
23146# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23147
23148# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23149#if defined(MFC_OpenACC)
23150# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23151!$acc enter data create(stored_values274)
23152# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23153#elif defined(MFC_OpenMP)
23154# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23155!$omp target enter data map(always,alloc:stored_values274)
23156# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23157#endif
23158# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23159 do f274 = 1, sys_size
23160# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23161 write (file_num_str274, '(I0)') f274
23162# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23163 fname274 = trim(files_dir) // "/prim." // trim(file_num_str274) // ".00." // trim(file_extension) // ".dat"
23164# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23165 open (newunit=unit274, file=trim(fname274), status='old', action='read', iostat=ios274)
23166# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23167 if (ios274 /= 0) call s_mpi_abort("Error opening file: " // trim(fname274))
23168# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23169 do ix274 = 0, m_glb
23170# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23171 do iy274 = 0, n_glb
23172# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23173 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274, dummy_val274
23174# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23175 if (ios274 /= 0) call s_mpi_abort("Error reading file (fewer lines than grid?): " // trim(fname274))
23176# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23177 ! Capture the file's own origin and spacing from its first records so we can
23178# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23179 ! confirm it was sampled on this run's grid (a silent mismatch would otherwise
23180# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23181 ! read a wrong partial slice -> nonphysical field -> VCFL=Inf downstream).
23182# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23183 if (f274 == 1) then
23184# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23185 if (ix274 == 0 .and. iy274 == 0) then
23186# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23187 x0_274 = dummy_x274
23188# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23189 y0_274 = dummy_y274
23190# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23191 local_ix_beg274 = nint((x_cc(0) - x0_274)/x_step274)
23192# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23193 local_iy_beg274 = nint((y_cc(0) - y0_274)/y_step274)
23194# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23195 end if
23196# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23197 if (ix274 == 1 .and. iy274 == 0) file_dx274 = dummy_x274 - x0_274
23198# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23199 if (ix274 == 0 .and. iy274 == 1) file_dy274 = dummy_y274 - y0_274
23200# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23201 end if
23202# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23203 if (ix274 - local_ix_beg274 >= 0 .and. ix274 - local_ix_beg274 <= m .and. iy274 - local_iy_beg274 >= 0 &
23204# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23205 & .and. iy274 - local_iy_beg274 <= n) then
23206# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23207 stored_values274(ix274 - local_ix_beg274, iy274 - local_iy_beg274, f274) = dummy_val274
23208# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23209 end if
23210# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23211 end do
23212# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23213 end do
23214# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23215 ! The file must contain exactly (m_glb+1)*(n_glb+1) records: a successful extra
23216# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23217 ! read means it was generated for a larger grid and would be silently misread.
23218# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23219 read (unit274, *, iostat=ios274) dummy_x274, dummy_y274
23220# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23221 if (ios274 == 0) call s_mpi_abort("hcid=274 file has more lines than the grid: " // trim(fname274))
23222# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23223 close (unit274)
23224# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23225 end do
23226# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23227
23228# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23229 ! The run grid must be aligned with the file grid (uniform grid assumed, as in case 270).
23230# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23231 ! Check alignment via the integer cell offset of this rank's first cell from the file
23232# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23233 ! origin -- decomposition-safe: on every MPI rank x_cc(0) sits an integer number of cells
23234# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23235 ! into the global file, so a non-integer offset means a shifted/mismatched IC. (Comparing
23236# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23237 ! x0_274 to x_cc(0) directly would false-abort every rank whose subdomain doesn't start at
23238# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23239 ! the global origin.) The spacing checks below must also hold.
23240# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23241 r_align274 = (x_cc(0) - x0_274)/x_step274
23242# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23243 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
23244# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23245 & call s_mpi_abort("hcid=274 file x-grid is misaligned with the run grid; regenerate the IC for this grid.")
23246# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23247 if (m_glb >= 1) then
23248# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23249 if (abs(file_dx274 - x_step274) > 1.e-6_wp*abs(x_step274)) &
23250# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23251 & call s_mpi_abort("hcid=274 file x-spacing does not match the grid; regenerate the IC for this grid.")
23252# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23253 end if
23254# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23255 if (n_glb >= 1) then
23256# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23257 r_align274 = (y_cc(0) - y0_274)/y_step274
23258# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23259 if (abs(r_align274 - nint(r_align274)) > 1.e-6_wp) &
23260# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23261 & call s_mpi_abort("hcid=274 file y-grid is misaligned with the run grid; regenerate the IC for this grid.")
23262# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23263 if (abs(file_dy274 - y_step274) > 1.e-6_wp*abs(y_step274)) &
23264# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23265 & call s_mpi_abort("hcid=274 file y-spacing does not match the grid; regenerate the IC for this grid.")
23266# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23267 end if
23268# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23269
23270# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23271 files_loaded274 = .true.
23272# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23273 end if
23274# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23275 ! Alignment is verified above (or this rank would already have aborted), so the local
23276# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23277 ! cell (i, j) maps to stored_values274(i, j, :) directly -- no re-derivation needed.
23278# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23279 do f274 = 1, sys_size
23280# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23281 q_prim_vf(f274)%sf(i, j, 0) = stored_values274(i, j, f274)
23282# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23283 end do
23284# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23285 case (271) ! Premixed Flame Vortices Interaction
23286# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23287 if (.not. files_loaded) then
23288# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23289 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
23290# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23291 do f = 1, max_files
23292# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23293 write (file_num_str, '(I0)') f
23294# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23295 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
23296# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23297 end do
23298# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23299
23300# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23301 ! Common file reading setup
23302# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23303 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
23304# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23305 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
23306# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23307
23308# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23309 select case (num_dims)
23310# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23311 case (1, 2) ! 1D and 2D cases are similar
23312# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23313 ! Count lines
23314# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23315 line_count = 0
23316# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23317 do
23318# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23319 read (unit2, *, iostat=ios2) dummy_x, dummy_y
23320# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23321 if (ios2 /= 0) exit
23322# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23323 line_count = line_count + 1
23324# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23325 end do
23326# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23327 close (unit2)
23328# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23329
23330# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23331 xrows = line_count
23332# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23333 yrows = 1
23334# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23335 index_x = 0
23336# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23337 if (num_dims == 2) index_x = i
23338# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23339#ifdef MFC_DEBUG
23340# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23341 block
23342# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23343 use iso_fortran_env, only: output_unit
23344# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23345
23346# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23347 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
23348# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23349
23350# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23351 call flush (output_unit)
23352# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23353 end block
23354# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23355#endif
23356# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23357 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
23358# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23359
23360# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23361
23362# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23363
23364# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23365#if defined(MFC_OpenACC)
23366# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23367!$acc enter data create(x_coords, stored_values)
23368# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23369#elif defined(MFC_OpenMP)
23370# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23371!$omp target enter data map(always,alloc:x_coords, stored_values)
23372# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23373#endif
23374# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23375
23376# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23377 ! Read data from all files
23378# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23379 do f = 1, max_files
23380# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23381 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
23382# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23383 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
23384# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23385
23386# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23387 do iter = 1, xrows
23388# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23389 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
23390# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23391 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
23392# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23393 end do
23394# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23395 close (unit)
23396# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23397 end do
23398# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23399
23400# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23401 ! Calculate offsets
23402# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23403 domain_xstart = x_coords(1)
23404# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23405 x_step = x_cc(1) - x_cc(0)
23406# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23407 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
23408# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23409 global_offset_x = nint(abs(delta_x)/x_step)
23410# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23411 case (3) ! 3D case - determine grid structure
23412# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23413 ! Find yRows by counting rows with same x
23414# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23415 read (unit2, *, iostat=ios2) x0, y0, dummy_z
23416# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23417 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
23418# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23419
23420# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23421 yrows = 1
23422# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23423 do
23424# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23425 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
23426# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23427 if (ios2 /= 0) exit
23428# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23429 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
23430# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23431 yrows = yrows + 1
23432# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23433 else
23434# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23435 exit
23436# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23437 end if
23438# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23439 end do
23440# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23441 close (unit2)
23442# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23443
23444# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23445 ! Count total rows
23446# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23447 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
23448# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23449 nrows = 0
23450# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23451 do
23452# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23453 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
23454# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23455 if (ios2 /= 0) exit
23456# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23457 nrows = nrows + 1
23458# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23459 end do
23460# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23461 close (unit2)
23462# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23463
23464# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23465 xrows = nrows/yrows
23466# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23467#ifdef MFC_DEBUG
23468# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23469 block
23470# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23471 use iso_fortran_env, only: output_unit
23472# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23473
23474# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23475 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
23476# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23477
23478# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23479 call flush (output_unit)
23480# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23481 end block
23482# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23483#endif
23484# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23485 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
23486# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23487
23488# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23489
23490# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23491
23492# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23493
23494# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23495#if defined(MFC_OpenACC)
23496# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23497!$acc enter data create(x_coords, y_coords, stored_values)
23498# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23499#elif defined(MFC_OpenMP)
23500# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23501!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
23502# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23503#endif
23504# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23505 index_x = i
23506# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23507 index_y = j
23508# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23509
23510# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23511 ! Read all files
23512# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23513 do f = 1, max_files
23514# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23515 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
23516# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23517 if (ios /= 0) then
23518# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23519 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
23520# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23521 cycle
23522# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23523 end if
23524# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23525
23526# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23527 iter = 0
23528# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23529 do iix = 1, xrows
23530# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23531 do iiy = 1, yrows
23532# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23533 iter = iter + 1
23534# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23535 if (f == 1) then
23536# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23537 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
23538# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23539 else
23540# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23541 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
23542# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23543 end if
23544# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23545 if (ios /= 0) call s_mpi_abort("Error reading data")
23546# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23547 end do
23548# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23549 end do
23550# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23551 close (unit)
23552# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23553 end do
23554# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23555
23556# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23557 ! Calculate offsets
23558# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23559 x_step = x_cc(1) - x_cc(0)
23560# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23561 y_step = y_cc(1) - y_cc(0)
23562# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23563 delta_x = x_cc(index_x) - x_coords(1)
23564# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23565 delta_y = y_cc(index_y) - y_coords(1)
23566# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23567 global_offset_x = nint(abs(delta_x)/x_step)
23568# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23569 global_offset_y = nint(abs(delta_y)/y_step)
23570# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23571
23572# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23573 ! The index check below only catches overruns, so a file that is merely too
23574# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23575 ! FINE stays in range and silently supplies a corner of itself. Check spacing
23576# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23577 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
23578# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23579 ! consecutive x values sit yRows apart.
23580# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23581 if (nrows > yrows) then
23582# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23583 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
23584# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23585 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
23586# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23587 end if
23588# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23589 if (yrows > 1) then
23590# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23591 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
23592# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23593 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
23594# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23595 end if
23596# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23597 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
23598# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23599 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
23600# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23601 & wp)) > 1.e-6_wp) &
23602# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23603 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
23604# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23605 end select
23606# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23607
23608# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23609 files_loaded = .true.
23610# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23611 end if
23612# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23613
23614# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23615 ! Data assignment
23616# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23617 select case (num_dims)
23618# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23619 case (1)
23620# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23621 idx = i + 1 + global_offset_x
23622# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23623 ! idx must land inside the file's row range: this rank's subdomain offset
23624# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23625 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
23626# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23627 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
23628# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23629 if (idx < 1 .or. idx > xrows) &
23630# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23631 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
23632# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23633 do f = 1, sys_size
23634# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23635 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
23636# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23637 end do
23638# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23639 case (2)
23640# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23641 idx = i + 1 + global_offset_x - index_x
23642# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23643 if (idx < 1 .or. idx > xrows) &
23644# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23645 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
23646# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23647 do f = 1, sys_size - 1
23648# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23649 jump = merge(1, 0, f >= eqn_idx%mom%end)
23650# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23651 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
23652# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23653 end do
23654# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23655 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
23656# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23657 case (3)
23658# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23659 idx = i + 1 + global_offset_x - index_x
23660# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23661 idy = j + 1 + global_offset_y - index_y
23662# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23663 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
23664# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23665 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
23666# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23667 do f = 1, sys_size - 1
23668# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23669 jump = merge(1, 0, f >= eqn_idx%mom%end)
23670# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23671 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
23672# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23673 end do
23674# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23675 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
23676# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23677 end select
23678# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23679 x1c = 0.0027_wp
23680# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23681 y1c = 0.005_wp
23682# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23683 x2c = 0.0027_wp
23684# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23685 y2c = 0.003_wp
23686# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23687 r1c = (x_cc(i) - x1c)**(2.0_wp) + (y_cc(j) - y1c)**(2.0_wp)
23688# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23689 r2c = (x_cc(i) - x2c)**(2.0_wp) + (y_cc(j) - y2c)**(2.0_wp)
23690# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23691 rvortex = 0.0005_wp
23692# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23693 cvortex = 6000.0_wp
23694# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23695
23696# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23697 u1c = -cvortex*((y_cc(j) - y1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
23698# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23699 v1c = cvortex*((x_cc(i) - x1c))*exp(-r1c/(2.0_wp*rvortex**2.0_wp))
23700# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23701
23702# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23703 u2c = cvortex*((y_cc(j) - y2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
23704# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23705 v2c = -cvortex*((x_cc(i) - x2c))*exp(-r2c/(2.0_wp*rvortex**2.0_wp))
23706# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23707 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) + u1c + u2c
23708# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23709 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = v1c + v2c
23710# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23711 case (272) ! Premixed Flame Instability
23712# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23713 if (.not. files_loaded) then
23714# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23715 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
23716# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23717 do f = 1, max_files
23718# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23719 write (file_num_str, '(I0)') f
23720# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23721 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
23722# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23723 end do
23724# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23725
23726# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23727 ! Common file reading setup
23728# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23729 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
23730# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23731 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
23732# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23733
23734# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23735 select case (num_dims)
23736# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23737 case (1, 2) ! 1D and 2D cases are similar
23738# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23739 ! Count lines
23740# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23741 line_count = 0
23742# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23743 do
23744# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23745 read (unit2, *, iostat=ios2) dummy_x, dummy_y
23746# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23747 if (ios2 /= 0) exit
23748# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23749 line_count = line_count + 1
23750# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23751 end do
23752# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23753 close (unit2)
23754# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23755
23756# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23757 xrows = line_count
23758# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23759 yrows = 1
23760# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23761 index_x = 0
23762# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23763 if (num_dims == 2) index_x = i
23764# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23765#ifdef MFC_DEBUG
23766# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23767 block
23768# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23769 use iso_fortran_env, only: output_unit
23770# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23771
23772# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23773 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
23774# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23775
23776# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23777 call flush (output_unit)
23778# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23779 end block
23780# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23781#endif
23782# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23783 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
23784# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23785
23786# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23787
23788# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23789
23790# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23791#if defined(MFC_OpenACC)
23792# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23793!$acc enter data create(x_coords, stored_values)
23794# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23795#elif defined(MFC_OpenMP)
23796# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23797!$omp target enter data map(always,alloc:x_coords, stored_values)
23798# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23799#endif
23800# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23801
23802# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23803 ! Read data from all files
23804# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23805 do f = 1, max_files
23806# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23807 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
23808# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23809 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
23810# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23811
23812# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23813 do iter = 1, xrows
23814# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23815 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
23816# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23817 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
23818# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23819 end do
23820# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23821 close (unit)
23822# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23823 end do
23824# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23825
23826# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23827 ! Calculate offsets
23828# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23829 domain_xstart = x_coords(1)
23830# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23831 x_step = x_cc(1) - x_cc(0)
23832# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23833 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
23834# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23835 global_offset_x = nint(abs(delta_x)/x_step)
23836# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23837 case (3) ! 3D case - determine grid structure
23838# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23839 ! Find yRows by counting rows with same x
23840# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23841 read (unit2, *, iostat=ios2) x0, y0, dummy_z
23842# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23843 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
23844# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23845
23846# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23847 yrows = 1
23848# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23849 do
23850# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23851 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
23852# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23853 if (ios2 /= 0) exit
23854# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23855 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
23856# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23857 yrows = yrows + 1
23858# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23859 else
23860# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23861 exit
23862# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23863 end if
23864# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23865 end do
23866# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23867 close (unit2)
23868# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23869
23870# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23871 ! Count total rows
23872# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23873 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
23874# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23875 nrows = 0
23876# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23877 do
23878# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23879 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
23880# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23881 if (ios2 /= 0) exit
23882# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23883 nrows = nrows + 1
23884# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23885 end do
23886# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23887 close (unit2)
23888# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23889
23890# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23891 xrows = nrows/yrows
23892# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23893#ifdef MFC_DEBUG
23894# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23895 block
23896# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23897 use iso_fortran_env, only: output_unit
23898# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23899
23900# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23901 print *, 'm_icpp_patches.fpp:748: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
23902# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23903
23904# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23905 call flush (output_unit)
23906# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23907 end block
23908# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23909#endif
23910# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23911 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
23912# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23913
23914# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23915
23916# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23917
23918# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23919
23920# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23921#if defined(MFC_OpenACC)
23922# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23923!$acc enter data create(x_coords, y_coords, stored_values)
23924# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23925#elif defined(MFC_OpenMP)
23926# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23927!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
23928# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23929#endif
23930# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23931 index_x = i
23932# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23933 index_y = j
23934# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23935
23936# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23937 ! Read all files
23938# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23939 do f = 1, max_files
23940# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23941 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
23942# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23943 if (ios /= 0) then
23944# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23945 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
23946# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23947 cycle
23948# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23949 end if
23950# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23951
23952# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23953 iter = 0
23954# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23955 do iix = 1, xrows
23956# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23957 do iiy = 1, yrows
23958# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23959 iter = iter + 1
23960# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23961 if (f == 1) then
23962# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23963 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
23964# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23965 else
23966# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23967 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
23968# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23969 end if
23970# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23971 if (ios /= 0) call s_mpi_abort("Error reading data")
23972# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23973 end do
23974# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23975 end do
23976# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23977 close (unit)
23978# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23979 end do
23980# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23981
23982# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23983 ! Calculate offsets
23984# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23985 x_step = x_cc(1) - x_cc(0)
23986# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23987 y_step = y_cc(1) - y_cc(0)
23988# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23989 delta_x = x_cc(index_x) - x_coords(1)
23990# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23991 delta_y = y_cc(index_y) - y_coords(1)
23992# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23993 global_offset_x = nint(abs(delta_x)/x_step)
23994# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23995 global_offset_y = nint(abs(delta_y)/y_step)
23996# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23997
23998# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
23999 ! The index check below only catches overruns, so a file that is merely too
24000# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24001 ! FINE stays in range and silently supplies a corner of itself. Check spacing
24002# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24003 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
24004# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24005 ! consecutive x values sit yRows apart.
24006# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24007 if (nrows > yrows) then
24008# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24009 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
24010# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24011 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
24012# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24013 end if
24014# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24015 if (yrows > 1) then
24016# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24017 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
24018# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24019 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
24020# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24021 end if
24022# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24023 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
24024# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24025 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
24026# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24027 & wp)) > 1.e-6_wp) &
24028# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24029 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
24030# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24031 end select
24032# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24033
24034# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24035 files_loaded = .true.
24036# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24037 end if
24038# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24039
24040# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24041 ! Data assignment
24042# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24043 select case (num_dims)
24044# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24045 case (1)
24046# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24047 idx = i + 1 + global_offset_x
24048# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24049 ! idx must land inside the file's row range: this rank's subdomain offset
24050# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24051 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
24052# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24053 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
24054# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24055 if (idx < 1 .or. idx > xrows) &
24056# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24057 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
24058# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24059 do f = 1, sys_size
24060# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24061 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
24062# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24063 end do
24064# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24065 case (2)
24066# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24067 idx = i + 1 + global_offset_x - index_x
24068# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24069 if (idx < 1 .or. idx > xrows) &
24070# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24071 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
24072# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24073 do f = 1, sys_size - 1
24074# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24075 jump = merge(1, 0, f >= eqn_idx%mom%end)
24076# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24077 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
24078# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24079 end do
24080# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24081 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
24082# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24083 case (3)
24084# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24085 idx = i + 1 + global_offset_x - index_x
24086# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24087 idy = j + 1 + global_offset_y - index_y
24088# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24089 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
24090# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24091 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
24092# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24093 do f = 1, sys_size - 1
24094# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24095 jump = merge(1, 0, f >= eqn_idx%mom%end)
24096# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24097 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
24098# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24099 end do
24100# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24101 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
24102# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24103 end select
24104# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24105
24106# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24107 y_center = y0_ref
24108# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24109 y_dist = y_cc(j) - y_center
24110# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24111 wave_phase = 2.0_wp*pi*nwaves*(y_dist/ly_param)
24112# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24113 front_shift = a_param*sin(wave_phase)
24114# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24115
24116# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24117 x_mapped = x_cc(i) - front_shift
24118# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24119
24120# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24121 if (x_mapped <= x_coords(1)) then
24122# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24123 do v = 1, sys_size - 1
24124# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24125 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(1, 1, v)
24126# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24127 end do
24128# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24129 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
24130# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24131 else if (x_mapped >= x_coords(xrows)) then
24132# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24133 do v = 1, sys_size - 1
24134# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24135 q_prim_vf(v + merge(1, 0, v >= eqn_idx%mom%end))%sf(i, j, 0) = stored_values(xrows, 1, v)
24136# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24137 end do
24138# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24139 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
24140# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24141 else
24142# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24143 idx_lo = 1; idx_hi = xrows
24144# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24145 do while (idx_hi - idx_lo > 1)
24146# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24147 idx_mid = (idx_lo + idx_hi)/2
24148# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24149 if (x_coords(idx_mid) <= x_mapped) then
24150# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24151 idx_lo = idx_mid
24152# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24153 else
24154# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24155 idx_hi = idx_mid
24156# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24157 end if
24158# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24159 end do
24160# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24161
24162# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24163 interp_wt = (x_mapped - x_coords(idx_lo))/(x_coords(idx_hi) - x_coords(idx_lo)) ! weight in [0,1)
24164# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24165
24166# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24167 do v = 1, sys_size - 1
24168# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24169 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, &
24170# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24171 & v) + interp_wt*stored_values(idx_hi, 1, v)
24172# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24173 end do
24174# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24175 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
24176# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24177 end if
24178# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24179 case (275) ! reactive shock-flame: sinusoidal (burned | fresh) flame interface
24180# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24181 ! Applied on the burned patch; cells AHEAD of the wavy interface are reset to the fresh
24182# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24183 ! reactant state (patch 1), giving a finite-amplitude flame front for a shock to wrinkle
24184# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24185 ! (Richtmyer-Meshkov). a(2) = mean interface x, a(3) = amplitude, a(4) = transverse wavenumber.
24186# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24187 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 &
24188# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24189 & - y_domain%beg))
24190# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24191 if (x_cc(i) > d) then
24192# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24193 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
24194# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24195 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = patch_icpp(1)%pres
24196# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24197 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = patch_icpp(1)%vel(1)
24198# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24199 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = patch_icpp(1)%vel(2)
24200# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24201 do v = eqn_idx%species%beg, eqn_idx%species%end
24202# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24203 q_prim_vf(v)%sf(i, j, 0) = patch_icpp(1)%Y(v - eqn_idx%species%beg + 1)
24204# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24205 end do
24206# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24207 end if
24208# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24209 case (280) ! Isentropic vortex
24210# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24211 ! This is patch is hard-coded for test suite optimization used in the 2D_isentropicvortex case: This analytic patch uses
24212# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24213 ! geometry 2
24214# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24215 if (patch_id == 1) then
24216# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24217 q_prim_vf(eqn_idx%E)%sf(i, j, &
24218# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24219 & 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) &
24220# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24221 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
24222# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24223 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
24224# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24225 & 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) &
24226# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24227 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
24228# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24229 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
24230# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24231 & 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) &
24232# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24233 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
24234# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24235 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
24236# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24237 & 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) &
24238# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24239 & - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
24240# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24241 end if
24242# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24243 case (281) ! Acoustic pulse
24244# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24245 ! This is patch is hard-coded for test suite optimization used in the 2D_acoustic_pulse case: This analytic patch uses
24246# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24247 ! geometry 2
24248# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24249 if (patch_id == 2) then
24250# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24251 q_prim_vf(eqn_idx%E)%sf(i, j, &
24252# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24253 & 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))
24254# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24255 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
24256# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24257 & 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))
24258# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24259 end if
24260# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24261 case (282) ! Zero-circulation vortex
24262# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24263 ! This is patch is hard-coded for test suite optimization used in the 2D_zero_circ_vortex case: This analytic patch uses
24264# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24265 ! geometry 2
24266# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24267 if (patch_id == 2) then
24268# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24269 q_prim_vf(eqn_idx%E)%sf(i, j, &
24270# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24271 & 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))
24272# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24273 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, j, &
24274# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24275 & 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))
24276# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24277 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, &
24278# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24279 & 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
24280# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24281 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, &
24282# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24283 & 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
24284# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24285 end if
24286# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24287 case (283) ! Isentropic vortex: conserved-variable GL cell averages (3-pt tensor product)
24288# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24289 ! GL averages of conserved variables (rho, rho*u, rho*v, E) eliminate the O(h^2) error that primitive-variable averaging
24290# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24291 ! introduces through the nonlinear prim->cons conversion: cell_avg(rho*u) != cell_avg(rho)*cell_avg(u) by O(h^2). We back
24292# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24293 ! out primitive values that reproduce the conserved averages exactly. Vortex strength eps is read from
24294# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24295 ! patch_icpp(patch_id)%epsilon; defaults to 5.
24296# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24297 if (patch_id == 1) then
24298# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24299 vortex_eps = merge(patch_icpp(patch_id)%epsilon, 5._wp, patch_icpp(patch_id)%epsilon > 0._wp)
24300# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24301 gauss_xi = [-sqrt(3._wp/5._wp), 0._wp, sqrt(3._wp/5._wp)]
24302# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24303 gauss_w = [5._wp/9._wp, 8._wp/9._wp, 5._wp/9._wp]
24304# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24305 rho_avg = 0._wp; rhou_avg = 0._wp; rhov_avg = 0._wp; e_avg = 0._wp
24306# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24307 do igq = 1, 3
24308# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24309 do jgq = 1, 3
24310# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24311 xq = x_cc(i) + gauss_xi(igq)*(x_cb(i) - x_cb(i - 1))*0.5_wp
24312# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24313 yq = y_cc(j) + gauss_xi(jgq)*(y_cb(j) - y_cb(j - 1))*0.5_wp
24314# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24315 r2q = (xq - patch_icpp(patch_id)%x_centroid)**2._wp + (yq - patch_icpp(patch_id)%y_centroid)**2._wp
24316# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24317 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))
24318# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24319 wq = gauss_w(igq)*gauss_w(jgq)
24320# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24321 rhoq = t_facq**1.4_wp
24322# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24323 pq = t_facq**2.4_wp
24324# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24325 uq = patch_icpp(patch_id)%vel(1) + (yq - patch_icpp(patch_id)%y_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
24326# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24327 & - r2q)
24328# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24329 vq = patch_icpp(patch_id)%vel(2) - (xq - patch_icpp(patch_id)%x_centroid)*(vortex_eps/(2._wp*pi))*exp(1._wp &
24330# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24331 & - r2q)
24332# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24333 eq = pq/0.4_wp + 0.5_wp*rhoq*(uq**2 + vq**2)
24334# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24335 rho_avg = rho_avg + wq*rhoq
24336# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24337 rhou_avg = rhou_avg + wq*(rhoq*uq)
24338# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24339 rhov_avg = rhov_avg + wq*(rhoq*vq)
24340# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24341 e_avg = e_avg + wq*eq
24342# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24343 end do
24344# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24345 end do
24346# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24347 rho_avg = rho_avg*0.25_wp
24348# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24349 rhou_avg = rhou_avg*0.25_wp
24350# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24351 rhov_avg = rhov_avg*0.25_wp
24352# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24353 e_avg = e_avg*0.25_wp
24354# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24355 ! Back out primitive vars so prim->cons conversion recovers the conserved averages
24356# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24357 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = rho_avg
24358# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24359 q_prim_vf(eqn_idx%mom%beg + 0)%sf(i, j, 0) = rhou_avg/rho_avg
24360# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24361 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, 0) = rhov_avg/rho_avg
24362# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24363 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
24364# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24365 end if
24366# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24367 case (291) ! Isothermal Flat Plate
24368# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24369 t_inf = 1125.0_wp
24370# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24371 t_wall = 600.0_wp
24372# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24373 p_atm = 101325.0_wp
24374# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24375
24376# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24377 ! Boundary/Shear Layer thicknesses
24378# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24379 delta_th = 0.0003_wp ! Thermal BL thickness
24380# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24381 delta_shear = 8e-3_wp ! Velocity BL thickness
24382# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24383
24384# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24385 u_max = 50.0_wp ! Freestream Velocity (m/s)
24386# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24387
24388# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24389 mw_n2 = 28.0134e-3_wp
24390# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24391 mw_o2 = 31.999e-3_wp
24392# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24393 y_n2 = 0.767_wp
24394# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24395 y_o2 = 0.233_wp
24396# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24397 r_mix = 8.314462618_wp*((y_n2/mw_n2) + (y_o2/mw_o2))
24398# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24399 bottom_blend_u = tanh(y_cc(j)/delta_shear)
24400# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24401 bottom_blend_t = tanh(y_cc(j)/delta_th)
24402# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24403 u_mean = u_max*bottom_blend_u
24404# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24405 t_loc = t_wall + (t_inf - t_wall)*bottom_blend_t
24406# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24407 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, 0) = p_atm/(r_mix*t_loc)
24408# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24409 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u_mean
24410# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24411 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
24412# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24413 q_prim_vf(eqn_idx%E)%sf(i, j, 0) = p_atm
24414# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24415 q_prim_vf(eqn_idx%species%beg)%sf(i, j, 0) = y_o2
24416# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24417 q_prim_vf(eqn_idx%species%end)%sf(i, j, 0) = y_n2
24418# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24419 case default
24420# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24421 if (proc_rank == 0) then
24422# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24423 call s_int_to_str(patch_id, istr)
24424# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24425 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
24426# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24427 end if
24428# 748 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24429 end select
24430# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24431 end if
24432
24433 ! Updating the patch identities bookkeeping variable
24434 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
24435
24436 ! Assign Parameters
24437 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, 0) = u0*sin(x_cc(i)/l0)*cos(y_cc(j)/l0)
24438 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = -u0*cos(x_cc(i)/l0)*sin(y_cc(j)/l0)
24439 q_prim_vf(eqn_idx%E)%sf(i, j, &
24440 & 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, &
24441 & 0)*u0*u0)/16
24442 end if
24443 end do
24444 end do
24445 if (allocated(stored_values)) then
24446# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24447#ifdef MFC_DEBUG
24448# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24449 block
24450# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24451 use iso_fortran_env, only: output_unit
24452# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24453
24454# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24455 print *, 'm_icpp_patches.fpp:763: ', '@:DEALLOCATE(stored_values)'
24456# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24457
24458# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24459 call flush (output_unit)
24460# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24461 end block
24462# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24463#endif
24464# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24465
24466# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24467#if defined(MFC_OpenACC)
24468# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24469!$acc exit data delete(stored_values)
24470# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24471#elif defined(MFC_OpenMP)
24472# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24473!$omp target exit data map(release:stored_values)
24474# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24475#endif
24476# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24477 deallocate (stored_values)
24478# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24479#ifdef MFC_DEBUG
24480# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24481 block
24482# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24483 use iso_fortran_env, only: output_unit
24484# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24485
24486# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24487 print *, 'm_icpp_patches.fpp:763: ', '@:DEALLOCATE(x_coords)'
24488# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24489
24490# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24491 call flush (output_unit)
24492# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24493 end block
24494# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24495#endif
24496# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24497
24498# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24499#if defined(MFC_OpenACC)
24500# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24501!$acc exit data delete(x_coords)
24502# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24503#elif defined(MFC_OpenMP)
24504# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24505!$omp target exit data map(release:x_coords)
24506# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24507#endif
24508# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24509 deallocate (x_coords)
24510# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24511 end if
24512# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24513
24514# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24515 if (allocated(y_coords)) then
24516# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24517#ifdef MFC_DEBUG
24518# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24519 block
24520# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24521 use iso_fortran_env, only: output_unit
24522# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24523
24524# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24525 print *, 'm_icpp_patches.fpp:763: ', '@:DEALLOCATE(y_coords)'
24526# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24527
24528# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24529 call flush (output_unit)
24530# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24531 end block
24532# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24533#endif
24534# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24535
24536# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24537#if defined(MFC_OpenACC)
24538# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24539!$acc exit data delete(y_coords)
24540# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24541#elif defined(MFC_OpenMP)
24542# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24543!$omp target exit data map(release:y_coords)
24544# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24545#endif
24546# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24547 deallocate (y_coords)
24548# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24549 end if
24550# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24551
24552# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24553 files_loaded = .false.
24554# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24555
24556# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24557 if (allocated(stored_values274)) then
24558# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24559#ifdef MFC_DEBUG
24560# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24561 block
24562# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24563 use iso_fortran_env, only: output_unit
24564# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24565
24566# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24567 print *, 'm_icpp_patches.fpp:763: ', '@:DEALLOCATE(stored_values274)'
24568# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24569
24570# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24571 call flush (output_unit)
24572# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24573 end block
24574# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24575#endif
24576# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24577
24578# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24579#if defined(MFC_OpenACC)
24580# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24581!$acc exit data delete(stored_values274)
24582# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24583#elif defined(MFC_OpenMP)
24584# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24585!$omp target exit data map(release:stored_values274)
24586# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24587#endif
24588# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24589 deallocate (stored_values274)
24590# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24591 end if
24592# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24593
24594# 763 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24595 files_loaded274 = .false.
24596# 764 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24597
24598 end subroutine s_icpp_2d_taylorgreen_vortex
24599
24600 !> Initialize a 1D bubble-pulse patch with analytical primitive variable profiles.
24601 subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
24602
24603 ! Description: This patch assigns the primitive variables as analytical functions such that the code can be verified.
24604
24605 ! Patch identifier
24606 integer, intent(in) :: patch_id
24607
24608#ifdef MFC_MIXED_PRECISION
24609 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
24610#else
24611 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
24612#endif
24613 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
24614
24615 ! Generic loop iterators
24616 integer :: i, j, k
24617 ! Placeholders for the cell boundary values
24618
24619 integer :: xRows, yRows, nRows, iix, iiy, max_files
24620# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24621 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
24622# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24623 real(wp) :: x_step, y_step
24624# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24625 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
24626# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24627 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
24628# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24629 real(wp) :: delta_x, delta_y
24630# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24631 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
24632# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24633 real(wp), allocatable :: stored_values(:,:,:)
24634# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24635 real(wp), allocatable :: x_coords(:), y_coords(:)
24636# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24637 logical :: files_loaded = .false.
24638# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24639 real(wp) :: domain_xstart
24640# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24641 character(len=20) :: file_num_str !< For storing the file number as a string
24642# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24643 integer :: ios
24644# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24645 integer :: ios2
24646# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24647
24648# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24649 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
24650# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24651 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
24652# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24653 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
24654# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24655 ! y_coords/files_loaded above.
24656# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24657 real(wp), allocatable, dimension(:,:,:) :: stored_values274
24658# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24659 logical :: files_loaded274 = .false.
24660# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24661 integer :: f274, ix274, iy274, unit274, ios274
24662# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24663 integer :: local_ix_beg274, local_iy_beg274
24664# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24665 character(len=300) :: fname274
24666# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24667 character(len=20) :: file_num_str274
24668# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24669 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
24670# 786 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24671 real(wp) :: file_dx274, file_dy274, r_align274
24672# 787 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24673 ! Place any declaration of intermediate variables here
24674# 787 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24675 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
24676# 788 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24677
24678 ! Transferring the patch's centroid and length information
24679 x_centroid = patch_icpp(patch_id)%x_centroid
24680 length_x = patch_icpp(patch_id)%length_x
24681
24682 ! Computing the beginning and the end x- and y-coordinates of the patch based on its centroid and lengths
24683 x_boundary%beg = x_centroid - 0.5_wp*length_x
24684 x_boundary%end = x_centroid + 0.5_wp*length_x
24685
24686 ! Set eta=1 (no smoothing for this patch type)
24687 eta = 1._wp
24688
24689 ! Assign patch vars if cell is covered and patch has write permission
24690 do i = 0, m
24691 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, &
24692 & 0, 0))) then
24693 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, eta, q_prim_vf, patch_id_fp)
24694
24695
24696# 807 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24697 if (patch_icpp(patch_id)%hcid /= dflt_int) then
24698 select case (patch_icpp(patch_id)%hcid)
24699# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24700 case (150) ! 1D Smooth Alfven Case for MHD
24701# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24702 ! velocity
24703# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24704 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
24705# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24706 q_prim_vf(eqn_idx%mom%beg + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
24707# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24708
24709# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24710 ! magnetic field
24711# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24712 q_prim_vf(eqn_idx%B%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
24713# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24714 q_prim_vf(eqn_idx%B%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
24715# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24716 case (170) ! 1D profile from external data (e.g. Cantera, SDtoolbox)
24717# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24718 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera,
24719# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24720 ! SDtoolbox)
24721# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24722 if (.not. files_loaded) then
24723# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24724 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
24725# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24726 do f = 1, max_files
24727# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24728 write (file_num_str, '(I0)') f
24729# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24730 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
24731# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24732 end do
24733# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24734
24735# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24736 ! Common file reading setup
24737# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24738 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
24739# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24740 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
24741# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24742
24743# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24744 select case (num_dims)
24745# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24746 case (1, 2) ! 1D and 2D cases are similar
24747# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24748 ! Count lines
24749# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24750 line_count = 0
24751# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24752 do
24753# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24754 read (unit2, *, iostat=ios2) dummy_x, dummy_y
24755# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24756 if (ios2 /= 0) exit
24757# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24758 line_count = line_count + 1
24759# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24760 end do
24761# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24762 close (unit2)
24763# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24764
24765# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24766 xrows = line_count
24767# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24768 yrows = 1
24769# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24770 index_x = 0
24771# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24772 if (num_dims == 2) index_x = i
24773# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24774#ifdef MFC_DEBUG
24775# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24776 block
24777# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24778 use iso_fortran_env, only: output_unit
24779# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24780
24781# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24782 print *, 'm_icpp_patches.fpp:808: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
24783# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24784
24785# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24786 call flush (output_unit)
24787# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24788 end block
24789# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24790#endif
24791# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24792 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
24793# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24794
24795# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24796
24797# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24798
24799# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24800#if defined(MFC_OpenACC)
24801# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24802!$acc enter data create(x_coords, stored_values)
24803# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24804#elif defined(MFC_OpenMP)
24805# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24806!$omp target enter data map(always,alloc:x_coords, stored_values)
24807# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24808#endif
24809# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24810
24811# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24812 ! Read data from all files
24813# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24814 do f = 1, max_files
24815# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24816 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
24817# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24818 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
24819# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24820
24821# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24822 do iter = 1, xrows
24823# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24824 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
24825# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24826 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
24827# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24828 end do
24829# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24830 close (unit)
24831# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24832 end do
24833# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24834
24835# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24836 ! Calculate offsets
24837# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24838 domain_xstart = x_coords(1)
24839# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24840 x_step = x_cc(1) - x_cc(0)
24841# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24842 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
24843# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24844 global_offset_x = nint(abs(delta_x)/x_step)
24845# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24846 case (3) ! 3D case - determine grid structure
24847# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24848 ! Find yRows by counting rows with same x
24849# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24850 read (unit2, *, iostat=ios2) x0, y0, dummy_z
24851# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24852 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
24853# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24854
24855# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24856 yrows = 1
24857# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24858 do
24859# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24860 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
24861# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24862 if (ios2 /= 0) exit
24863# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24864 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
24865# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24866 yrows = yrows + 1
24867# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24868 else
24869# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24870 exit
24871# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24872 end if
24873# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24874 end do
24875# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24876 close (unit2)
24877# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24878
24879# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24880 ! Count total rows
24881# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24882 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
24883# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24884 nrows = 0
24885# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24886 do
24887# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24888 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
24889# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24890 if (ios2 /= 0) exit
24891# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24892 nrows = nrows + 1
24893# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24894 end do
24895# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24896 close (unit2)
24897# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24898
24899# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24900 xrows = nrows/yrows
24901# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24902#ifdef MFC_DEBUG
24903# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24904 block
24905# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24906 use iso_fortran_env, only: output_unit
24907# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24908
24909# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24910 print *, 'm_icpp_patches.fpp:808: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
24911# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24912
24913# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24914 call flush (output_unit)
24915# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24916 end block
24917# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24918#endif
24919# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24920 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
24921# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24922
24923# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24924
24925# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24926
24927# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24928
24929# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24930#if defined(MFC_OpenACC)
24931# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24932!$acc enter data create(x_coords, y_coords, stored_values)
24933# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24934#elif defined(MFC_OpenMP)
24935# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24936!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
24937# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24938#endif
24939# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24940 index_x = i
24941# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24942 index_y = j
24943# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24944
24945# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24946 ! Read all files
24947# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24948 do f = 1, max_files
24949# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24950 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
24951# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24952 if (ios /= 0) then
24953# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24954 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
24955# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24956 cycle
24957# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24958 end if
24959# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24960
24961# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24962 iter = 0
24963# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24964 do iix = 1, xrows
24965# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24966 do iiy = 1, yrows
24967# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24968 iter = iter + 1
24969# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24970 if (f == 1) then
24971# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24972 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
24973# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24974 else
24975# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24976 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
24977# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24978 end if
24979# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24980 if (ios /= 0) call s_mpi_abort("Error reading data")
24981# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24982 end do
24983# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24984 end do
24985# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24986 close (unit)
24987# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24988 end do
24989# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24990
24991# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24992 ! Calculate offsets
24993# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24994 x_step = x_cc(1) - x_cc(0)
24995# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24996 y_step = y_cc(1) - y_cc(0)
24997# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
24998 delta_x = x_cc(index_x) - x_coords(1)
24999# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25000 delta_y = y_cc(index_y) - y_coords(1)
25001# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25002 global_offset_x = nint(abs(delta_x)/x_step)
25003# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25004 global_offset_y = nint(abs(delta_y)/y_step)
25005# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25006
25007# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25008 ! The index check below only catches overruns, so a file that is merely too
25009# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25010 ! FINE stays in range and silently supplies a corner of itself. Check spacing
25011# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25012 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
25013# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25014 ! consecutive x values sit yRows apart.
25015# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25016 if (nrows > yrows) then
25017# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25018 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
25019# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25020 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
25021# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25022 end if
25023# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25024 if (yrows > 1) then
25025# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25026 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
25027# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25028 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
25029# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25030 end if
25031# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25032 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
25033# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25034 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
25035# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25036 & wp)) > 1.e-6_wp) &
25037# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25038 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
25039# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25040 end select
25041# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25042
25043# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25044 files_loaded = .true.
25045# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25046 end if
25047# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25048
25049# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25050 ! Data assignment
25051# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25052 select case (num_dims)
25053# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25054 case (1)
25055# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25056 idx = i + 1 + global_offset_x
25057# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25058 ! idx must land inside the file's row range: this rank's subdomain offset
25059# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25060 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
25061# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25062 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
25063# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25064 if (idx < 1 .or. idx > xrows) &
25065# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25066 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
25067# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25068 do f = 1, sys_size
25069# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25070 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
25071# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25072 end do
25073# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25074 case (2)
25075# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25076 idx = i + 1 + global_offset_x - index_x
25077# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25078 if (idx < 1 .or. idx > xrows) &
25079# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25080 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
25081# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25082 do f = 1, sys_size - 1
25083# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25084 jump = merge(1, 0, f >= eqn_idx%mom%end)
25085# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25086 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
25087# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25088 end do
25089# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25090 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
25091# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25092 case (3)
25093# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25094 idx = i + 1 + global_offset_x - index_x
25095# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25096 idy = j + 1 + global_offset_y - index_y
25097# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25098 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
25099# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25100 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
25101# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25102 do f = 1, sys_size - 1
25103# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25104 jump = merge(1, 0, f >= eqn_idx%mom%end)
25105# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25106 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
25107# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25108 end do
25109# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25110 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
25111# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25112 end select
25113# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25114 case (180) ! Shu-Osher problem
25115# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25116 ! This is patch is hard-coded for test suite optimization used in the 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 +
25117# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25118 ! 0.2*sin(5*x)"
25119# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25120 if (patch_id == 2) then
25121# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25122 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
25123# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25124 end if
25125# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25126 case (181) ! Titarev-Torro problem
25127# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25128 ! This is patch is hard-coded for test suite optimization used in the 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)":
25129# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25130 ! "1 + 0.1*sin(20*x*pi)"
25131# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25132 q_prim_vf(eqn_idx%cont%beg + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
25133# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25134 case (182) ! Multi-component diffusion
25135# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25136 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
25137# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25138 x_mid_diffu = 0.05_wp/2.0_wp
25139# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25140 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
25141# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25142 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
25143# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25144 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
25145# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25146 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
25147# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25148 q_prim_vf(eqn_idx%adv%beg)%sf(i, 0, 0) = 1.0_wp
25149# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25150
25151# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25152 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
25153# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25154 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
25155# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25156 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
25157# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25158 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
25159# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25160
25161# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25162 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = y1
25163# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25164 q_prim_vf(eqn_idx%species%beg + 1)%sf(i, 0, 0) = y2
25165# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25166 q_prim_vf(eqn_idx%species%beg + 2)%sf(i, 0, 0) = y3
25167# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25168 q_prim_vf(eqn_idx%species%beg + 3)%sf(i, 0, 0) = y4
25169# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25170
25171# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25172 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
25173# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25174
25175# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25176 molar_mass_inv = y1/31.998_wp + y2/18.01508_wp + y3/16.04256_wp + y4/28.0134_wp
25177# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25178
25179# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25180 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)
25181# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25182 case(191) ! 1D Dual Isothermal case
25183# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25184 q_prim_vf(eqn_idx%E)%sf(i, 0, 0) = 101325.0_wp
25185# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25186 q_prim_vf(eqn_idx%mom%beg)%sf(i, 0, 0) = 0.0_wp
25187# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25188 q_prim_vf(eqn_idx%species%beg)%sf(i, 0, 0) = 1.0_wp
25189# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25190
25191# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25192 if (x_cc(i) <= 0.025_wp) then
25193# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25194 temp = 700.0_wp + ((1000.0_wp - 700.0_wp)/0.025_wp)*x_cc(i)
25195# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25196 else
25197# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25198 temp = 1200.0_wp + ((900.0_wp - 1000.0_wp)/0.025_wp)*(x_cc(i) - 0.025_wp)
25199# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25200 end if
25201# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25202
25203# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25204 molar_mass_inv = 1.0_wp/2.01588_wp
25205# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25206 q_prim_vf(eqn_idx%cont%beg)%sf(i, 0, 0) = 101325.0_wp/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
25207# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25208 case default
25209# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25210 call s_int_to_str(patch_id, istr)
25211# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25212 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
25213# 808 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25214 end select
25215# 809 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25216 end if
25217 end if
25218 end do
25219 if (allocated(stored_values)) then
25220# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25221#ifdef MFC_DEBUG
25222# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25223 block
25224# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25225 use iso_fortran_env, only: output_unit
25226# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25227
25228# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25229 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(stored_values)'
25230# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25231
25232# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25233 call flush (output_unit)
25234# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25235 end block
25236# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25237#endif
25238# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25239
25240# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25241#if defined(MFC_OpenACC)
25242# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25243!$acc exit data delete(stored_values)
25244# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25245#elif defined(MFC_OpenMP)
25246# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25247!$omp target exit data map(release:stored_values)
25248# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25249#endif
25250# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25251 deallocate (stored_values)
25252# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25253#ifdef MFC_DEBUG
25254# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25255 block
25256# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25257 use iso_fortran_env, only: output_unit
25258# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25259
25260# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25261 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(x_coords)'
25262# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25263
25264# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25265 call flush (output_unit)
25266# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25267 end block
25268# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25269#endif
25270# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25271
25272# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25273#if defined(MFC_OpenACC)
25274# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25275!$acc exit data delete(x_coords)
25276# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25277#elif defined(MFC_OpenMP)
25278# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25279!$omp target exit data map(release:x_coords)
25280# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25281#endif
25282# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25283 deallocate (x_coords)
25284# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25285 end if
25286# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25287
25288# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25289 if (allocated(y_coords)) then
25290# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25291#ifdef MFC_DEBUG
25292# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25293 block
25294# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25295 use iso_fortran_env, only: output_unit
25296# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25297
25298# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25299 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(y_coords)'
25300# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25301
25302# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25303 call flush (output_unit)
25304# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25305 end block
25306# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25307#endif
25308# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25309
25310# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25311#if defined(MFC_OpenACC)
25312# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25313!$acc exit data delete(y_coords)
25314# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25315#elif defined(MFC_OpenMP)
25316# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25317!$omp target exit data map(release:y_coords)
25318# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25319#endif
25320# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25321 deallocate (y_coords)
25322# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25323 end if
25324# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25325
25326# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25327 files_loaded = .false.
25328# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25329
25330# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25331 if (allocated(stored_values274)) then
25332# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25333#ifdef MFC_DEBUG
25334# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25335 block
25336# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25337 use iso_fortran_env, only: output_unit
25338# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25339
25340# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25341 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(stored_values274)'
25342# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25343
25344# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25345 call flush (output_unit)
25346# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25347 end block
25348# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25349#endif
25350# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25351
25352# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25353#if defined(MFC_OpenACC)
25354# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25355!$acc exit data delete(stored_values274)
25356# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25357#elif defined(MFC_OpenMP)
25358# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25359!$omp target exit data map(release:stored_values274)
25360# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25361#endif
25362# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25363 deallocate (stored_values274)
25364# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25365 end if
25366# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25367
25368# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25369 files_loaded274 = .false.
25370# 813 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25371
25372 end subroutine s_icpp_1d_bubble_pulse
25373
25374 !> 2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid). Additive (modal_use_exp_form false): R = radius +
25375 !! sum_n [fourier_cos*cos(n*theta)+fourier_sin*sin(n*theta)]; coefficients are absolute (same units as radius). R is clipped to
25376 !! 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);
25377 !! coefficients are relative (dimensionless).
25378 subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
25379
25380 integer, intent(in) :: patch_id
25381
25382#ifdef MFC_MIXED_PRECISION
25383 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
25384#else
25385 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
25386#endif
25387 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
25388 real(wp) :: r, theta, R_boundary, sum_series
25389 integer :: i, j, nn
25390
25391 x_centroid = patch_icpp(patch_id)%x_centroid
25392 y_centroid = patch_icpp(patch_id)%y_centroid
25393 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
25394 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
25395 eta = 1._wp
25396
25397 do j = 0, n
25398 do i = 0, m
25399 r = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
25400 if (r < small_radius) then
25401 theta = 0._wp
25402 else
25403 theta = atan2(y_cc(j) - y_centroid, x_cc(i) - x_centroid)
25404 end if
25405 sum_series = 0._wp
25406 do nn = 1, max_2d_fourier_modes
25407 sum_series = sum_series + patch_icpp(patch_id)%fourier_cos(nn)*cos(real(nn, &
25408 & wp)*theta) + patch_icpp(patch_id)%fourier_sin(nn)*sin(real(nn, wp)*theta)
25409 end do
25410 if (patch_icpp(patch_id)%modal_use_exp_form) then
25411 r_boundary = patch_icpp(patch_id)%radius*exp(sum_series)
25412 else
25413 r_boundary = patch_icpp(patch_id)%radius + sum_series
25414 r_boundary = max(r_boundary, 0._wp)
25415 if (patch_icpp(patch_id)%modal_clip_r_to_min) then
25416 r_boundary = max(r_boundary, patch_icpp(patch_id)%modal_r_min)
25417 end if
25418 end if
25419 if (patch_icpp(patch_id)%smoothen) then
25420 eta = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx_min, dy_min)*(r_boundary - r))
25421 end if
25422 if ((r <= r_boundary .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) .or. patch_id_fp(i, j, &
25423 & 0) == smooth_patch_id) then
25424 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
25425 end if
25426 end do
25427 end do
25428
25429 end subroutine s_icpp_2d_modal
25430
25431 !> 3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,phi). theta = acos(z/r), phi =
25432 !! atan2(y,x) relative to centroid.
25433 subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
25434
25435 integer, intent(in) :: patch_id
25436
25437#ifdef MFC_MIXED_PRECISION
25438 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
25439#else
25440 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
25441#endif
25442 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
25443 real(wp) :: dx_loc, dy_loc, dz_loc, r, theta, phi, R_surface, eta_local
25444 integer :: i, j, k, ll, mm
25445
25446 x_centroid = patch_icpp(patch_id)%x_centroid
25447 y_centroid = patch_icpp(patch_id)%y_centroid
25448 z_centroid = patch_icpp(patch_id)%z_centroid
25449 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
25450 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
25451 eta_local = 1._wp
25452
25453 do k = 0, p
25454 do j = 0, n
25455 do i = 0, m
25456 if (grid_geometry == 3) then
25457 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
25458 dx_loc = x_cc(i) - x_centroid
25459 dy_loc = cart_y - y_centroid
25460 dz_loc = cart_z - z_centroid
25461 else
25462 dx_loc = x_cc(i) - x_centroid
25463 dy_loc = y_cc(j) - y_centroid
25464 dz_loc = z_cc(k) - z_centroid
25465 end if
25466 r = sqrt(dx_loc**2 + dy_loc**2 + dz_loc**2)
25467 if (r < small_radius) then
25468 theta = 0._wp
25469 phi = 0._wp
25470 else
25471 theta = acos(min(1._wp, max(-1._wp, dz_loc/r)))
25472 phi = atan2(dy_loc, dx_loc)
25473 end if
25474 r_surface = patch_icpp(patch_id)%radius
25475 do ll = 0, max_sph_harm_degree
25476 do mm = -ll, ll
25477 if (patch_icpp(patch_id)%sph_har_coeff(ll, mm) == 0._wp) cycle
25478 r_surface = r_surface + patch_icpp(patch_id)%sph_har_coeff(ll, mm)*real_ylm(theta, phi, ll, mm)
25479 end do
25480 end do
25481 if (patch_icpp(patch_id)%smoothen) then
25482 eta_local = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx_min, dy_min, dz_min)*(r_surface - r))
25483 end if
25484 if ((r <= r_surface .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
25485 & k) == smooth_patch_id) then
25486 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta_local, q_prim_vf, patch_id_fp)
25487 end if
25488 end do
25489 end do
25490 end do
25491
25492 end subroutine s_icpp_3d_spherical_harmonic
25493
25494 !> The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet. The patch geometry is
25495 !! well-defined when its centroid and radius are provided. Please note that the spherical patch DOES allow for the smoothing of
25496 !! its boundary.
25497 subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
25498
25499 integer, intent(in) :: patch_id
25500
25501#ifdef MFC_MIXED_PRECISION
25502 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
25503#else
25504 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
25505#endif
25506 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
25507
25508 ! Generic loop iterators
25509 integer :: i, j, k
25510 real(wp) :: radius
25511
25512 integer :: xRows, yRows, nRows, iix, iiy, max_files
25513# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25514 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
25515# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25516 real(wp) :: x_step, y_step
25517# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25518 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
25519# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25520 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
25521# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25522 real(wp) :: delta_x, delta_y
25523# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25524 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
25525# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25526 real(wp), allocatable :: stored_values(:,:,:)
25527# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25528 real(wp), allocatable :: x_coords(:), y_coords(:)
25529# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25530 logical :: files_loaded = .false.
25531# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25532 real(wp) :: domain_xstart
25533# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25534 character(len=20) :: file_num_str !< For storing the file number as a string
25535# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25536 integer :: ios
25537# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25538 integer :: ios2
25539# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25540
25541# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25542 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
25543# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25544 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
25545# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25546 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
25547# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25548 ! y_coords/files_loaded above.
25549# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25550 real(wp), allocatable, dimension(:,:,:) :: stored_values274
25551# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25552 logical :: files_loaded274 = .false.
25553# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25554 integer :: f274, ix274, iy274, unit274, ios274
25555# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25556 integer :: local_ix_beg274, local_iy_beg274
25557# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25558 character(len=300) :: fname274
25559# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25560 character(len=20) :: file_num_str274
25561# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25562 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
25563# 954 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25564 real(wp) :: file_dx274, file_dy274, r_align274
25565# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25566 ! Place any declaration of intermediate variables here
25567# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25568 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
25569# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25570 real(wp) :: eps
25571# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25572 real(wp) :: zlen371, kz371
25573# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25574
25575# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25576 ! IGR Jets Arrays to stor position and radii of jets from input file
25577# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25578 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
25579# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25580 ! Variables to describe initial condition of jet
25581# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25582 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
25583# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25584 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
25585# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25586 real(wp), dimension(0:n,0:p) :: rcut_arr
25587# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25588 integer :: l, q, s !< Iterators for reading input files
25589# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25590 integer :: start, end !< Ints to keep track of position in file
25591# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25592 character(len=100000) :: line ! String to store line in file
25593# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25594 character(len=25) :: value !< String to store value in line
25595# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25596 integer :: NJet !< Number of jets
25597# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25598 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
25599# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25600 logical :: file_exist ! Flag to check if file exists
25601# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25602
25603# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25604 eps = 1e-9_wp
25605# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25606
25607# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25608 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
25609# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25610 eps_smooth = 3._wp
25611# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25612 inquire (file="njet.txt", exist=file_exist)
25613# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25614 if (file_exist) then
25615# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25616 open (unit=10, file="njet.txt", status="old", action="read")
25617# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25618 read (10, *) njet
25619# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25620 close (10)
25621# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25622 else
25623# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25624 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
25625# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25626 end if
25627# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25628
25629# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25630#ifdef MFC_DEBUG
25631# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25632 block
25633# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25634 use iso_fortran_env, only: output_unit
25635# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25636
25637# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25638 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
25639# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25640
25641# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25642 call flush (output_unit)
25643# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25644 end block
25645# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25646#endif
25647# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25648 allocate (y_th_arr(0:njet - 1))
25649# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25650
25651# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25652
25653# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25654#if defined(MFC_OpenACC)
25655# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25656!$acc enter data create(y_th_arr)
25657# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25658#elif defined(MFC_OpenMP)
25659# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25660!$omp target enter data map(always,alloc:y_th_arr)
25661# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25662#endif
25663# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25664#ifdef MFC_DEBUG
25665# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25666 block
25667# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25668 use iso_fortran_env, only: output_unit
25669# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25670
25671# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25672 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
25673# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25674
25675# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25676 call flush (output_unit)
25677# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25678 end block
25679# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25680#endif
25681# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25682 allocate (z_th_arr(0:njet - 1))
25683# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25684
25685# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25686
25687# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25688#if defined(MFC_OpenACC)
25689# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25690!$acc enter data create(z_th_arr)
25691# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25692#elif defined(MFC_OpenMP)
25693# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25694!$omp target enter data map(always,alloc:z_th_arr)
25695# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25696#endif
25697# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25698#ifdef MFC_DEBUG
25699# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25700 block
25701# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25702 use iso_fortran_env, only: output_unit
25703# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25704
25705# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25706 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
25707# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25708
25709# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25710 call flush (output_unit)
25711# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25712 end block
25713# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25714#endif
25715# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25716 allocate (r_th_arr(0:njet - 1))
25717# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25718
25719# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25720
25721# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25722#if defined(MFC_OpenACC)
25723# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25724!$acc enter data create(r_th_arr)
25725# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25726#elif defined(MFC_OpenMP)
25727# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25728!$omp target enter data map(always,alloc:r_th_arr)
25729# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25730#endif
25731# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25732
25733# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25734 inquire (file="jets.csv", exist=file_exist)
25735# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25736 if (file_exist) then
25737# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25738 open (unit=10, file="jets.csv", status="old", action="read")
25739# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25740 do q = 0, njet - 1
25741# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25742 read (10, '(A)') line ! Read a full line as a string
25743# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25744 start = 1
25745# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25746
25747# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25748 do l = 0, 2
25749# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25750 end = index(line(start:), ',') ! Find the next comma
25751# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25752 if (end == 0) then
25753# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25754 value = trim(adjustl(line(start:))) ! Last value in the line
25755# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25756 else
25757# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25758 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
25759# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25760 start = start + end ! Move to next value
25761# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25762 end if
25763# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25764 if (l == 0) then
25765# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25766 read (value, *) y_th_arr(q) ! Convert string to numeric value
25767# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25768 else if (l == 1) then
25769# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25770 read (value, *) z_th_arr(q)
25771# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25772 else
25773# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25774 read (value, *) r_th_arr(q)
25775# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25776 end if
25777# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25778 end do
25779# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25780 end do
25781# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25782 close (10)
25783# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25784
25785# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25786 do q = 0, p
25787# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25788 do l = 0, n
25789# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25790 rcut = 0._wp
25791# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25792 do s = 0, njet - 1
25793# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25794 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
25795# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25796 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
25797# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25798 end do
25799# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25800 rcut_arr(l, q) = rcut
25801# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25802 end do
25803# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25804 end do
25805# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25806 else
25807# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25808 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
25809# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25810 end if
25811# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25812 end if
25813# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25814
25815# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25816 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
25817# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25818#ifdef MFC_DEBUG
25819# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25820 block
25821# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25822 use iso_fortran_env, only: output_unit
25823# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25824
25825# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25826 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
25827# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25828
25829# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25830 call flush (output_unit)
25831# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25832 end block
25833# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25834#endif
25835# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25836 allocate (ih(0:n_glb, 0:p_glb))
25837# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25838
25839# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25840
25841# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25842#if defined(MFC_OpenACC)
25843# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25844!$acc enter data create(ih)
25845# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25846#elif defined(MFC_OpenMP)
25847# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25848!$omp target enter data map(always,alloc:ih)
25849# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25850#endif
25851# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25852
25853# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25854 if (interface_file == '.') then
25855# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25856 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
25857# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25858 else
25859# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25860 inquire (file=trim(interface_file), exist=file_exist)
25861# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25862 if (file_exist) then
25863# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25864 open (unit=10, file=trim(interface_file), status="old", action="read")
25865# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25866 do i = 0, n_glb
25867# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25868 read (10, '(A)') line ! Read a full line as a string
25869# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25870 start = 1
25871# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25872
25873# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25874 do j = 0, p_glb
25875# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25876 end = index(line(start:), ',') ! Find the next comma
25877# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25878 if (end == 0) then
25879# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25880 value = trim(adjustl(line(start:))) ! Last value in the line
25881# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25882 else
25883# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25884 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
25885# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25886 start = start + end ! Move to next value
25887# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25888 end if
25889# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25890 read (value, *) ih(i, j) ! Convert string to numeric value
25891# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25892 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
25893# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25894 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
25895# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25896 end do
25897# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25898 end do
25899# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25900 close (10)
25901# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25902 else
25903# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25904 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
25905# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25906 end if
25907# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25908 end if
25909# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25910 end if
25911# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25912
25913# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25914 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
25915# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25916#ifdef MFC_DEBUG
25917# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25918 block
25919# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25920 use iso_fortran_env, only: output_unit
25921# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25922
25923# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25924 print *, 'm_icpp_patches.fpp:955: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
25925# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25926
25927# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25928 call flush (output_unit)
25929# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25930 end block
25931# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25932#endif
25933# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25934 allocate (ih(0:n_glb, 0:0))
25935# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25936
25937# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25938
25939# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25940#if defined(MFC_OpenACC)
25941# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25942!$acc enter data create(ih)
25943# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25944#elif defined(MFC_OpenMP)
25945# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25946!$omp target enter data map(always,alloc:ih)
25947# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25948#endif
25949# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25950 if (interface_file == '.') then
25951# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25952 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
25953# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25954 else
25955# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25956 inquire (file=trim(interface_file), exist=file_exist)
25957# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25958 if (file_exist) then
25959# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25960 open (unit=10, file=trim(interface_file), status="old", action="read")
25961# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25962 do i = 0, n_glb
25963# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25964 read (10, '(A)') line ! Read a full line as a string
25965# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25966 value = trim(line)
25967# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25968 read (value, *) ih(i, 0) ! Convert string to numeric value
25969# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25970 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
25971# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25972 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
25973# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25974 end do
25975# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25976 close (10)
25977# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25978 else
25979# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25980 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
25981# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25982 end if
25983# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25984 end if
25985# 955 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25986 end if
25987# 956 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
25988
25989 ! Variables to initialize the pressure field that corresponds to the bubble-collapse test case found in Tiwari et al. (2013)
25990
25991 ! Transferring spherical patch's radius, centroid, smoothing patch identity and smoothing coefficient information
25992 x_centroid = patch_icpp(patch_id)%x_centroid
25993 y_centroid = patch_icpp(patch_id)%y_centroid
25994 z_centroid = patch_icpp(patch_id)%z_centroid
25995 radius = patch_icpp(patch_id)%radius
25996 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
25997 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
25998
25999 ! Initialize eta=1; modified if smoothing is enabled
26000 eta = 1._wp
26001
26002 ! Assign patch vars if cell is covered and patch has write permission
26003 do k = 0, p
26004 do j = 0, n
26005 do i = 0, m
26006 if (grid_geometry == 3) then
26008 else
26009 cart_y = y_cc(j)
26010 cart_z = z_cc(k)
26011 end if
26012
26013 if (patch_icpp(patch_id)%smoothen) then
26014 eta = tanh(smooth_coeff/min(dx_min, dy_min, &
26015 & dz_min)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2 + (cart_z - z_centroid) &
26016 & **2) - radius))*(-0.5_wp) + 0.5_wp
26017 end if
26018
26019 if ((f_is_inside_sphere(x_cc(i) - x_centroid, cart_y - y_centroid, cart_z - z_centroid, &
26020 & radius) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
26021 & k) == smooth_patch_id) then
26022 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
26023
26024
26025# 993 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26026 if (patch_icpp(patch_id)%hcid /= dflt_int) then
26027 select case (patch_icpp(patch_id)%hcid)
26028# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26029 case (300) ! Rayleigh-Taylor instability
26030# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26031 rhoh = 3._wp
26032# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26033 rhol = 1._wp
26034# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26035 pref = 1.e5_wp
26036# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26037 pint = pref
26038# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26039 h = 0.7_wp
26040# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26041 lam = 0.2_wp
26042# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26043 wl = 2._wp*pi/lam
26044# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26045 amp = 0.025_wp/wl
26046# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26047
26048# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26049 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
26050# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26051
26052# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26053 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
26054# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26055
26056# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26057 if (alph < eps) alph = eps
26058# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26059 if (alph > 1._wp - eps) alph = 1._wp - eps
26060# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26061
26062# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26063 if (y_cc(j) > inth) then
26064# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26065 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
26066# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26067 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
26068# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26069 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
26070# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26071 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
26072# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26073 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
26074# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26075 else
26076# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26077 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
26078# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26079 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
26080# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26081 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
26082# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26083 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
26084# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26085 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
26086# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26087 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
26088# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26089 end if
26090# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26091 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
26092# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26093 h = 0.0_wp
26094# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26095 lam = 1.0_wp
26096# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26097 amp = patch_icpp(patch_id)%a(2)
26098# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26099 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
26100# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26101 if (x_cc(i) > inth) then
26102# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26103 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
26104# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26105 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
26106# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26107 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
26108# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26109 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
26110# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26111 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
26112# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26113 end if
26114# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26115 case (302) ! 3D Jet with IGR
26116# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26117 ux_th = 10*sqrt(1.4*0.4)
26118# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26119 ux_am = 0.0*sqrt(1.4)
26120# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26121 p_th = 2.0_wp
26122# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26123 p_am = 1.0_wp
26124# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26125 rho_th = 1._wp
26126# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26127 rho_am = 1._wp
26128# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26129 y_th = 0.0_wp
26130# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26131 z_th = 0.0_wp
26132# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26133 r_th = 1._wp
26134# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26135 eps_smooth = 1._wp
26136# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26137 eps = 1e-6
26138# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26139
26140# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26141 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
26142# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26143 rcut = f_cut_on(r - r_th, eps_smooth)
26144# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26145 xcut = f_cut_on(x_cc(i), eps_smooth)
26146# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26147
26148# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26149 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
26150# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26151 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
26152# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26153 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
26154# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26155
26156# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26157 if (num_fluids == 1) then
26158# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26159 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
26160# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26161 else
26162# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26163 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
26164# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26165 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
26166# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26167 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))
26168# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26169 end if
26170# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26171
26172# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26173 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
26174# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26175 case (303) ! 3D Multijet
26176# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26177 eps_smooth = 3.0_wp
26178# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26179 ux_th = 10*sqrt(1.4*0.4)
26180# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26181 ux_am = 2.5*sqrt(1.4*0.4)
26182# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26183 p_th = 0.8_wp
26184# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26185 p_am = 0.4_wp
26186# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26187 rho_th = 1._wp
26188# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26189 rho_am = 1._wp
26190# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26191 eps = 1e-6
26192# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26193
26194# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26195 rcut = rcut_arr(j, k)
26196# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26197 xcut = f_cut_on(x_cc(i), eps_smooth)
26198# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26199
26200# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26201 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
26202# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26203 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
26204# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26205 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
26206# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26207
26208# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26209 if (num_fluids == 1) then
26210# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26211 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
26212# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26213 else
26214# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26215 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
26216# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26217 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
26218# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26219 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))
26220# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26221 end if
26222# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26223
26224# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26225 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
26226# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26227 case (304) ! 3D Interface from file cartesian
26228# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26229 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)))
26230# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26231
26232# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26233 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
26234# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26235 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
26236# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26237
26238# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26239 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)
26240# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26241 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)
26242# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26243
26244# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26245 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, &
26246# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26247 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
26248# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26249
26250# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26251 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
26252# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26253 case (305) ! 3D Interface from file axisymmetric
26254# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26255 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)))
26256# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26257
26258# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26259 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
26260# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26261 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
26262# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26263
26264# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26265 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
26266# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26267 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)
26268# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26269
26270# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26271 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, &
26272# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26273 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
26274# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26275
26276# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26277 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
26278# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26279 case (370) ! 3D extrusion of 2D profile from external data
26280# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26281 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
26282# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26283 if (.not. files_loaded) then
26284# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26285 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
26286# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26287 do f = 1, max_files
26288# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26289 write (file_num_str, '(I0)') f
26290# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26291 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
26292# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26293 end do
26294# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26295
26296# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26297 ! Common file reading setup
26298# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26299 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
26300# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26301 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
26302# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26303
26304# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26305 select case (num_dims)
26306# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26307 case (1, 2) ! 1D and 2D cases are similar
26308# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26309 ! Count lines
26310# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26311 line_count = 0
26312# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26313 do
26314# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26315 read (unit2, *, iostat=ios2) dummy_x, dummy_y
26316# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26317 if (ios2 /= 0) exit
26318# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26319 line_count = line_count + 1
26320# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26321 end do
26322# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26323 close (unit2)
26324# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26325
26326# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26327 xrows = line_count
26328# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26329 yrows = 1
26330# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26331 index_x = 0
26332# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26333 if (num_dims == 2) index_x = i
26334# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26335#ifdef MFC_DEBUG
26336# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26337 block
26338# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26339 use iso_fortran_env, only: output_unit
26340# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26341
26342# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26343 print *, 'm_icpp_patches.fpp:994: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
26344# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26345
26346# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26347 call flush (output_unit)
26348# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26349 end block
26350# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26351#endif
26352# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26353 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
26354# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26355
26356# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26357
26358# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26359
26360# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26361#if defined(MFC_OpenACC)
26362# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26363!$acc enter data create(x_coords, stored_values)
26364# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26365#elif defined(MFC_OpenMP)
26366# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26367!$omp target enter data map(always,alloc:x_coords, stored_values)
26368# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26369#endif
26370# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26371
26372# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26373 ! Read data from all files
26374# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26375 do f = 1, max_files
26376# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26377 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
26378# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26379 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
26380# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26381
26382# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26383 do iter = 1, xrows
26384# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26385 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
26386# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26387 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
26388# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26389 end do
26390# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26391 close (unit)
26392# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26393 end do
26394# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26395
26396# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26397 ! Calculate offsets
26398# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26399 domain_xstart = x_coords(1)
26400# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26401 x_step = x_cc(1) - x_cc(0)
26402# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26403 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
26404# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26405 global_offset_x = nint(abs(delta_x)/x_step)
26406# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26407 case (3) ! 3D case - determine grid structure
26408# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26409 ! Find yRows by counting rows with same x
26410# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26411 read (unit2, *, iostat=ios2) x0, y0, dummy_z
26412# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26413 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
26414# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26415
26416# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26417 yrows = 1
26418# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26419 do
26420# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26421 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
26422# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26423 if (ios2 /= 0) exit
26424# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26425 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
26426# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26427 yrows = yrows + 1
26428# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26429 else
26430# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26431 exit
26432# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26433 end if
26434# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26435 end do
26436# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26437 close (unit2)
26438# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26439
26440# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26441 ! Count total rows
26442# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26443 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
26444# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26445 nrows = 0
26446# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26447 do
26448# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26449 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
26450# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26451 if (ios2 /= 0) exit
26452# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26453 nrows = nrows + 1
26454# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26455 end do
26456# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26457 close (unit2)
26458# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26459
26460# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26461 xrows = nrows/yrows
26462# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26463#ifdef MFC_DEBUG
26464# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26465 block
26466# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26467 use iso_fortran_env, only: output_unit
26468# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26469
26470# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26471 print *, 'm_icpp_patches.fpp:994: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
26472# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26473
26474# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26475 call flush (output_unit)
26476# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26477 end block
26478# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26479#endif
26480# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26481 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
26482# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26483
26484# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26485
26486# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26487
26488# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26489
26490# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26491#if defined(MFC_OpenACC)
26492# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26493!$acc enter data create(x_coords, y_coords, stored_values)
26494# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26495#elif defined(MFC_OpenMP)
26496# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26497!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
26498# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26499#endif
26500# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26501 index_x = i
26502# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26503 index_y = j
26504# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26505
26506# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26507 ! Read all files
26508# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26509 do f = 1, max_files
26510# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26511 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
26512# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26513 if (ios /= 0) then
26514# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26515 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
26516# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26517 cycle
26518# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26519 end if
26520# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26521
26522# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26523 iter = 0
26524# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26525 do iix = 1, xrows
26526# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26527 do iiy = 1, yrows
26528# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26529 iter = iter + 1
26530# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26531 if (f == 1) then
26532# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26533 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
26534# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26535 else
26536# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26537 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
26538# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26539 end if
26540# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26541 if (ios /= 0) call s_mpi_abort("Error reading data")
26542# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26543 end do
26544# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26545 end do
26546# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26547 close (unit)
26548# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26549 end do
26550# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26551
26552# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26553 ! Calculate offsets
26554# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26555 x_step = x_cc(1) - x_cc(0)
26556# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26557 y_step = y_cc(1) - y_cc(0)
26558# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26559 delta_x = x_cc(index_x) - x_coords(1)
26560# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26561 delta_y = y_cc(index_y) - y_coords(1)
26562# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26563 global_offset_x = nint(abs(delta_x)/x_step)
26564# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26565 global_offset_y = nint(abs(delta_y)/y_step)
26566# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26567
26568# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26569 ! The index check below only catches overruns, so a file that is merely too
26570# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26571 ! FINE stays in range and silently supplies a corner of itself. Check spacing
26572# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26573 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
26574# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26575 ! consecutive x values sit yRows apart.
26576# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26577 if (nrows > yrows) then
26578# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26579 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
26580# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26581 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
26582# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26583 end if
26584# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26585 if (yrows > 1) then
26586# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26587 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
26588# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26589 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
26590# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26591 end if
26592# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26593 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
26594# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26595 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
26596# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26597 & wp)) > 1.e-6_wp) &
26598# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26599 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
26600# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26601 end select
26602# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26603
26604# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26605 files_loaded = .true.
26606# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26607 end if
26608# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26609
26610# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26611 ! Data assignment
26612# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26613 select case (num_dims)
26614# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26615 case (1)
26616# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26617 idx = i + 1 + global_offset_x
26618# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26619 ! idx must land inside the file's row range: this rank's subdomain offset
26620# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26621 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
26622# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26623 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
26624# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26625 if (idx < 1 .or. idx > xrows) &
26626# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26627 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
26628# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26629 do f = 1, sys_size
26630# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26631 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
26632# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26633 end do
26634# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26635 case (2)
26636# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26637 idx = i + 1 + global_offset_x - index_x
26638# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26639 if (idx < 1 .or. idx > xrows) &
26640# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26641 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
26642# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26643 do f = 1, sys_size - 1
26644# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26645 jump = merge(1, 0, f >= eqn_idx%mom%end)
26646# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26647 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
26648# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26649 end do
26650# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26651 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
26652# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26653 case (3)
26654# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26655 idx = i + 1 + global_offset_x - index_x
26656# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26657 idy = j + 1 + global_offset_y - index_y
26658# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26659 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
26660# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26661 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
26662# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26663 do f = 1, sys_size - 1
26664# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26665 jump = merge(1, 0, f >= eqn_idx%mom%end)
26666# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26667 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
26668# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26669 end do
26670# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26671 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
26672# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26673 end select
26674# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26675 case (371) ! hcid=370 + closed-form spanwise (z) modulation for genuine 3D content
26676# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26677 ! hcid=370's read extrudes the (x,y) file uniformly across z, leaving the flow
26678# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26679 ! z-invariant. Modulate the file's cross-stream (y) velocity by a z-dependent
26680# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26681 ! factor and set the spanwise (w) component from the result, so both inherit the
26682# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26683 ! file's shear-layer localization and amplitude scale. Streamwise (x) is left as
26684# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26685 ! read. This scales the whole y-velocity, which is the perturbation alone only
26686# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26687 ! when the base state has v == 0, as a temporal mixing layer does.
26688# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26689 !
26690# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26691 ! kz uses the GLOBAL z extent: p and z_cc(0:p) are per-rank under MPI, so a local
26692# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26693 ! extent would scale kz by num_procs_z and break periodicity at the z wrap.
26694# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26695 ! z_cc(k) is already absolute, so the phase needs no offset. Assumes uniform dz.
26696# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26697 if (.not. files_loaded) then
26698# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26699 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
26700# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26701 do f = 1, max_files
26702# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26703 write (file_num_str, '(I0)') f
26704# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26705 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
26706# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26707 end do
26708# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26709
26710# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26711 ! Common file reading setup
26712# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26713 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
26714# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26715 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
26716# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26717
26718# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26719 select case (num_dims)
26720# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26721 case (1, 2) ! 1D and 2D cases are similar
26722# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26723 ! Count lines
26724# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26725 line_count = 0
26726# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26727 do
26728# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26729 read (unit2, *, iostat=ios2) dummy_x, dummy_y
26730# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26731 if (ios2 /= 0) exit
26732# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26733 line_count = line_count + 1
26734# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26735 end do
26736# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26737 close (unit2)
26738# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26739
26740# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26741 xrows = line_count
26742# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26743 yrows = 1
26744# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26745 index_x = 0
26746# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26747 if (num_dims == 2) index_x = i
26748# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26749#ifdef MFC_DEBUG
26750# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26751 block
26752# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26753 use iso_fortran_env, only: output_unit
26754# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26755
26756# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26757 print *, 'm_icpp_patches.fpp:994: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
26758# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26759
26760# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26761 call flush (output_unit)
26762# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26763 end block
26764# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26765#endif
26766# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26767 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
26768# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26769
26770# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26771
26772# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26773
26774# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26775#if defined(MFC_OpenACC)
26776# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26777!$acc enter data create(x_coords, stored_values)
26778# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26779#elif defined(MFC_OpenMP)
26780# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26781!$omp target enter data map(always,alloc:x_coords, stored_values)
26782# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26783#endif
26784# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26785
26786# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26787 ! Read data from all files
26788# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26789 do f = 1, max_files
26790# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26791 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
26792# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26793 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
26794# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26795
26796# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26797 do iter = 1, xrows
26798# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26799 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
26800# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26801 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
26802# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26803 end do
26804# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26805 close (unit)
26806# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26807 end do
26808# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26809
26810# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26811 ! Calculate offsets
26812# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26813 domain_xstart = x_coords(1)
26814# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26815 x_step = x_cc(1) - x_cc(0)
26816# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26817 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
26818# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26819 global_offset_x = nint(abs(delta_x)/x_step)
26820# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26821 case (3) ! 3D case - determine grid structure
26822# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26823 ! Find yRows by counting rows with same x
26824# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26825 read (unit2, *, iostat=ios2) x0, y0, dummy_z
26826# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26827 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
26828# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26829
26830# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26831 yrows = 1
26832# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26833 do
26834# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26835 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
26836# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26837 if (ios2 /= 0) exit
26838# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26839 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
26840# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26841 yrows = yrows + 1
26842# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26843 else
26844# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26845 exit
26846# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26847 end if
26848# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26849 end do
26850# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26851 close (unit2)
26852# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26853
26854# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26855 ! Count total rows
26856# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26857 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
26858# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26859 nrows = 0
26860# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26861 do
26862# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26863 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
26864# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26865 if (ios2 /= 0) exit
26866# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26867 nrows = nrows + 1
26868# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26869 end do
26870# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26871 close (unit2)
26872# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26873
26874# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26875 xrows = nrows/yrows
26876# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26877#ifdef MFC_DEBUG
26878# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26879 block
26880# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26881 use iso_fortran_env, only: output_unit
26882# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26883
26884# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26885 print *, 'm_icpp_patches.fpp:994: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
26886# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26887
26888# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26889 call flush (output_unit)
26890# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26891 end block
26892# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26893#endif
26894# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26895 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
26896# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26897
26898# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26899
26900# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26901
26902# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26903
26904# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26905#if defined(MFC_OpenACC)
26906# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26907!$acc enter data create(x_coords, y_coords, stored_values)
26908# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26909#elif defined(MFC_OpenMP)
26910# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26911!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
26912# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26913#endif
26914# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26915 index_x = i
26916# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26917 index_y = j
26918# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26919
26920# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26921 ! Read all files
26922# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26923 do f = 1, max_files
26924# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26925 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
26926# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26927 if (ios /= 0) then
26928# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26929 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
26930# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26931 cycle
26932# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26933 end if
26934# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26935
26936# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26937 iter = 0
26938# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26939 do iix = 1, xrows
26940# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26941 do iiy = 1, yrows
26942# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26943 iter = iter + 1
26944# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26945 if (f == 1) then
26946# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26947 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
26948# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26949 else
26950# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26951 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
26952# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26953 end if
26954# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26955 if (ios /= 0) call s_mpi_abort("Error reading data")
26956# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26957 end do
26958# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26959 end do
26960# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26961 close (unit)
26962# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26963 end do
26964# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26965
26966# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26967 ! Calculate offsets
26968# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26969 x_step = x_cc(1) - x_cc(0)
26970# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26971 y_step = y_cc(1) - y_cc(0)
26972# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26973 delta_x = x_cc(index_x) - x_coords(1)
26974# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26975 delta_y = y_cc(index_y) - y_coords(1)
26976# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26977 global_offset_x = nint(abs(delta_x)/x_step)
26978# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26979 global_offset_y = nint(abs(delta_y)/y_step)
26980# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26981
26982# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26983 ! The index check below only catches overruns, so a file that is merely too
26984# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26985 ! FINE stays in range and silently supplies a corner of itself. Check spacing
26986# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26987 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
26988# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26989 ! consecutive x values sit yRows apart.
26990# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26991 if (nrows > yrows) then
26992# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26993 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
26994# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26995 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
26996# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26997 end if
26998# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
26999 if (yrows > 1) then
27000# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27001 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
27002# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27003 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
27004# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27005 end if
27006# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27007 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
27008# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27009 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
27010# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27011 & wp)) > 1.e-6_wp) &
27012# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27013 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
27014# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27015 end select
27016# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27017
27018# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27019 files_loaded = .true.
27020# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27021 end if
27022# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27023
27024# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27025 ! Data assignment
27026# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27027 select case (num_dims)
27028# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27029 case (1)
27030# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27031 idx = i + 1 + global_offset_x
27032# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27033 ! idx must land inside the file's row range: this rank's subdomain offset
27034# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27035 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
27036# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27037 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
27038# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27039 if (idx < 1 .or. idx > xrows) &
27040# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27041 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
27042# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27043 do f = 1, sys_size
27044# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27045 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
27046# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27047 end do
27048# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27049 case (2)
27050# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27051 idx = i + 1 + global_offset_x - index_x
27052# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27053 if (idx < 1 .or. idx > xrows) &
27054# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27055 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
27056# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27057 do f = 1, sys_size - 1
27058# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27059 jump = merge(1, 0, f >= eqn_idx%mom%end)
27060# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27061 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
27062# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27063 end do
27064# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27065 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
27066# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27067 case (3)
27068# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27069 idx = i + 1 + global_offset_x - index_x
27070# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27071 idy = j + 1 + global_offset_y - index_y
27072# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27073 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
27074# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27075 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
27076# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27077 do f = 1, sys_size - 1
27078# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27079 jump = merge(1, 0, f >= eqn_idx%mom%end)
27080# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27081 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
27082# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27083 end do
27084# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27085 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
27086# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27087 end select
27088# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27089 zlen371 = real(p_glb + 1, wp)*(z_cb(0) - z_cb(-1))
27090# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27091 kz371 = 2._wp*pi/zlen371
27092# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27093 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*(1._wp + 0.5_wp*cos(kz371*z_cc(k)))
27094# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27095 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.5_wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*sin(kz371*z_cc(k) + pi/3._wp)
27096# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27097 case (380) ! Taylor-Green vortex
27098# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27099 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
27100# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27101 ! geometry 9
27102# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27103 mach = 0.1
27104# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27105 if (patch_id == 1) then
27106# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27107 q_prim_vf(eqn_idx%E)%sf(i, j, &
27108# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27109 & 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)
27110# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27111 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)
27112# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27113 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)
27114# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27115 end if
27116# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27117 case default
27118# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27119 call s_int_to_str(patch_id, istr)
27120# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27121 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
27122# 994 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27123 end select
27124# 995 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27125 end if
27126 end if
27127 end do
27128 end do
27129 end do
27130 if (allocated(stored_values)) then
27131# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27132#ifdef MFC_DEBUG
27133# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27134 block
27135# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27136 use iso_fortran_env, only: output_unit
27137# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27138
27139# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27140 print *, 'm_icpp_patches.fpp:1000: ', '@:DEALLOCATE(stored_values)'
27141# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27142
27143# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27144 call flush (output_unit)
27145# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27146 end block
27147# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27148#endif
27149# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27150
27151# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27152#if defined(MFC_OpenACC)
27153# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27154!$acc exit data delete(stored_values)
27155# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27156#elif defined(MFC_OpenMP)
27157# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27158!$omp target exit data map(release:stored_values)
27159# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27160#endif
27161# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27162 deallocate (stored_values)
27163# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27164#ifdef MFC_DEBUG
27165# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27166 block
27167# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27168 use iso_fortran_env, only: output_unit
27169# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27170
27171# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27172 print *, 'm_icpp_patches.fpp:1000: ', '@:DEALLOCATE(x_coords)'
27173# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27174
27175# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27176 call flush (output_unit)
27177# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27178 end block
27179# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27180#endif
27181# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27182
27183# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27184#if defined(MFC_OpenACC)
27185# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27186!$acc exit data delete(x_coords)
27187# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27188#elif defined(MFC_OpenMP)
27189# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27190!$omp target exit data map(release:x_coords)
27191# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27192#endif
27193# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27194 deallocate (x_coords)
27195# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27196 end if
27197# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27198
27199# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27200 if (allocated(y_coords)) then
27201# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27202#ifdef MFC_DEBUG
27203# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27204 block
27205# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27206 use iso_fortran_env, only: output_unit
27207# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27208
27209# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27210 print *, 'm_icpp_patches.fpp:1000: ', '@:DEALLOCATE(y_coords)'
27211# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27212
27213# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27214 call flush (output_unit)
27215# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27216 end block
27217# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27218#endif
27219# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27220
27221# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27222#if defined(MFC_OpenACC)
27223# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27224!$acc exit data delete(y_coords)
27225# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27226#elif defined(MFC_OpenMP)
27227# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27228!$omp target exit data map(release:y_coords)
27229# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27230#endif
27231# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27232 deallocate (y_coords)
27233# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27234 end if
27235# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27236
27237# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27238 files_loaded = .false.
27239# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27240
27241# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27242 if (allocated(stored_values274)) then
27243# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27244#ifdef MFC_DEBUG
27245# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27246 block
27247# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27248 use iso_fortran_env, only: output_unit
27249# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27250
27251# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27252 print *, 'm_icpp_patches.fpp:1000: ', '@:DEALLOCATE(stored_values274)'
27253# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27254
27255# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27256 call flush (output_unit)
27257# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27258 end block
27259# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27260#endif
27261# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27262
27263# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27264#if defined(MFC_OpenACC)
27265# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27266!$acc exit data delete(stored_values274)
27267# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27268#elif defined(MFC_OpenMP)
27269# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27270!$omp target exit data map(release:stored_values274)
27271# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27272#endif
27273# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27274 deallocate (stored_values274)
27275# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27276 end if
27277# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27278
27279# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27280 files_loaded274 = .false.
27281# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27282
27283 end subroutine s_icpp_sphere
27284
27285 !> The cuboidal patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post-shock region,
27286 !! which is aligned with the axes of the Cartesian coordinate system. The geometry of such a patch is well- defined when its
27287 !! centroid and lengths in the x-, y- and z-coordinate directions are provided. Please notice that the cuboidal patch DOES NOT
27288 !! allow for the smearing of its boundaries.
27289 subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
27290
27291 integer, intent(in) :: patch_id
27292
27293#ifdef MFC_MIXED_PRECISION
27294 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
27295#else
27296 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
27297#endif
27298 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
27299 integer :: i, j, k !< Generic loop iterators
27300
27301 integer :: xRows, yRows, nRows, iix, iiy, max_files
27302# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27303 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
27304# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27305 real(wp) :: x_step, y_step
27306# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27307 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
27308# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27309 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
27310# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27311 real(wp) :: delta_x, delta_y
27312# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27313 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
27314# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27315 real(wp), allocatable :: stored_values(:,:,:)
27316# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27317 real(wp), allocatable :: x_coords(:), y_coords(:)
27318# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27319 logical :: files_loaded = .false.
27320# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27321 real(wp) :: domain_xstart
27322# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27323 character(len=20) :: file_num_str !< For storing the file number as a string
27324# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27325 integer :: ios
27326# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27327 integer :: ios2
27328# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27329
27330# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27331 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
27332# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27333 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
27334# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27335 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
27336# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27337 ! y_coords/files_loaded above.
27338# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27339 real(wp), allocatable, dimension(:,:,:) :: stored_values274
27340# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27341 logical :: files_loaded274 = .false.
27342# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27343 integer :: f274, ix274, iy274, unit274, ios274
27344# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27345 integer :: local_ix_beg274, local_iy_beg274
27346# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27347 character(len=300) :: fname274
27348# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27349 character(len=20) :: file_num_str274
27350# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27351 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
27352# 1020 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27353 real(wp) :: file_dx274, file_dy274, r_align274
27354# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27355 ! Place any declaration of intermediate variables here
27356# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27357 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
27358# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27359 real(wp) :: eps
27360# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27361 real(wp) :: zlen371, kz371
27362# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27363
27364# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27365 ! IGR Jets Arrays to stor position and radii of jets from input file
27366# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27367 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
27368# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27369 ! Variables to describe initial condition of jet
27370# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27371 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
27372# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27373 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
27374# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27375 real(wp), dimension(0:n,0:p) :: rcut_arr
27376# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27377 integer :: l, q, s !< Iterators for reading input files
27378# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27379 integer :: start, end !< Ints to keep track of position in file
27380# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27381 character(len=100000) :: line ! String to store line in file
27382# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27383 character(len=25) :: value !< String to store value in line
27384# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27385 integer :: NJet !< Number of jets
27386# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27387 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
27388# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27389 logical :: file_exist ! Flag to check if file exists
27390# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27391
27392# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27393 eps = 1e-9_wp
27394# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27395
27396# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27397 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
27398# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27399 eps_smooth = 3._wp
27400# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27401 inquire (file="njet.txt", exist=file_exist)
27402# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27403 if (file_exist) then
27404# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27405 open (unit=10, file="njet.txt", status="old", action="read")
27406# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27407 read (10, *) njet
27408# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27409 close (10)
27410# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27411 else
27412# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27413 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
27414# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27415 end if
27416# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27417
27418# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27419#ifdef MFC_DEBUG
27420# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27421 block
27422# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27423 use iso_fortran_env, only: output_unit
27424# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27425
27426# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27427 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
27428# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27429
27430# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27431 call flush (output_unit)
27432# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27433 end block
27434# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27435#endif
27436# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27437 allocate (y_th_arr(0:njet - 1))
27438# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27439
27440# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27441
27442# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27443#if defined(MFC_OpenACC)
27444# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27445!$acc enter data create(y_th_arr)
27446# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27447#elif defined(MFC_OpenMP)
27448# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27449!$omp target enter data map(always,alloc:y_th_arr)
27450# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27451#endif
27452# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27453#ifdef MFC_DEBUG
27454# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27455 block
27456# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27457 use iso_fortran_env, only: output_unit
27458# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27459
27460# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27461 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
27462# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27463
27464# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27465 call flush (output_unit)
27466# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27467 end block
27468# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27469#endif
27470# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27471 allocate (z_th_arr(0:njet - 1))
27472# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27473
27474# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27475
27476# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27477#if defined(MFC_OpenACC)
27478# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27479!$acc enter data create(z_th_arr)
27480# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27481#elif defined(MFC_OpenMP)
27482# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27483!$omp target enter data map(always,alloc:z_th_arr)
27484# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27485#endif
27486# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27487#ifdef MFC_DEBUG
27488# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27489 block
27490# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27491 use iso_fortran_env, only: output_unit
27492# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27493
27494# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27495 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
27496# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27497
27498# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27499 call flush (output_unit)
27500# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27501 end block
27502# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27503#endif
27504# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27505 allocate (r_th_arr(0:njet - 1))
27506# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27507
27508# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27509
27510# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27511#if defined(MFC_OpenACC)
27512# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27513!$acc enter data create(r_th_arr)
27514# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27515#elif defined(MFC_OpenMP)
27516# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27517!$omp target enter data map(always,alloc:r_th_arr)
27518# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27519#endif
27520# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27521
27522# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27523 inquire (file="jets.csv", exist=file_exist)
27524# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27525 if (file_exist) then
27526# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27527 open (unit=10, file="jets.csv", status="old", action="read")
27528# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27529 do q = 0, njet - 1
27530# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27531 read (10, '(A)') line ! Read a full line as a string
27532# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27533 start = 1
27534# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27535
27536# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27537 do l = 0, 2
27538# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27539 end = index(line(start:), ',') ! Find the next comma
27540# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27541 if (end == 0) then
27542# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27543 value = trim(adjustl(line(start:))) ! Last value in the line
27544# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27545 else
27546# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27547 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
27548# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27549 start = start + end ! Move to next value
27550# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27551 end if
27552# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27553 if (l == 0) then
27554# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27555 read (value, *) y_th_arr(q) ! Convert string to numeric value
27556# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27557 else if (l == 1) then
27558# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27559 read (value, *) z_th_arr(q)
27560# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27561 else
27562# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27563 read (value, *) r_th_arr(q)
27564# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27565 end if
27566# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27567 end do
27568# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27569 end do
27570# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27571 close (10)
27572# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27573
27574# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27575 do q = 0, p
27576# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27577 do l = 0, n
27578# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27579 rcut = 0._wp
27580# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27581 do s = 0, njet - 1
27582# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27583 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
27584# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27585 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
27586# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27587 end do
27588# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27589 rcut_arr(l, q) = rcut
27590# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27591 end do
27592# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27593 end do
27594# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27595 else
27596# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27597 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
27598# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27599 end if
27600# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27601 end if
27602# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27603
27604# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27605 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
27606# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27607#ifdef MFC_DEBUG
27608# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27609 block
27610# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27611 use iso_fortran_env, only: output_unit
27612# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27613
27614# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27615 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
27616# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27617
27618# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27619 call flush (output_unit)
27620# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27621 end block
27622# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27623#endif
27624# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27625 allocate (ih(0:n_glb, 0:p_glb))
27626# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27627
27628# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27629
27630# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27631#if defined(MFC_OpenACC)
27632# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27633!$acc enter data create(ih)
27634# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27635#elif defined(MFC_OpenMP)
27636# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27637!$omp target enter data map(always,alloc:ih)
27638# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27639#endif
27640# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27641
27642# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27643 if (interface_file == '.') then
27644# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27645 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
27646# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27647 else
27648# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27649 inquire (file=trim(interface_file), exist=file_exist)
27650# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27651 if (file_exist) then
27652# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27653 open (unit=10, file=trim(interface_file), status="old", action="read")
27654# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27655 do i = 0, n_glb
27656# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27657 read (10, '(A)') line ! Read a full line as a string
27658# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27659 start = 1
27660# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27661
27662# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27663 do j = 0, p_glb
27664# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27665 end = index(line(start:), ',') ! Find the next comma
27666# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27667 if (end == 0) then
27668# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27669 value = trim(adjustl(line(start:))) ! Last value in the line
27670# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27671 else
27672# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27673 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
27674# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27675 start = start + end ! Move to next value
27676# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27677 end if
27678# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27679 read (value, *) ih(i, j) ! Convert string to numeric value
27680# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27681 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
27682# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27683 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
27684# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27685 end do
27686# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27687 end do
27688# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27689 close (10)
27690# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27691 else
27692# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27693 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
27694# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27695 end if
27696# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27697 end if
27698# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27699 end if
27700# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27701
27702# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27703 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
27704# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27705#ifdef MFC_DEBUG
27706# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27707 block
27708# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27709 use iso_fortran_env, only: output_unit
27710# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27711
27712# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27713 print *, 'm_icpp_patches.fpp:1021: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
27714# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27715
27716# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27717 call flush (output_unit)
27718# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27719 end block
27720# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27721#endif
27722# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27723 allocate (ih(0:n_glb, 0:0))
27724# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27725
27726# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27727
27728# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27729#if defined(MFC_OpenACC)
27730# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27731!$acc enter data create(ih)
27732# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27733#elif defined(MFC_OpenMP)
27734# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27735!$omp target enter data map(always,alloc:ih)
27736# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27737#endif
27738# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27739 if (interface_file == '.') then
27740# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27741 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
27742# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27743 else
27744# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27745 inquire (file=trim(interface_file), exist=file_exist)
27746# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27747 if (file_exist) then
27748# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27749 open (unit=10, file=trim(interface_file), status="old", action="read")
27750# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27751 do i = 0, n_glb
27752# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27753 read (10, '(A)') line ! Read a full line as a string
27754# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27755 value = trim(line)
27756# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27757 read (value, *) ih(i, 0) ! Convert string to numeric value
27758# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27759 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
27760# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27761 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
27762# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27763 end do
27764# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27765 close (10)
27766# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27767 else
27768# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27769 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
27770# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27771 end if
27772# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27773 end if
27774# 1021 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27775 end if
27776# 1022 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27777
27778 ! Transferring the cuboid's centroid and length information
27779 x_centroid = patch_icpp(patch_id)%x_centroid
27780 y_centroid = patch_icpp(patch_id)%y_centroid
27781 z_centroid = patch_icpp(patch_id)%z_centroid
27782 length_x = patch_icpp(patch_id)%length_x
27783 length_y = patch_icpp(patch_id)%length_y
27784 length_z = patch_icpp(patch_id)%length_z
27785
27786 ! Computing the beginning and the end x-, y- and z-coordinates of the cuboid based on its centroid and lengths
27787 x_boundary%beg = x_centroid - 0.5_wp*length_x
27788 x_boundary%end = x_centroid + 0.5_wp*length_x
27789 y_boundary%beg = y_centroid - 0.5_wp*length_y
27790 y_boundary%end = y_centroid + 0.5_wp*length_y
27791 z_boundary%beg = z_centroid - 0.5_wp*length_z
27792 z_boundary%end = z_centroid + 0.5_wp*length_z
27793
27794 ! Set eta=1 (no smoothing for this patch type)
27795 eta = 1._wp
27796
27797 ! Assign patch vars if cell is covered and patch has write permission
27798 do k = 0, p
27799 do j = 0, n
27800 do i = 0, m
27801 if (grid_geometry == 3) then
27803 else
27804 cart_y = y_cc(j)
27805 cart_z = z_cc(k)
27806 end if
27807
27808 if (f_is_inside_cuboid(x_cc(i) - x_centroid, cart_y - y_centroid, cart_z - z_centroid, [length_x, length_y, &
27809 & length_z])) then
27810 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
27811 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
27812
27813
27814# 1059 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27815 if (patch_icpp(patch_id)%hcid /= dflt_int) then
27816 select case (patch_icpp(patch_id)%hcid)
27817# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27818 case (300) ! Rayleigh-Taylor instability
27819# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27820 rhoh = 3._wp
27821# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27822 rhol = 1._wp
27823# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27824 pref = 1.e5_wp
27825# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27826 pint = pref
27827# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27828 h = 0.7_wp
27829# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27830 lam = 0.2_wp
27831# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27832 wl = 2._wp*pi/lam
27833# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27834 amp = 0.025_wp/wl
27835# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27836
27837# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27838 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
27839# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27840
27841# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27842 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
27843# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27844
27845# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27846 if (alph < eps) alph = eps
27847# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27848 if (alph > 1._wp - eps) alph = 1._wp - eps
27849# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27850
27851# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27852 if (y_cc(j) > inth) then
27853# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27854 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
27855# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27856 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
27857# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27858 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
27859# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27860 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
27861# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27862 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
27863# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27864 else
27865# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27866 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
27867# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27868 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
27869# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27870 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
27871# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27872 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
27873# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27874 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
27875# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27876 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
27877# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27878 end if
27879# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27880 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
27881# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27882 h = 0.0_wp
27883# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27884 lam = 1.0_wp
27885# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27886 amp = patch_icpp(patch_id)%a(2)
27887# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27888 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
27889# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27890 if (x_cc(i) > inth) then
27891# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27892 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
27893# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27894 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
27895# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27896 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
27897# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27898 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
27899# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27900 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
27901# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27902 end if
27903# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27904 case (302) ! 3D Jet with IGR
27905# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27906 ux_th = 10*sqrt(1.4*0.4)
27907# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27908 ux_am = 0.0*sqrt(1.4)
27909# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27910 p_th = 2.0_wp
27911# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27912 p_am = 1.0_wp
27913# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27914 rho_th = 1._wp
27915# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27916 rho_am = 1._wp
27917# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27918 y_th = 0.0_wp
27919# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27920 z_th = 0.0_wp
27921# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27922 r_th = 1._wp
27923# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27924 eps_smooth = 1._wp
27925# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27926 eps = 1e-6
27927# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27928
27929# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27930 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
27931# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27932 rcut = f_cut_on(r - r_th, eps_smooth)
27933# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27934 xcut = f_cut_on(x_cc(i), eps_smooth)
27935# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27936
27937# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27938 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
27939# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27940 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
27941# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27942 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
27943# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27944
27945# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27946 if (num_fluids == 1) then
27947# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27948 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
27949# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27950 else
27951# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27952 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
27953# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27954 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
27955# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27956 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))
27957# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27958 end if
27959# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27960
27961# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27962 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
27963# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27964 case (303) ! 3D Multijet
27965# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27966 eps_smooth = 3.0_wp
27967# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27968 ux_th = 10*sqrt(1.4*0.4)
27969# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27970 ux_am = 2.5*sqrt(1.4*0.4)
27971# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27972 p_th = 0.8_wp
27973# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27974 p_am = 0.4_wp
27975# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27976 rho_th = 1._wp
27977# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27978 rho_am = 1._wp
27979# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27980 eps = 1e-6
27981# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27982
27983# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27984 rcut = rcut_arr(j, k)
27985# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27986 xcut = f_cut_on(x_cc(i), eps_smooth)
27987# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27988
27989# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27990 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
27991# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27992 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
27993# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27994 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
27995# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27996
27997# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
27998 if (num_fluids == 1) then
27999# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28000 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
28001# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28002 else
28003# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28004 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
28005# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28006 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
28007# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28008 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))
28009# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28010 end if
28011# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28012
28013# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28014 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
28015# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28016 case (304) ! 3D Interface from file cartesian
28017# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28018 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)))
28019# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28020
28021# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28022 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
28023# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28024 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
28025# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28026
28027# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28028 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)
28029# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28030 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)
28031# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28032
28033# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28034 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, &
28035# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28036 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
28037# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28038
28039# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28040 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
28041# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28042 case (305) ! 3D Interface from file axisymmetric
28043# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28044 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)))
28045# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28046
28047# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28048 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
28049# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28050 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
28051# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28052
28053# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28054 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
28055# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28056 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)
28057# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28058
28059# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28060 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, &
28061# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28062 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
28063# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28064
28065# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28066 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
28067# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28068 case (370) ! 3D extrusion of 2D profile from external data
28069# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28070 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
28071# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28072 if (.not. files_loaded) then
28073# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28074 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
28075# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28076 do f = 1, max_files
28077# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28078 write (file_num_str, '(I0)') f
28079# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28080 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
28081# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28082 end do
28083# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28084
28085# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28086 ! Common file reading setup
28087# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28088 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
28089# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28090 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
28091# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28092
28093# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28094 select case (num_dims)
28095# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28096 case (1, 2) ! 1D and 2D cases are similar
28097# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28098 ! Count lines
28099# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28100 line_count = 0
28101# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28102 do
28103# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28104 read (unit2, *, iostat=ios2) dummy_x, dummy_y
28105# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28106 if (ios2 /= 0) exit
28107# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28108 line_count = line_count + 1
28109# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28110 end do
28111# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28112 close (unit2)
28113# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28114
28115# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28116 xrows = line_count
28117# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28118 yrows = 1
28119# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28120 index_x = 0
28121# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28122 if (num_dims == 2) index_x = i
28123# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28124#ifdef MFC_DEBUG
28125# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28126 block
28127# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28128 use iso_fortran_env, only: output_unit
28129# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28130
28131# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28132 print *, 'm_icpp_patches.fpp:1060: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
28133# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28134
28135# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28136 call flush (output_unit)
28137# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28138 end block
28139# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28140#endif
28141# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28142 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
28143# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28144
28145# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28146
28147# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28148
28149# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28150#if defined(MFC_OpenACC)
28151# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28152!$acc enter data create(x_coords, stored_values)
28153# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28154#elif defined(MFC_OpenMP)
28155# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28156!$omp target enter data map(always,alloc:x_coords, stored_values)
28157# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28158#endif
28159# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28160
28161# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28162 ! Read data from all files
28163# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28164 do f = 1, max_files
28165# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28166 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
28167# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28168 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
28169# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28170
28171# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28172 do iter = 1, xrows
28173# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28174 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
28175# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28176 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
28177# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28178 end do
28179# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28180 close (unit)
28181# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28182 end do
28183# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28184
28185# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28186 ! Calculate offsets
28187# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28188 domain_xstart = x_coords(1)
28189# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28190 x_step = x_cc(1) - x_cc(0)
28191# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28192 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
28193# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28194 global_offset_x = nint(abs(delta_x)/x_step)
28195# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28196 case (3) ! 3D case - determine grid structure
28197# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28198 ! Find yRows by counting rows with same x
28199# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28200 read (unit2, *, iostat=ios2) x0, y0, dummy_z
28201# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28202 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
28203# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28204
28205# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28206 yrows = 1
28207# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28208 do
28209# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28210 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
28211# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28212 if (ios2 /= 0) exit
28213# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28214 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
28215# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28216 yrows = yrows + 1
28217# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28218 else
28219# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28220 exit
28221# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28222 end if
28223# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28224 end do
28225# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28226 close (unit2)
28227# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28228
28229# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28230 ! Count total rows
28231# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28232 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
28233# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28234 nrows = 0
28235# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28236 do
28237# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28238 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
28239# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28240 if (ios2 /= 0) exit
28241# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28242 nrows = nrows + 1
28243# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28244 end do
28245# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28246 close (unit2)
28247# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28248
28249# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28250 xrows = nrows/yrows
28251# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28252#ifdef MFC_DEBUG
28253# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28254 block
28255# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28256 use iso_fortran_env, only: output_unit
28257# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28258
28259# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28260 print *, 'm_icpp_patches.fpp:1060: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
28261# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28262
28263# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28264 call flush (output_unit)
28265# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28266 end block
28267# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28268#endif
28269# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28270 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
28271# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28272
28273# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28274
28275# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28276
28277# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28278
28279# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28280#if defined(MFC_OpenACC)
28281# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28282!$acc enter data create(x_coords, y_coords, stored_values)
28283# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28284#elif defined(MFC_OpenMP)
28285# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28286!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
28287# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28288#endif
28289# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28290 index_x = i
28291# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28292 index_y = j
28293# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28294
28295# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28296 ! Read all files
28297# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28298 do f = 1, max_files
28299# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28300 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
28301# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28302 if (ios /= 0) then
28303# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28304 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
28305# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28306 cycle
28307# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28308 end if
28309# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28310
28311# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28312 iter = 0
28313# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28314 do iix = 1, xrows
28315# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28316 do iiy = 1, yrows
28317# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28318 iter = iter + 1
28319# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28320 if (f == 1) then
28321# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28322 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
28323# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28324 else
28325# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28326 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
28327# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28328 end if
28329# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28330 if (ios /= 0) call s_mpi_abort("Error reading data")
28331# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28332 end do
28333# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28334 end do
28335# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28336 close (unit)
28337# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28338 end do
28339# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28340
28341# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28342 ! Calculate offsets
28343# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28344 x_step = x_cc(1) - x_cc(0)
28345# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28346 y_step = y_cc(1) - y_cc(0)
28347# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28348 delta_x = x_cc(index_x) - x_coords(1)
28349# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28350 delta_y = y_cc(index_y) - y_coords(1)
28351# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28352 global_offset_x = nint(abs(delta_x)/x_step)
28353# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28354 global_offset_y = nint(abs(delta_y)/y_step)
28355# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28356
28357# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28358 ! The index check below only catches overruns, so a file that is merely too
28359# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28360 ! FINE stays in range and silently supplies a corner of itself. Check spacing
28361# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28362 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
28363# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28364 ! consecutive x values sit yRows apart.
28365# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28366 if (nrows > yrows) then
28367# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28368 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
28369# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28370 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
28371# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28372 end if
28373# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28374 if (yrows > 1) then
28375# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28376 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
28377# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28378 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
28379# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28380 end if
28381# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28382 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
28383# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28384 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
28385# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28386 & wp)) > 1.e-6_wp) &
28387# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28388 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
28389# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28390 end select
28391# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28392
28393# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28394 files_loaded = .true.
28395# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28396 end if
28397# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28398
28399# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28400 ! Data assignment
28401# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28402 select case (num_dims)
28403# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28404 case (1)
28405# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28406 idx = i + 1 + global_offset_x
28407# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28408 ! idx must land inside the file's row range: this rank's subdomain offset
28409# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28410 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
28411# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28412 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
28413# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28414 if (idx < 1 .or. idx > xrows) &
28415# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28416 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
28417# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28418 do f = 1, sys_size
28419# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28420 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
28421# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28422 end do
28423# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28424 case (2)
28425# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28426 idx = i + 1 + global_offset_x - index_x
28427# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28428 if (idx < 1 .or. idx > xrows) &
28429# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28430 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
28431# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28432 do f = 1, sys_size - 1
28433# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28434 jump = merge(1, 0, f >= eqn_idx%mom%end)
28435# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28436 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
28437# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28438 end do
28439# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28440 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
28441# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28442 case (3)
28443# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28444 idx = i + 1 + global_offset_x - index_x
28445# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28446 idy = j + 1 + global_offset_y - index_y
28447# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28448 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
28449# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28450 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
28451# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28452 do f = 1, sys_size - 1
28453# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28454 jump = merge(1, 0, f >= eqn_idx%mom%end)
28455# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28456 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
28457# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28458 end do
28459# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28460 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
28461# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28462 end select
28463# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28464 case (371) ! hcid=370 + closed-form spanwise (z) modulation for genuine 3D content
28465# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28466 ! hcid=370's read extrudes the (x,y) file uniformly across z, leaving the flow
28467# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28468 ! z-invariant. Modulate the file's cross-stream (y) velocity by a z-dependent
28469# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28470 ! factor and set the spanwise (w) component from the result, so both inherit the
28471# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28472 ! file's shear-layer localization and amplitude scale. Streamwise (x) is left as
28473# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28474 ! read. This scales the whole y-velocity, which is the perturbation alone only
28475# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28476 ! when the base state has v == 0, as a temporal mixing layer does.
28477# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28478 !
28479# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28480 ! kz uses the GLOBAL z extent: p and z_cc(0:p) are per-rank under MPI, so a local
28481# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28482 ! extent would scale kz by num_procs_z and break periodicity at the z wrap.
28483# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28484 ! z_cc(k) is already absolute, so the phase needs no offset. Assumes uniform dz.
28485# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28486 if (.not. files_loaded) then
28487# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28488 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
28489# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28490 do f = 1, max_files
28491# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28492 write (file_num_str, '(I0)') f
28493# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28494 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
28495# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28496 end do
28497# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28498
28499# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28500 ! Common file reading setup
28501# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28502 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
28503# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28504 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
28505# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28506
28507# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28508 select case (num_dims)
28509# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28510 case (1, 2) ! 1D and 2D cases are similar
28511# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28512 ! Count lines
28513# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28514 line_count = 0
28515# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28516 do
28517# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28518 read (unit2, *, iostat=ios2) dummy_x, dummy_y
28519# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28520 if (ios2 /= 0) exit
28521# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28522 line_count = line_count + 1
28523# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28524 end do
28525# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28526 close (unit2)
28527# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28528
28529# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28530 xrows = line_count
28531# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28532 yrows = 1
28533# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28534 index_x = 0
28535# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28536 if (num_dims == 2) index_x = i
28537# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28538#ifdef MFC_DEBUG
28539# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28540 block
28541# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28542 use iso_fortran_env, only: output_unit
28543# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28544
28545# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28546 print *, 'm_icpp_patches.fpp:1060: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
28547# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28548
28549# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28550 call flush (output_unit)
28551# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28552 end block
28553# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28554#endif
28555# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28556 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
28557# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28558
28559# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28560
28561# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28562
28563# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28564#if defined(MFC_OpenACC)
28565# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28566!$acc enter data create(x_coords, stored_values)
28567# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28568#elif defined(MFC_OpenMP)
28569# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28570!$omp target enter data map(always,alloc:x_coords, stored_values)
28571# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28572#endif
28573# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28574
28575# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28576 ! Read data from all files
28577# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28578 do f = 1, max_files
28579# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28580 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
28581# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28582 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
28583# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28584
28585# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28586 do iter = 1, xrows
28587# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28588 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
28589# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28590 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
28591# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28592 end do
28593# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28594 close (unit)
28595# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28596 end do
28597# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28598
28599# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28600 ! Calculate offsets
28601# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28602 domain_xstart = x_coords(1)
28603# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28604 x_step = x_cc(1) - x_cc(0)
28605# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28606 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
28607# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28608 global_offset_x = nint(abs(delta_x)/x_step)
28609# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28610 case (3) ! 3D case - determine grid structure
28611# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28612 ! Find yRows by counting rows with same x
28613# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28614 read (unit2, *, iostat=ios2) x0, y0, dummy_z
28615# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28616 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
28617# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28618
28619# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28620 yrows = 1
28621# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28622 do
28623# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28624 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
28625# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28626 if (ios2 /= 0) exit
28627# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28628 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
28629# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28630 yrows = yrows + 1
28631# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28632 else
28633# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28634 exit
28635# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28636 end if
28637# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28638 end do
28639# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28640 close (unit2)
28641# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28642
28643# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28644 ! Count total rows
28645# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28646 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
28647# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28648 nrows = 0
28649# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28650 do
28651# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28652 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
28653# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28654 if (ios2 /= 0) exit
28655# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28656 nrows = nrows + 1
28657# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28658 end do
28659# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28660 close (unit2)
28661# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28662
28663# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28664 xrows = nrows/yrows
28665# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28666#ifdef MFC_DEBUG
28667# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28668 block
28669# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28670 use iso_fortran_env, only: output_unit
28671# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28672
28673# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28674 print *, 'm_icpp_patches.fpp:1060: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
28675# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28676
28677# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28678 call flush (output_unit)
28679# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28680 end block
28681# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28682#endif
28683# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28684 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
28685# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28686
28687# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28688
28689# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28690
28691# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28692
28693# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28694#if defined(MFC_OpenACC)
28695# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28696!$acc enter data create(x_coords, y_coords, stored_values)
28697# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28698#elif defined(MFC_OpenMP)
28699# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28700!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
28701# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28702#endif
28703# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28704 index_x = i
28705# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28706 index_y = j
28707# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28708
28709# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28710 ! Read all files
28711# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28712 do f = 1, max_files
28713# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28714 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
28715# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28716 if (ios /= 0) then
28717# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28718 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
28719# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28720 cycle
28721# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28722 end if
28723# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28724
28725# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28726 iter = 0
28727# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28728 do iix = 1, xrows
28729# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28730 do iiy = 1, yrows
28731# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28732 iter = iter + 1
28733# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28734 if (f == 1) then
28735# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28736 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
28737# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28738 else
28739# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28740 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
28741# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28742 end if
28743# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28744 if (ios /= 0) call s_mpi_abort("Error reading data")
28745# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28746 end do
28747# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28748 end do
28749# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28750 close (unit)
28751# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28752 end do
28753# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28754
28755# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28756 ! Calculate offsets
28757# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28758 x_step = x_cc(1) - x_cc(0)
28759# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28760 y_step = y_cc(1) - y_cc(0)
28761# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28762 delta_x = x_cc(index_x) - x_coords(1)
28763# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28764 delta_y = y_cc(index_y) - y_coords(1)
28765# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28766 global_offset_x = nint(abs(delta_x)/x_step)
28767# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28768 global_offset_y = nint(abs(delta_y)/y_step)
28769# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28770
28771# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28772 ! The index check below only catches overruns, so a file that is merely too
28773# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28774 ! FINE stays in range and silently supplies a corner of itself. Check spacing
28775# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28776 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
28777# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28778 ! consecutive x values sit yRows apart.
28779# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28780 if (nrows > yrows) then
28781# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28782 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
28783# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28784 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
28785# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28786 end if
28787# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28788 if (yrows > 1) then
28789# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28790 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
28791# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28792 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
28793# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28794 end if
28795# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28796 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
28797# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28798 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
28799# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28800 & wp)) > 1.e-6_wp) &
28801# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28802 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
28803# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28804 end select
28805# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28806
28807# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28808 files_loaded = .true.
28809# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28810 end if
28811# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28812
28813# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28814 ! Data assignment
28815# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28816 select case (num_dims)
28817# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28818 case (1)
28819# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28820 idx = i + 1 + global_offset_x
28821# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28822 ! idx must land inside the file's row range: this rank's subdomain offset
28823# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28824 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
28825# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28826 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
28827# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28828 if (idx < 1 .or. idx > xrows) &
28829# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28830 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
28831# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28832 do f = 1, sys_size
28833# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28834 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
28835# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28836 end do
28837# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28838 case (2)
28839# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28840 idx = i + 1 + global_offset_x - index_x
28841# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28842 if (idx < 1 .or. idx > xrows) &
28843# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28844 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
28845# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28846 do f = 1, sys_size - 1
28847# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28848 jump = merge(1, 0, f >= eqn_idx%mom%end)
28849# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28850 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
28851# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28852 end do
28853# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28854 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
28855# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28856 case (3)
28857# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28858 idx = i + 1 + global_offset_x - index_x
28859# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28860 idy = j + 1 + global_offset_y - index_y
28861# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28862 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
28863# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28864 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
28865# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28866 do f = 1, sys_size - 1
28867# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28868 jump = merge(1, 0, f >= eqn_idx%mom%end)
28869# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28870 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
28871# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28872 end do
28873# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28874 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
28875# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28876 end select
28877# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28878 zlen371 = real(p_glb + 1, wp)*(z_cb(0) - z_cb(-1))
28879# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28880 kz371 = 2._wp*pi/zlen371
28881# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28882 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*(1._wp + 0.5_wp*cos(kz371*z_cc(k)))
28883# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28884 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.5_wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*sin(kz371*z_cc(k) + pi/3._wp)
28885# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28886 case (380) ! Taylor-Green vortex
28887# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28888 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
28889# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28890 ! geometry 9
28891# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28892 mach = 0.1
28893# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28894 if (patch_id == 1) then
28895# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28896 q_prim_vf(eqn_idx%E)%sf(i, j, &
28897# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28898 & 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)
28899# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28900 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)
28901# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28902 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)
28903# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28904 end if
28905# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28906 case default
28907# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28908 call s_int_to_str(patch_id, istr)
28909# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28910 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
28911# 1060 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28912 end select
28913# 1061 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28914 end if
28915
28916 ! Updating the patch identities bookkeeping variable
28917 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
28918 end if
28919 end if
28920 end do
28921 end do
28922 end do
28923 if (allocated(stored_values)) then
28924# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28925#ifdef MFC_DEBUG
28926# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28927 block
28928# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28929 use iso_fortran_env, only: output_unit
28930# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28931
28932# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28933 print *, 'm_icpp_patches.fpp:1070: ', '@:DEALLOCATE(stored_values)'
28934# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28935
28936# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28937 call flush (output_unit)
28938# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28939 end block
28940# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28941#endif
28942# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28943
28944# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28945#if defined(MFC_OpenACC)
28946# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28947!$acc exit data delete(stored_values)
28948# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28949#elif defined(MFC_OpenMP)
28950# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28951!$omp target exit data map(release:stored_values)
28952# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28953#endif
28954# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28955 deallocate (stored_values)
28956# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28957#ifdef MFC_DEBUG
28958# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28959 block
28960# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28961 use iso_fortran_env, only: output_unit
28962# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28963
28964# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28965 print *, 'm_icpp_patches.fpp:1070: ', '@:DEALLOCATE(x_coords)'
28966# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28967
28968# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28969 call flush (output_unit)
28970# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28971 end block
28972# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28973#endif
28974# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28975
28976# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28977#if defined(MFC_OpenACC)
28978# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28979!$acc exit data delete(x_coords)
28980# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28981#elif defined(MFC_OpenMP)
28982# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28983!$omp target exit data map(release:x_coords)
28984# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28985#endif
28986# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28987 deallocate (x_coords)
28988# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28989 end if
28990# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28991
28992# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28993 if (allocated(y_coords)) then
28994# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28995#ifdef MFC_DEBUG
28996# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28997 block
28998# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
28999 use iso_fortran_env, only: output_unit
29000# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29001
29002# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29003 print *, 'm_icpp_patches.fpp:1070: ', '@:DEALLOCATE(y_coords)'
29004# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29005
29006# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29007 call flush (output_unit)
29008# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29009 end block
29010# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29011#endif
29012# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29013
29014# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29015#if defined(MFC_OpenACC)
29016# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29017!$acc exit data delete(y_coords)
29018# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29019#elif defined(MFC_OpenMP)
29020# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29021!$omp target exit data map(release:y_coords)
29022# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29023#endif
29024# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29025 deallocate (y_coords)
29026# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29027 end if
29028# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29029
29030# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29031 files_loaded = .false.
29032# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29033
29034# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29035 if (allocated(stored_values274)) then
29036# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29037#ifdef MFC_DEBUG
29038# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29039 block
29040# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29041 use iso_fortran_env, only: output_unit
29042# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29043
29044# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29045 print *, 'm_icpp_patches.fpp:1070: ', '@:DEALLOCATE(stored_values274)'
29046# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29047
29048# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29049 call flush (output_unit)
29050# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29051 end block
29052# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29053#endif
29054# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29055
29056# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29057#if defined(MFC_OpenACC)
29058# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29059!$acc exit data delete(stored_values274)
29060# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29061#elif defined(MFC_OpenMP)
29062# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29063!$omp target exit data map(release:stored_values274)
29064# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29065#endif
29066# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29067 deallocate (stored_values274)
29068# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29069 end if
29070# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29071
29072# 1070 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29073 files_loaded274 = .false.
29074# 1071 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29075
29076 end subroutine s_icpp_cuboid
29077
29078 !> The cylindrical patch is a 3D geometry that may be used, for example, in setting up a cylindrical solid boundary confinement,
29079 !! like a blood vessel. The geometry of this patch is well-defined when the centroid, the radius and the length along the
29080 !! cylinder's axis, parallel to the x-, y- or z-coordinate direction, are provided. Please note that the cylindrical patch DOES
29081 !! allow for the smoothing of its lateral boundary.
29082 subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
29083
29084 integer, intent(in) :: patch_id
29085
29086#ifdef MFC_MIXED_PRECISION
29087 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
29088#else
29089 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
29090#endif
29091 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
29092 integer :: i, j, k !< Generic loop iterators
29093 real(wp) :: radius
29094
29095 integer :: xRows, yRows, nRows, iix, iiy, max_files
29096# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29097 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
29098# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29099 real(wp) :: x_step, y_step
29100# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29101 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
29102# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29103 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
29104# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29105 real(wp) :: delta_x, delta_y
29106# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29107 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
29108# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29109 real(wp), allocatable :: stored_values(:,:,:)
29110# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29111 real(wp), allocatable :: x_coords(:), y_coords(:)
29112# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29113 logical :: files_loaded = .false.
29114# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29115 real(wp) :: domain_xstart
29116# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29117 character(len=20) :: file_num_str !< For storing the file number as a string
29118# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29119 integer :: ios
29120# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29121 integer :: ios2
29122# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29123
29124# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29125 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
29126# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29127 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
29128# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29129 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
29130# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29131 ! y_coords/files_loaded above.
29132# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29133 real(wp), allocatable, dimension(:,:,:) :: stored_values274
29134# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29135 logical :: files_loaded274 = .false.
29136# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29137 integer :: f274, ix274, iy274, unit274, ios274
29138# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29139 integer :: local_ix_beg274, local_iy_beg274
29140# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29141 character(len=300) :: fname274
29142# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29143 character(len=20) :: file_num_str274
29144# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29145 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
29146# 1091 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29147 real(wp) :: file_dx274, file_dy274, r_align274
29148# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29149 ! Place any declaration of intermediate variables here
29150# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29151 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
29152# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29153 real(wp) :: eps
29154# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29155 real(wp) :: zlen371, kz371
29156# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29157
29158# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29159 ! IGR Jets Arrays to stor position and radii of jets from input file
29160# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29161 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
29162# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29163 ! Variables to describe initial condition of jet
29164# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29165 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
29166# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29167 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
29168# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29169 real(wp), dimension(0:n,0:p) :: rcut_arr
29170# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29171 integer :: l, q, s !< Iterators for reading input files
29172# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29173 integer :: start, end !< Ints to keep track of position in file
29174# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29175 character(len=100000) :: line ! String to store line in file
29176# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29177 character(len=25) :: value !< String to store value in line
29178# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29179 integer :: NJet !< Number of jets
29180# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29181 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
29182# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29183 logical :: file_exist ! Flag to check if file exists
29184# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29185
29186# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29187 eps = 1e-9_wp
29188# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29189
29190# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29191 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
29192# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29193 eps_smooth = 3._wp
29194# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29195 inquire (file="njet.txt", exist=file_exist)
29196# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29197 if (file_exist) then
29198# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29199 open (unit=10, file="njet.txt", status="old", action="read")
29200# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29201 read (10, *) njet
29202# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29203 close (10)
29204# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29205 else
29206# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29207 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
29208# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29209 end if
29210# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29211
29212# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29213#ifdef MFC_DEBUG
29214# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29215 block
29216# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29217 use iso_fortran_env, only: output_unit
29218# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29219
29220# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29221 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
29222# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29223
29224# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29225 call flush (output_unit)
29226# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29227 end block
29228# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29229#endif
29230# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29231 allocate (y_th_arr(0:njet - 1))
29232# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29233
29234# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29235
29236# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29237#if defined(MFC_OpenACC)
29238# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29239!$acc enter data create(y_th_arr)
29240# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29241#elif defined(MFC_OpenMP)
29242# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29243!$omp target enter data map(always,alloc:y_th_arr)
29244# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29245#endif
29246# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29247#ifdef MFC_DEBUG
29248# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29249 block
29250# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29251 use iso_fortran_env, only: output_unit
29252# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29253
29254# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29255 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
29256# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29257
29258# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29259 call flush (output_unit)
29260# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29261 end block
29262# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29263#endif
29264# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29265 allocate (z_th_arr(0:njet - 1))
29266# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29267
29268# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29269
29270# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29271#if defined(MFC_OpenACC)
29272# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29273!$acc enter data create(z_th_arr)
29274# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29275#elif defined(MFC_OpenMP)
29276# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29277!$omp target enter data map(always,alloc:z_th_arr)
29278# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29279#endif
29280# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29281#ifdef MFC_DEBUG
29282# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29283 block
29284# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29285 use iso_fortran_env, only: output_unit
29286# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29287
29288# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29289 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
29290# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29291
29292# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29293 call flush (output_unit)
29294# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29295 end block
29296# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29297#endif
29298# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29299 allocate (r_th_arr(0:njet - 1))
29300# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29301
29302# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29303
29304# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29305#if defined(MFC_OpenACC)
29306# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29307!$acc enter data create(r_th_arr)
29308# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29309#elif defined(MFC_OpenMP)
29310# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29311!$omp target enter data map(always,alloc:r_th_arr)
29312# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29313#endif
29314# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29315
29316# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29317 inquire (file="jets.csv", exist=file_exist)
29318# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29319 if (file_exist) then
29320# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29321 open (unit=10, file="jets.csv", status="old", action="read")
29322# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29323 do q = 0, njet - 1
29324# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29325 read (10, '(A)') line ! Read a full line as a string
29326# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29327 start = 1
29328# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29329
29330# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29331 do l = 0, 2
29332# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29333 end = index(line(start:), ',') ! Find the next comma
29334# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29335 if (end == 0) then
29336# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29337 value = trim(adjustl(line(start:))) ! Last value in the line
29338# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29339 else
29340# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29341 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
29342# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29343 start = start + end ! Move to next value
29344# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29345 end if
29346# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29347 if (l == 0) then
29348# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29349 read (value, *) y_th_arr(q) ! Convert string to numeric value
29350# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29351 else if (l == 1) then
29352# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29353 read (value, *) z_th_arr(q)
29354# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29355 else
29356# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29357 read (value, *) r_th_arr(q)
29358# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29359 end if
29360# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29361 end do
29362# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29363 end do
29364# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29365 close (10)
29366# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29367
29368# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29369 do q = 0, p
29370# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29371 do l = 0, n
29372# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29373 rcut = 0._wp
29374# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29375 do s = 0, njet - 1
29376# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29377 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
29378# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29379 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
29380# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29381 end do
29382# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29383 rcut_arr(l, q) = rcut
29384# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29385 end do
29386# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29387 end do
29388# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29389 else
29390# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29391 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
29392# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29393 end if
29394# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29395 end if
29396# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29397
29398# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29399 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
29400# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29401#ifdef MFC_DEBUG
29402# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29403 block
29404# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29405 use iso_fortran_env, only: output_unit
29406# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29407
29408# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29409 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
29410# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29411
29412# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29413 call flush (output_unit)
29414# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29415 end block
29416# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29417#endif
29418# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29419 allocate (ih(0:n_glb, 0:p_glb))
29420# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29421
29422# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29423
29424# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29425#if defined(MFC_OpenACC)
29426# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29427!$acc enter data create(ih)
29428# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29429#elif defined(MFC_OpenMP)
29430# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29431!$omp target enter data map(always,alloc:ih)
29432# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29433#endif
29434# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29435
29436# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29437 if (interface_file == '.') then
29438# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29439 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
29440# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29441 else
29442# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29443 inquire (file=trim(interface_file), exist=file_exist)
29444# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29445 if (file_exist) then
29446# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29447 open (unit=10, file=trim(interface_file), status="old", action="read")
29448# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29449 do i = 0, n_glb
29450# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29451 read (10, '(A)') line ! Read a full line as a string
29452# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29453 start = 1
29454# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29455
29456# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29457 do j = 0, p_glb
29458# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29459 end = index(line(start:), ',') ! Find the next comma
29460# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29461 if (end == 0) then
29462# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29463 value = trim(adjustl(line(start:))) ! Last value in the line
29464# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29465 else
29466# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29467 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
29468# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29469 start = start + end ! Move to next value
29470# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29471 end if
29472# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29473 read (value, *) ih(i, j) ! Convert string to numeric value
29474# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29475 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
29476# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29477 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
29478# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29479 end do
29480# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29481 end do
29482# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29483 close (10)
29484# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29485 else
29486# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29487 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
29488# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29489 end if
29490# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29491 end if
29492# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29493 end if
29494# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29495
29496# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29497 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
29498# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29499#ifdef MFC_DEBUG
29500# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29501 block
29502# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29503 use iso_fortran_env, only: output_unit
29504# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29505
29506# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29507 print *, 'm_icpp_patches.fpp:1092: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
29508# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29509
29510# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29511 call flush (output_unit)
29512# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29513 end block
29514# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29515#endif
29516# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29517 allocate (ih(0:n_glb, 0:0))
29518# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29519
29520# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29521
29522# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29523#if defined(MFC_OpenACC)
29524# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29525!$acc enter data create(ih)
29526# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29527#elif defined(MFC_OpenMP)
29528# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29529!$omp target enter data map(always,alloc:ih)
29530# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29531#endif
29532# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29533 if (interface_file == '.') then
29534# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29535 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
29536# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29537 else
29538# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29539 inquire (file=trim(interface_file), exist=file_exist)
29540# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29541 if (file_exist) then
29542# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29543 open (unit=10, file=trim(interface_file), status="old", action="read")
29544# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29545 do i = 0, n_glb
29546# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29547 read (10, '(A)') line ! Read a full line as a string
29548# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29549 value = trim(line)
29550# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29551 read (value, *) ih(i, 0) ! Convert string to numeric value
29552# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29553 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
29554# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29555 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
29556# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29557 end do
29558# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29559 close (10)
29560# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29561 else
29562# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29563 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
29564# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29565 end if
29566# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29567 end if
29568# 1092 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29569 end if
29570# 1093 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29571
29572 ! Transferring the cylindrical patch's centroid, length, radius, smoothing patch identity and smoothing coefficient
29573 ! information
29574 x_centroid = patch_icpp(patch_id)%x_centroid
29575 y_centroid = patch_icpp(patch_id)%y_centroid
29576 z_centroid = patch_icpp(patch_id)%z_centroid
29577 length_x = patch_icpp(patch_id)%length_x
29578 length_y = patch_icpp(patch_id)%length_y
29579 length_z = patch_icpp(patch_id)%length_z
29580 radius = patch_icpp(patch_id)%radius
29581 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
29582 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
29583
29584 ! Computing the beginning and the end x-, y- and z-coordinates of the cylinder based on its centroid and lengths
29585 x_boundary%beg = x_centroid - 0.5_wp*length_x
29586 x_boundary%end = x_centroid + 0.5_wp*length_x
29587 y_boundary%beg = y_centroid - 0.5_wp*length_y
29588 y_boundary%end = y_centroid + 0.5_wp*length_y
29589 z_boundary%beg = z_centroid - 0.5_wp*length_z
29590 z_boundary%end = z_centroid + 0.5_wp*length_z
29591
29592 ! Initialize eta=1; modified if smoothing is enabled
29593 eta = 1._wp
29594
29595 ! Assign patch vars if cell is covered and patch has write permission
29596 do k = 0, p
29597 do j = 0, n
29598 do i = 0, m
29599 if (grid_geometry == 3) then
29601 else
29602 cart_y = y_cc(j)
29603 cart_z = z_cc(k)
29604 end if
29605
29606 if (patch_icpp(patch_id)%smoothen) then
29607 if (.not. f_is_default(length_x)) then
29608 eta = tanh(smooth_coeff/min(dy_min, &
29609 & dz_min)*(sqrt((cart_y - y_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
29610 & + 0.5_wp
29611 else if (.not. f_is_default(length_y)) then
29612 eta = tanh(smooth_coeff/min(dx_min, &
29613 & dz_min)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_z - z_centroid)**2) - radius))*(-0.5_wp) &
29614 & + 0.5_wp
29615 else
29616 eta = tanh(smooth_coeff/min(dx_min, &
29617 & dy_min)*(sqrt((x_cc(i) - x_centroid)**2 + (cart_y - y_centroid)**2) - radius))*(-0.5_wp) &
29618 & + 0.5_wp
29619 end if
29620 end if
29621
29622 if (((.not. f_is_default(length_x) .and. f_is_inside_cylinder(cart_y - y_centroid, cart_z - z_centroid, &
29623 & x_cc(i) - x_centroid, radius, &
29624 & length_x)) .or. (.not. f_is_default(length_y) .and. f_is_inside_cylinder(x_cc(i) - x_centroid, &
29625 & cart_z - z_centroid, cart_y - y_centroid, radius, &
29626 & length_y)) .or. (.not. f_is_default(length_z) .and. f_is_inside_cylinder(x_cc(i) - x_centroid, &
29627 & cart_y - y_centroid, cart_z - z_centroid, radius, &
29628 & length_z)) .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. patch_id_fp(i, j, &
29629 & k) == smooth_patch_id) then
29630 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
29631
29632
29633# 1155 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29634 if (patch_icpp(patch_id)%hcid /= dflt_int) then
29635 select case (patch_icpp(patch_id)%hcid)
29636# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29637 case (300) ! Rayleigh-Taylor instability
29638# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29639 rhoh = 3._wp
29640# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29641 rhol = 1._wp
29642# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29643 pref = 1.e5_wp
29644# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29645 pint = pref
29646# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29647 h = 0.7_wp
29648# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29649 lam = 0.2_wp
29650# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29651 wl = 2._wp*pi/lam
29652# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29653 amp = 0.025_wp/wl
29654# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29655
29656# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29657 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
29658# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29659
29660# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29661 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
29662# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29663
29664# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29665 if (alph < eps) alph = eps
29666# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29667 if (alph > 1._wp - eps) alph = 1._wp - eps
29668# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29669
29670# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29671 if (y_cc(j) > inth) then
29672# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29673 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
29674# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29675 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
29676# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29677 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
29678# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29679 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
29680# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29681 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
29682# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29683 else
29684# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29685 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
29686# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29687 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
29688# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29689 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
29690# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29691 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
29692# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29693 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
29694# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29695 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
29696# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29697 end if
29698# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29699 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
29700# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29701 h = 0.0_wp
29702# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29703 lam = 1.0_wp
29704# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29705 amp = patch_icpp(patch_id)%a(2)
29706# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29707 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
29708# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29709 if (x_cc(i) > inth) then
29710# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29711 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
29712# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29713 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
29714# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29715 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
29716# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29717 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
29718# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29719 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
29720# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29721 end if
29722# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29723 case (302) ! 3D Jet with IGR
29724# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29725 ux_th = 10*sqrt(1.4*0.4)
29726# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29727 ux_am = 0.0*sqrt(1.4)
29728# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29729 p_th = 2.0_wp
29730# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29731 p_am = 1.0_wp
29732# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29733 rho_th = 1._wp
29734# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29735 rho_am = 1._wp
29736# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29737 y_th = 0.0_wp
29738# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29739 z_th = 0.0_wp
29740# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29741 r_th = 1._wp
29742# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29743 eps_smooth = 1._wp
29744# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29745 eps = 1e-6
29746# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29747
29748# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29749 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
29750# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29751 rcut = f_cut_on(r - r_th, eps_smooth)
29752# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29753 xcut = f_cut_on(x_cc(i), eps_smooth)
29754# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29755
29756# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29757 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
29758# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29759 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
29760# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29761 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
29762# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29763
29764# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29765 if (num_fluids == 1) then
29766# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29767 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
29768# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29769 else
29770# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29771 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
29772# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29773 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
29774# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29775 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))
29776# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29777 end if
29778# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29779
29780# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29781 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
29782# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29783 case (303) ! 3D Multijet
29784# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29785 eps_smooth = 3.0_wp
29786# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29787 ux_th = 10*sqrt(1.4*0.4)
29788# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29789 ux_am = 2.5*sqrt(1.4*0.4)
29790# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29791 p_th = 0.8_wp
29792# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29793 p_am = 0.4_wp
29794# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29795 rho_th = 1._wp
29796# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29797 rho_am = 1._wp
29798# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29799 eps = 1e-6
29800# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29801
29802# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29803 rcut = rcut_arr(j, k)
29804# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29805 xcut = f_cut_on(x_cc(i), eps_smooth)
29806# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29807
29808# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29809 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
29810# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29811 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
29812# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29813 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
29814# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29815
29816# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29817 if (num_fluids == 1) then
29818# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29819 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
29820# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29821 else
29822# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29823 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
29824# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29825 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
29826# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29827 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))
29828# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29829 end if
29830# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29831
29832# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29833 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
29834# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29835 case (304) ! 3D Interface from file cartesian
29836# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29837 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)))
29838# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29839
29840# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29841 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
29842# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29843 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
29844# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29845
29846# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29847 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)
29848# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29849 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)
29850# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29851
29852# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29853 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, &
29854# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29855 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
29856# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29857
29858# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29859 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
29860# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29861 case (305) ! 3D Interface from file axisymmetric
29862# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29863 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)))
29864# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29865
29866# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29867 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
29868# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29869 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
29870# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29871
29872# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29873 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
29874# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29875 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)
29876# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29877
29878# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29879 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, &
29880# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29881 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
29882# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29883
29884# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29885 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
29886# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29887 case (370) ! 3D extrusion of 2D profile from external data
29888# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29889 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
29890# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29891 if (.not. files_loaded) then
29892# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29893 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
29894# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29895 do f = 1, max_files
29896# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29897 write (file_num_str, '(I0)') f
29898# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29899 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
29900# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29901 end do
29902# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29903
29904# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29905 ! Common file reading setup
29906# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29907 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
29908# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29909 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
29910# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29911
29912# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29913 select case (num_dims)
29914# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29915 case (1, 2) ! 1D and 2D cases are similar
29916# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29917 ! Count lines
29918# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29919 line_count = 0
29920# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29921 do
29922# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29923 read (unit2, *, iostat=ios2) dummy_x, dummy_y
29924# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29925 if (ios2 /= 0) exit
29926# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29927 line_count = line_count + 1
29928# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29929 end do
29930# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29931 close (unit2)
29932# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29933
29934# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29935 xrows = line_count
29936# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29937 yrows = 1
29938# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29939 index_x = 0
29940# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29941 if (num_dims == 2) index_x = i
29942# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29943#ifdef MFC_DEBUG
29944# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29945 block
29946# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29947 use iso_fortran_env, only: output_unit
29948# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29949
29950# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29951 print *, 'm_icpp_patches.fpp:1156: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
29952# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29953
29954# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29955 call flush (output_unit)
29956# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29957 end block
29958# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29959#endif
29960# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29961 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
29962# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29963
29964# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29965
29966# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29967
29968# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29969#if defined(MFC_OpenACC)
29970# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29971!$acc enter data create(x_coords, stored_values)
29972# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29973#elif defined(MFC_OpenMP)
29974# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29975!$omp target enter data map(always,alloc:x_coords, stored_values)
29976# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29977#endif
29978# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29979
29980# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29981 ! Read data from all files
29982# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29983 do f = 1, max_files
29984# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29985 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
29986# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29987 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
29988# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29989
29990# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29991 do iter = 1, xrows
29992# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29993 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
29994# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29995 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
29996# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29997 end do
29998# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
29999 close (unit)
30000# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30001 end do
30002# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30003
30004# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30005 ! Calculate offsets
30006# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30007 domain_xstart = x_coords(1)
30008# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30009 x_step = x_cc(1) - x_cc(0)
30010# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30011 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
30012# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30013 global_offset_x = nint(abs(delta_x)/x_step)
30014# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30015 case (3) ! 3D case - determine grid structure
30016# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30017 ! Find yRows by counting rows with same x
30018# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30019 read (unit2, *, iostat=ios2) x0, y0, dummy_z
30020# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30021 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
30022# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30023
30024# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30025 yrows = 1
30026# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30027 do
30028# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30029 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
30030# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30031 if (ios2 /= 0) exit
30032# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30033 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
30034# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30035 yrows = yrows + 1
30036# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30037 else
30038# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30039 exit
30040# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30041 end if
30042# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30043 end do
30044# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30045 close (unit2)
30046# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30047
30048# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30049 ! Count total rows
30050# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30051 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
30052# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30053 nrows = 0
30054# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30055 do
30056# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30057 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
30058# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30059 if (ios2 /= 0) exit
30060# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30061 nrows = nrows + 1
30062# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30063 end do
30064# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30065 close (unit2)
30066# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30067
30068# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30069 xrows = nrows/yrows
30070# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30071#ifdef MFC_DEBUG
30072# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30073 block
30074# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30075 use iso_fortran_env, only: output_unit
30076# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30077
30078# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30079 print *, 'm_icpp_patches.fpp:1156: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
30080# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30081
30082# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30083 call flush (output_unit)
30084# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30085 end block
30086# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30087#endif
30088# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30089 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
30090# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30091
30092# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30093
30094# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30095
30096# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30097
30098# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30099#if defined(MFC_OpenACC)
30100# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30101!$acc enter data create(x_coords, y_coords, stored_values)
30102# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30103#elif defined(MFC_OpenMP)
30104# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30105!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
30106# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30107#endif
30108# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30109 index_x = i
30110# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30111 index_y = j
30112# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30113
30114# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30115 ! Read all files
30116# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30117 do f = 1, max_files
30118# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30119 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
30120# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30121 if (ios /= 0) then
30122# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30123 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
30124# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30125 cycle
30126# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30127 end if
30128# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30129
30130# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30131 iter = 0
30132# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30133 do iix = 1, xrows
30134# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30135 do iiy = 1, yrows
30136# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30137 iter = iter + 1
30138# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30139 if (f == 1) then
30140# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30141 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
30142# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30143 else
30144# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30145 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
30146# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30147 end if
30148# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30149 if (ios /= 0) call s_mpi_abort("Error reading data")
30150# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30151 end do
30152# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30153 end do
30154# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30155 close (unit)
30156# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30157 end do
30158# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30159
30160# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30161 ! Calculate offsets
30162# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30163 x_step = x_cc(1) - x_cc(0)
30164# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30165 y_step = y_cc(1) - y_cc(0)
30166# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30167 delta_x = x_cc(index_x) - x_coords(1)
30168# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30169 delta_y = y_cc(index_y) - y_coords(1)
30170# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30171 global_offset_x = nint(abs(delta_x)/x_step)
30172# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30173 global_offset_y = nint(abs(delta_y)/y_step)
30174# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30175
30176# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30177 ! The index check below only catches overruns, so a file that is merely too
30178# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30179 ! FINE stays in range and silently supplies a corner of itself. Check spacing
30180# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30181 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
30182# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30183 ! consecutive x values sit yRows apart.
30184# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30185 if (nrows > yrows) then
30186# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30187 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
30188# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30189 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
30190# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30191 end if
30192# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30193 if (yrows > 1) then
30194# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30195 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
30196# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30197 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
30198# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30199 end if
30200# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30201 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
30202# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30203 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
30204# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30205 & wp)) > 1.e-6_wp) &
30206# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30207 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
30208# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30209 end select
30210# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30211
30212# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30213 files_loaded = .true.
30214# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30215 end if
30216# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30217
30218# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30219 ! Data assignment
30220# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30221 select case (num_dims)
30222# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30223 case (1)
30224# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30225 idx = i + 1 + global_offset_x
30226# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30227 ! idx must land inside the file's row range: this rank's subdomain offset
30228# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30229 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
30230# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30231 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
30232# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30233 if (idx < 1 .or. idx > xrows) &
30234# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30235 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
30236# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30237 do f = 1, sys_size
30238# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30239 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
30240# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30241 end do
30242# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30243 case (2)
30244# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30245 idx = i + 1 + global_offset_x - index_x
30246# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30247 if (idx < 1 .or. idx > xrows) &
30248# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30249 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
30250# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30251 do f = 1, sys_size - 1
30252# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30253 jump = merge(1, 0, f >= eqn_idx%mom%end)
30254# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30255 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
30256# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30257 end do
30258# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30259 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
30260# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30261 case (3)
30262# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30263 idx = i + 1 + global_offset_x - index_x
30264# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30265 idy = j + 1 + global_offset_y - index_y
30266# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30267 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
30268# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30269 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
30270# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30271 do f = 1, sys_size - 1
30272# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30273 jump = merge(1, 0, f >= eqn_idx%mom%end)
30274# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30275 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
30276# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30277 end do
30278# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30279 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
30280# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30281 end select
30282# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30283 case (371) ! hcid=370 + closed-form spanwise (z) modulation for genuine 3D content
30284# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30285 ! hcid=370's read extrudes the (x,y) file uniformly across z, leaving the flow
30286# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30287 ! z-invariant. Modulate the file's cross-stream (y) velocity by a z-dependent
30288# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30289 ! factor and set the spanwise (w) component from the result, so both inherit the
30290# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30291 ! file's shear-layer localization and amplitude scale. Streamwise (x) is left as
30292# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30293 ! read. This scales the whole y-velocity, which is the perturbation alone only
30294# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30295 ! when the base state has v == 0, as a temporal mixing layer does.
30296# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30297 !
30298# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30299 ! kz uses the GLOBAL z extent: p and z_cc(0:p) are per-rank under MPI, so a local
30300# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30301 ! extent would scale kz by num_procs_z and break periodicity at the z wrap.
30302# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30303 ! z_cc(k) is already absolute, so the phase needs no offset. Assumes uniform dz.
30304# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30305 if (.not. files_loaded) then
30306# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30307 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
30308# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30309 do f = 1, max_files
30310# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30311 write (file_num_str, '(I0)') f
30312# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30313 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
30314# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30315 end do
30316# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30317
30318# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30319 ! Common file reading setup
30320# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30321 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
30322# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30323 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
30324# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30325
30326# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30327 select case (num_dims)
30328# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30329 case (1, 2) ! 1D and 2D cases are similar
30330# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30331 ! Count lines
30332# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30333 line_count = 0
30334# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30335 do
30336# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30337 read (unit2, *, iostat=ios2) dummy_x, dummy_y
30338# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30339 if (ios2 /= 0) exit
30340# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30341 line_count = line_count + 1
30342# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30343 end do
30344# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30345 close (unit2)
30346# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30347
30348# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30349 xrows = line_count
30350# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30351 yrows = 1
30352# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30353 index_x = 0
30354# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30355 if (num_dims == 2) index_x = i
30356# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30357#ifdef MFC_DEBUG
30358# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30359 block
30360# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30361 use iso_fortran_env, only: output_unit
30362# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30363
30364# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30365 print *, 'm_icpp_patches.fpp:1156: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
30366# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30367
30368# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30369 call flush (output_unit)
30370# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30371 end block
30372# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30373#endif
30374# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30375 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
30376# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30377
30378# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30379
30380# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30381
30382# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30383#if defined(MFC_OpenACC)
30384# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30385!$acc enter data create(x_coords, stored_values)
30386# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30387#elif defined(MFC_OpenMP)
30388# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30389!$omp target enter data map(always,alloc:x_coords, stored_values)
30390# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30391#endif
30392# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30393
30394# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30395 ! Read data from all files
30396# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30397 do f = 1, max_files
30398# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30399 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
30400# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30401 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
30402# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30403
30404# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30405 do iter = 1, xrows
30406# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30407 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
30408# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30409 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
30410# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30411 end do
30412# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30413 close (unit)
30414# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30415 end do
30416# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30417
30418# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30419 ! Calculate offsets
30420# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30421 domain_xstart = x_coords(1)
30422# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30423 x_step = x_cc(1) - x_cc(0)
30424# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30425 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
30426# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30427 global_offset_x = nint(abs(delta_x)/x_step)
30428# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30429 case (3) ! 3D case - determine grid structure
30430# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30431 ! Find yRows by counting rows with same x
30432# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30433 read (unit2, *, iostat=ios2) x0, y0, dummy_z
30434# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30435 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
30436# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30437
30438# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30439 yrows = 1
30440# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30441 do
30442# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30443 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
30444# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30445 if (ios2 /= 0) exit
30446# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30447 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
30448# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30449 yrows = yrows + 1
30450# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30451 else
30452# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30453 exit
30454# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30455 end if
30456# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30457 end do
30458# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30459 close (unit2)
30460# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30461
30462# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30463 ! Count total rows
30464# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30465 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
30466# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30467 nrows = 0
30468# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30469 do
30470# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30471 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
30472# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30473 if (ios2 /= 0) exit
30474# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30475 nrows = nrows + 1
30476# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30477 end do
30478# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30479 close (unit2)
30480# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30481
30482# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30483 xrows = nrows/yrows
30484# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30485#ifdef MFC_DEBUG
30486# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30487 block
30488# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30489 use iso_fortran_env, only: output_unit
30490# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30491
30492# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30493 print *, 'm_icpp_patches.fpp:1156: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
30494# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30495
30496# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30497 call flush (output_unit)
30498# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30499 end block
30500# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30501#endif
30502# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30503 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
30504# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30505
30506# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30507
30508# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30509
30510# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30511
30512# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30513#if defined(MFC_OpenACC)
30514# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30515!$acc enter data create(x_coords, y_coords, stored_values)
30516# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30517#elif defined(MFC_OpenMP)
30518# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30519!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
30520# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30521#endif
30522# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30523 index_x = i
30524# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30525 index_y = j
30526# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30527
30528# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30529 ! Read all files
30530# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30531 do f = 1, max_files
30532# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30533 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
30534# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30535 if (ios /= 0) then
30536# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30537 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
30538# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30539 cycle
30540# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30541 end if
30542# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30543
30544# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30545 iter = 0
30546# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30547 do iix = 1, xrows
30548# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30549 do iiy = 1, yrows
30550# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30551 iter = iter + 1
30552# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30553 if (f == 1) then
30554# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30555 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
30556# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30557 else
30558# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30559 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
30560# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30561 end if
30562# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30563 if (ios /= 0) call s_mpi_abort("Error reading data")
30564# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30565 end do
30566# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30567 end do
30568# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30569 close (unit)
30570# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30571 end do
30572# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30573
30574# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30575 ! Calculate offsets
30576# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30577 x_step = x_cc(1) - x_cc(0)
30578# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30579 y_step = y_cc(1) - y_cc(0)
30580# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30581 delta_x = x_cc(index_x) - x_coords(1)
30582# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30583 delta_y = y_cc(index_y) - y_coords(1)
30584# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30585 global_offset_x = nint(abs(delta_x)/x_step)
30586# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30587 global_offset_y = nint(abs(delta_y)/y_step)
30588# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30589
30590# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30591 ! The index check below only catches overruns, so a file that is merely too
30592# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30593 ! FINE stays in range and silently supplies a corner of itself. Check spacing
30594# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30595 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
30596# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30597 ! consecutive x values sit yRows apart.
30598# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30599 if (nrows > yrows) then
30600# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30601 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
30602# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30603 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
30604# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30605 end if
30606# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30607 if (yrows > 1) then
30608# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30609 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
30610# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30611 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
30612# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30613 end if
30614# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30615 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
30616# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30617 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
30618# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30619 & wp)) > 1.e-6_wp) &
30620# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30621 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
30622# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30623 end select
30624# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30625
30626# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30627 files_loaded = .true.
30628# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30629 end if
30630# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30631
30632# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30633 ! Data assignment
30634# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30635 select case (num_dims)
30636# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30637 case (1)
30638# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30639 idx = i + 1 + global_offset_x
30640# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30641 ! idx must land inside the file's row range: this rank's subdomain offset
30642# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30643 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
30644# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30645 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
30646# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30647 if (idx < 1 .or. idx > xrows) &
30648# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30649 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
30650# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30651 do f = 1, sys_size
30652# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30653 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
30654# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30655 end do
30656# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30657 case (2)
30658# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30659 idx = i + 1 + global_offset_x - index_x
30660# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30661 if (idx < 1 .or. idx > xrows) &
30662# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30663 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
30664# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30665 do f = 1, sys_size - 1
30666# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30667 jump = merge(1, 0, f >= eqn_idx%mom%end)
30668# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30669 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
30670# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30671 end do
30672# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30673 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
30674# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30675 case (3)
30676# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30677 idx = i + 1 + global_offset_x - index_x
30678# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30679 idy = j + 1 + global_offset_y - index_y
30680# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30681 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
30682# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30683 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
30684# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30685 do f = 1, sys_size - 1
30686# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30687 jump = merge(1, 0, f >= eqn_idx%mom%end)
30688# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30689 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
30690# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30691 end do
30692# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30693 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
30694# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30695 end select
30696# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30697 zlen371 = real(p_glb + 1, wp)*(z_cb(0) - z_cb(-1))
30698# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30699 kz371 = 2._wp*pi/zlen371
30700# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30701 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*(1._wp + 0.5_wp*cos(kz371*z_cc(k)))
30702# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30703 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.5_wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*sin(kz371*z_cc(k) + pi/3._wp)
30704# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30705 case (380) ! Taylor-Green vortex
30706# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30707 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
30708# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30709 ! geometry 9
30710# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30711 mach = 0.1
30712# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30713 if (patch_id == 1) then
30714# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30715 q_prim_vf(eqn_idx%E)%sf(i, j, &
30716# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30717 & 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)
30718# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30719 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)
30720# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30721 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)
30722# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30723 end if
30724# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30725 case default
30726# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30727 call s_int_to_str(patch_id, istr)
30728# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30729 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
30730# 1156 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30731 end select
30732# 1157 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30733 end if
30734
30735 ! Updating the patch identities bookkeeping variable
30736 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
30737 end if
30738 end do
30739 end do
30740 end do
30741 if (allocated(stored_values)) then
30742# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30743#ifdef MFC_DEBUG
30744# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30745 block
30746# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30747 use iso_fortran_env, only: output_unit
30748# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30749
30750# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30751 print *, 'm_icpp_patches.fpp:1165: ', '@:DEALLOCATE(stored_values)'
30752# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30753
30754# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30755 call flush (output_unit)
30756# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30757 end block
30758# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30759#endif
30760# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30761
30762# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30763#if defined(MFC_OpenACC)
30764# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30765!$acc exit data delete(stored_values)
30766# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30767#elif defined(MFC_OpenMP)
30768# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30769!$omp target exit data map(release:stored_values)
30770# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30771#endif
30772# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30773 deallocate (stored_values)
30774# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30775#ifdef MFC_DEBUG
30776# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30777 block
30778# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30779 use iso_fortran_env, only: output_unit
30780# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30781
30782# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30783 print *, 'm_icpp_patches.fpp:1165: ', '@:DEALLOCATE(x_coords)'
30784# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30785
30786# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30787 call flush (output_unit)
30788# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30789 end block
30790# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30791#endif
30792# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30793
30794# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30795#if defined(MFC_OpenACC)
30796# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30797!$acc exit data delete(x_coords)
30798# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30799#elif defined(MFC_OpenMP)
30800# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30801!$omp target exit data map(release:x_coords)
30802# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30803#endif
30804# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30805 deallocate (x_coords)
30806# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30807 end if
30808# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30809
30810# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30811 if (allocated(y_coords)) then
30812# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30813#ifdef MFC_DEBUG
30814# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30815 block
30816# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30817 use iso_fortran_env, only: output_unit
30818# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30819
30820# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30821 print *, 'm_icpp_patches.fpp:1165: ', '@:DEALLOCATE(y_coords)'
30822# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30823
30824# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30825 call flush (output_unit)
30826# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30827 end block
30828# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30829#endif
30830# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30831
30832# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30833#if defined(MFC_OpenACC)
30834# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30835!$acc exit data delete(y_coords)
30836# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30837#elif defined(MFC_OpenMP)
30838# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30839!$omp target exit data map(release:y_coords)
30840# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30841#endif
30842# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30843 deallocate (y_coords)
30844# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30845 end if
30846# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30847
30848# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30849 files_loaded = .false.
30850# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30851
30852# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30853 if (allocated(stored_values274)) then
30854# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30855#ifdef MFC_DEBUG
30856# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30857 block
30858# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30859 use iso_fortran_env, only: output_unit
30860# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30861
30862# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30863 print *, 'm_icpp_patches.fpp:1165: ', '@:DEALLOCATE(stored_values274)'
30864# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30865
30866# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30867 call flush (output_unit)
30868# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30869 end block
30870# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30871#endif
30872# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30873
30874# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30875#if defined(MFC_OpenACC)
30876# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30877!$acc exit data delete(stored_values274)
30878# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30879#elif defined(MFC_OpenMP)
30880# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30881!$omp target exit data map(release:stored_values274)
30882# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30883#endif
30884# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30885 deallocate (stored_values274)
30886# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30887 end if
30888# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30889
30890# 1165 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30891 files_loaded274 = .false.
30892# 1166 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30893
30894 end subroutine s_icpp_cylinder
30895
30896 !> The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary, or pre-/post- shock
30897 !! region, at an angle with respect to the axes of the Cartesian coordinate system. The geometry of the patch is well-defined
30898 !! when its centroid and normal vector, aimed in the sweep direction, are provided. Note that the sweep plane patch DOES allow
30899 !! the smoothing of its boundary.
30900 subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
30901
30902 integer, intent(in) :: patch_id
30903
30904#ifdef MFC_MIXED_PRECISION
30905 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
30906#else
30907 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
30908#endif
30909 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
30910 integer :: i, j, k !< Generic loop iterators
30911 real(wp) :: a, b, c, d
30912
30913 integer :: xRows, yRows, nRows, iix, iiy, max_files
30914# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30915 integer :: f, iter, unit, unit2, idx, idy, index_x, index_y, jump, line_count
30916# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30917 real(wp) :: x_step, y_step
30918# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30919 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
30920# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30921 integer :: global_offset_x, global_offset_y !< MPI subdomain offset
30922# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30923 real(wp) :: delta_x, delta_y
30924# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30925 character(len=300), dimension(sys_size) :: fileNames !< Arrays to store all data from files
30926# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30927 real(wp), allocatable :: stored_values(:,:,:)
30928# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30929 real(wp), allocatable :: x_coords(:), y_coords(:)
30930# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30931 logical :: files_loaded = .false.
30932# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30933 real(wp) :: domain_xstart
30934# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30935 character(len=20) :: file_num_str !< For storing the file number as a string
30936# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30937 integer :: ios
30938# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30939 integer :: ios2
30940# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30941
30942# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30943 ! hcid=274 (2dHardcodedIC.fpp): full 2D field from external data, no extrusion.
30944# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30945 ! Declared here (not in Hardcoded2DVariables()) so it's visible wherever
30946# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30947 ! HardcodedDeallocation() is called, matching the pattern of stored_values/x_coords/
30948# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30949 ! y_coords/files_loaded above.
30950# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30951 real(wp), allocatable, dimension(:,:,:) :: stored_values274
30952# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30953 logical :: files_loaded274 = .false.
30954# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30955 integer :: f274, ix274, iy274, unit274, ios274
30956# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30957 integer :: local_ix_beg274, local_iy_beg274
30958# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30959 character(len=300) :: fname274
30960# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30961 character(len=20) :: file_num_str274
30962# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30963 real(wp) :: dummy_x274, dummy_y274, dummy_val274, x0_274, y0_274, x_step274, y_step274
30964# 1186 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30965 real(wp) :: file_dx274, file_dy274, r_align274
30966# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30967 ! Place any declaration of intermediate variables here
30968# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30969 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
30970# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30971 real(wp) :: eps
30972# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30973 real(wp) :: zlen371, kz371
30974# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30975
30976# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30977 ! IGR Jets Arrays to stor position and radii of jets from input file
30978# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30979 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
30980# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30981 ! Variables to describe initial condition of jet
30982# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30983 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
30984# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30985 real(wp) :: rcut, xcut !< Intermediate variables for creating smooth initial condition
30986# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30987 real(wp), dimension(0:n,0:p) :: rcut_arr
30988# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30989 integer :: l, q, s !< Iterators for reading input files
30990# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30991 integer :: start, end !< Ints to keep track of position in file
30992# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30993 character(len=100000) :: line ! String to store line in file
30994# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30995 character(len=25) :: value !< String to store value in line
30996# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30997 integer :: NJet !< Number of jets
30998# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
30999 real(wp), allocatable, dimension(:,:) :: ih ! Array to store interface height in
31000# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31001 logical :: file_exist ! Flag to check if file exists
31002# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31003
31004# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31005 eps = 1e-9_wp
31006# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31007
31008# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31009 if (patch_icpp(patch_id)%hcid == 303) then ! IGR Multijet
31010# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31011 eps_smooth = 3._wp
31012# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31013 inquire (file="njet.txt", exist=file_exist)
31014# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31015 if (file_exist) then
31016# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31017 open (unit=10, file="njet.txt", status="old", action="read")
31018# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31019 read (10, *) njet
31020# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31021 close (10)
31022# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31023 else
31024# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31025 call s_mpi_abort("Error: njet.txt file specified for hcid=303 does not exist")
31026# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31027 end if
31028# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31029
31030# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31031#ifdef MFC_DEBUG
31032# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31033 block
31034# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31035 use iso_fortran_env, only: output_unit
31036# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31037
31038# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31039 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(y_th_arr(0:NJet - 1))'
31040# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31041
31042# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31043 call flush (output_unit)
31044# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31045 end block
31046# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31047#endif
31048# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31049 allocate (y_th_arr(0:njet - 1))
31050# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31051
31052# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31053
31054# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31055#if defined(MFC_OpenACC)
31056# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31057!$acc enter data create(y_th_arr)
31058# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31059#elif defined(MFC_OpenMP)
31060# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31061!$omp target enter data map(always,alloc:y_th_arr)
31062# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31063#endif
31064# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31065#ifdef MFC_DEBUG
31066# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31067 block
31068# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31069 use iso_fortran_env, only: output_unit
31070# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31071
31072# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31073 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(z_th_arr(0:NJet - 1))'
31074# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31075
31076# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31077 call flush (output_unit)
31078# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31079 end block
31080# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31081#endif
31082# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31083 allocate (z_th_arr(0:njet - 1))
31084# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31085
31086# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31087
31088# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31089#if defined(MFC_OpenACC)
31090# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31091!$acc enter data create(z_th_arr)
31092# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31093#elif defined(MFC_OpenMP)
31094# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31095!$omp target enter data map(always,alloc:z_th_arr)
31096# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31097#endif
31098# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31099#ifdef MFC_DEBUG
31100# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31101 block
31102# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31103 use iso_fortran_env, only: output_unit
31104# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31105
31106# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31107 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(r_th_arr(0:NJet - 1))'
31108# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31109
31110# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31111 call flush (output_unit)
31112# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31113 end block
31114# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31115#endif
31116# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31117 allocate (r_th_arr(0:njet - 1))
31118# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31119
31120# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31121
31122# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31123#if defined(MFC_OpenACC)
31124# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31125!$acc enter data create(r_th_arr)
31126# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31127#elif defined(MFC_OpenMP)
31128# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31129!$omp target enter data map(always,alloc:r_th_arr)
31130# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31131#endif
31132# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31133
31134# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31135 inquire (file="jets.csv", exist=file_exist)
31136# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31137 if (file_exist) then
31138# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31139 open (unit=10, file="jets.csv", status="old", action="read")
31140# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31141 do q = 0, njet - 1
31142# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31143 read (10, '(A)') line ! Read a full line as a string
31144# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31145 start = 1
31146# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31147
31148# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31149 do l = 0, 2
31150# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31151 end = index(line(start:), ',') ! Find the next comma
31152# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31153 if (end == 0) then
31154# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31155 value = trim(adjustl(line(start:))) ! Last value in the line
31156# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31157 else
31158# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31159 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
31160# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31161 start = start + end ! Move to next value
31162# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31163 end if
31164# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31165 if (l == 0) then
31166# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31167 read (value, *) y_th_arr(q) ! Convert string to numeric value
31168# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31169 else if (l == 1) then
31170# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31171 read (value, *) z_th_arr(q)
31172# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31173 else
31174# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31175 read (value, *) r_th_arr(q)
31176# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31177 end if
31178# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31179 end do
31180# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31181 end do
31182# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31183 close (10)
31184# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31185
31186# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31187 do q = 0, p
31188# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31189 do l = 0, n
31190# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31191 rcut = 0._wp
31192# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31193 do s = 0, njet - 1
31194# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31195 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
31196# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31197 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
31198# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31199 end do
31200# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31201 rcut_arr(l, q) = rcut
31202# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31203 end do
31204# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31205 end do
31206# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31207 else
31208# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31209 call s_mpi_abort("Error: jets.csv file specified for hcid=303 does not exist")
31210# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31211 end if
31212# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31213 end if
31214# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31215
31216# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31217 if (patch_icpp(patch_id)%hcid == 304) then ! 3D Cartesian interface from file
31218# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31219#ifdef MFC_DEBUG
31220# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31221 block
31222# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31223 use iso_fortran_env, only: output_unit
31224# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31225
31226# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31227 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(ih(0:n_glb, 0:p_glb))'
31228# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31229
31230# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31231 call flush (output_unit)
31232# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31233 end block
31234# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31235#endif
31236# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31237 allocate (ih(0:n_glb, 0:p_glb))
31238# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31239
31240# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31241
31242# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31243#if defined(MFC_OpenACC)
31244# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31245!$acc enter data create(ih)
31246# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31247#elif defined(MFC_OpenMP)
31248# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31249!$omp target enter data map(always,alloc:ih)
31250# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31251#endif
31252# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31253
31254# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31255 if (interface_file == '.') then
31256# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31257 call s_mpi_abort("Error: interface_file must be specified for hcid=304")
31258# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31259 else
31260# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31261 inquire (file=trim(interface_file), exist=file_exist)
31262# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31263 if (file_exist) then
31264# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31265 open (unit=10, file=trim(interface_file), status="old", action="read")
31266# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31267 do i = 0, n_glb
31268# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31269 read (10, '(A)') line ! Read a full line as a string
31270# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31271 start = 1
31272# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31273
31274# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31275 do j = 0, p_glb
31276# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31277 end = index(line(start:), ',') ! Find the next comma
31278# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31279 if (end == 0) then
31280# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31281 value = trim(adjustl(line(start:))) ! Last value in the line
31282# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31283 else
31284# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31285 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
31286# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31287 start = start + end ! Move to next value
31288# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31289 end if
31290# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31291 read (value, *) ih(i, j) ! Convert string to numeric value
31292# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31293 if (.not. f_is_default(normmag)) ih(i, j) = ih(i, j)*normmag
31294# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31295 if (.not. f_is_default(normfac)) ih(i, j) = ih(i, j) + normfac
31296# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31297 end do
31298# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31299 end do
31300# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31301 close (10)
31302# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31303 else
31304# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31305 call s_mpi_abort("Error: interface_file specified for hcid=304 does not exist")
31306# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31307 end if
31308# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31309 end if
31310# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31311 end if
31312# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31313
31314# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31315 if (patch_icpp(patch_id)%hcid == 305) then ! 3D Axisymmetric interface from file
31316# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31317#ifdef MFC_DEBUG
31318# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31319 block
31320# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31321 use iso_fortran_env, only: output_unit
31322# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31323
31324# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31325 print *, 'm_icpp_patches.fpp:1187: ', '@:ALLOCATE(ih(0:n_glb, 0:0))'
31326# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31327
31328# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31329 call flush (output_unit)
31330# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31331 end block
31332# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31333#endif
31334# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31335 allocate (ih(0:n_glb, 0:0))
31336# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31337
31338# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31339
31340# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31341#if defined(MFC_OpenACC)
31342# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31343!$acc enter data create(ih)
31344# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31345#elif defined(MFC_OpenMP)
31346# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31347!$omp target enter data map(always,alloc:ih)
31348# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31349#endif
31350# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31351 if (interface_file == '.') then
31352# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31353 call s_mpi_abort("Error: interface_file must be specified for hcid=305")
31354# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31355 else
31356# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31357 inquire (file=trim(interface_file), exist=file_exist)
31358# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31359 if (file_exist) then
31360# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31361 open (unit=10, file=trim(interface_file), status="old", action="read")
31362# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31363 do i = 0, n_glb
31364# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31365 read (10, '(A)') line ! Read a full line as a string
31366# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31367 value = trim(line)
31368# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31369 read (value, *) ih(i, 0) ! Convert string to numeric value
31370# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31371 if (.not. f_is_default(normmag)) ih(i, 0) = ih(i, 0)*normmag
31372# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31373 if (.not. f_is_default(normfac)) ih(i, 0) = ih(i, 0) + normfac
31374# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31375 end do
31376# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31377 close (10)
31378# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31379 else
31380# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31381 call s_mpi_abort("Error: interface_file specified for hcid=305 does not exist")
31382# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31383 end if
31384# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31385 end if
31386# 1187 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31387 end if
31388# 1188 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31389
31390 ! Transferring the centroid information of the plane to be swept
31391 x_centroid = patch_icpp(patch_id)%x_centroid
31392 y_centroid = patch_icpp(patch_id)%y_centroid
31393 z_centroid = patch_icpp(patch_id)%z_centroid
31394 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
31395 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
31396
31397 ! Obtaining coefficients of the equation describing the sweep plane
31398 a = patch_icpp(patch_id)%normal(1)
31399 b = patch_icpp(patch_id)%normal(2)
31400 c = patch_icpp(patch_id)%normal(3)
31401 d = -a*x_centroid - b*y_centroid - c*z_centroid
31402
31403 ! Initialize eta=1; modified if smoothing is enabled
31404 eta = 1._wp
31405
31406 ! Assign patch vars if cell is covered and patch has write permission
31407 do k = 0, p
31408 do j = 0, n
31409 do i = 0, m
31410 if (grid_geometry == 3) then
31412 else
31413 cart_y = y_cc(j)
31414 cart_z = z_cc(k)
31415 end if
31416
31417 if (patch_icpp(patch_id)%smoothen) then
31418 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx_min, dy_min, &
31419 & dz_min)*(a*x_cc(i) + b*cart_y + c*cart_z + d)/sqrt(a**2 + b**2 + c**2))
31420 end if
31421
31422 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, &
31423 & k))) .or. patch_id_fp(i, j, k) == smooth_patch_id) then
31424 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
31425
31426
31427# 1226 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31428 if (patch_icpp(patch_id)%hcid /= dflt_int) then
31429 select case (patch_icpp(patch_id)%hcid)
31430# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31431 case (300) ! Rayleigh-Taylor instability
31432# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31433 rhoh = 3._wp
31434# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31435 rhol = 1._wp
31436# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31437 pref = 1.e5_wp
31438# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31439 pint = pref
31440# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31441 h = 0.7_wp
31442# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31443 lam = 0.2_wp
31444# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31445 wl = 2._wp*pi/lam
31446# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31447 amp = 0.025_wp/wl
31448# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31449
31450# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31451 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
31452# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31453
31454# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31455 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
31456# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31457
31458# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31459 if (alph < eps) alph = eps
31460# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31461 if (alph > 1._wp - eps) alph = 1._wp - eps
31462# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31463
31464# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31465 if (y_cc(j) > inth) then
31466# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31467 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
31468# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31469 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
31470# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31471 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
31472# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31473 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
31474# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31475 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
31476# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31477 else
31478# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31479 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
31480# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31481 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
31482# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31483 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = alph*rhoh
31484# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31485 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = (1._wp - alph)*rhol
31486# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31487 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
31488# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31489 q_prim_vf(eqn_idx%E)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
31490# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31491 end if
31492# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31493 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
31494# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31495 h = 0.0_wp
31496# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31497 lam = 1.0_wp
31498# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31499 amp = patch_icpp(patch_id)%a(2)
31500# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31501 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
31502# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31503 if (x_cc(i) > inth) then
31504# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31505 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
31506# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31507 q_prim_vf(eqn_idx%cont%end)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
31508# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31509 q_prim_vf(eqn_idx%E)%sf(i, j, k) = patch_icpp(1)%pres
31510# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31511 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = patch_icpp(1)%alpha(1)
31512# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31513 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = patch_icpp(1)%alpha(2)
31514# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31515 end if
31516# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31517 case (302) ! 3D Jet with IGR
31518# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31519 ux_th = 10*sqrt(1.4*0.4)
31520# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31521 ux_am = 0.0*sqrt(1.4)
31522# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31523 p_th = 2.0_wp
31524# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31525 p_am = 1.0_wp
31526# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31527 rho_th = 1._wp
31528# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31529 rho_am = 1._wp
31530# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31531 y_th = 0.0_wp
31532# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31533 z_th = 0.0_wp
31534# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31535 r_th = 1._wp
31536# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31537 eps_smooth = 1._wp
31538# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31539 eps = 1e-6
31540# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31541
31542# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31543 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
31544# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31545 rcut = f_cut_on(r - r_th, eps_smooth)
31546# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31547 xcut = f_cut_on(x_cc(i), eps_smooth)
31548# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31549
31550# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31551 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
31552# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31553 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
31554# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31555 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
31556# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31557
31558# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31559 if (num_fluids == 1) then
31560# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31561 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
31562# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31563 else
31564# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31565 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
31566# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31567 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
31568# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31569 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))
31570# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31571 end if
31572# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31573
31574# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31575 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
31576# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31577 case (303) ! 3D Multijet
31578# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31579 eps_smooth = 3.0_wp
31580# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31581 ux_th = 10*sqrt(1.4*0.4)
31582# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31583 ux_am = 2.5*sqrt(1.4*0.4)
31584# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31585 p_th = 0.8_wp
31586# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31587 p_am = 0.4_wp
31588# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31589 rho_th = 1._wp
31590# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31591 rho_am = 1._wp
31592# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31593 eps = 1e-6
31594# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31595
31596# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31597 rcut = rcut_arr(j, k)
31598# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31599 xcut = f_cut_on(x_cc(i), eps_smooth)
31600# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31601
31602# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31603 q_prim_vf(eqn_idx%mom%beg)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
31604# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31605 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = 0._wp
31606# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31607 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0._wp
31608# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31609
31610# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31611 if (num_fluids == 1) then
31612# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31613 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
31614# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31615 else
31616# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31617 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
31618# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31619 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = rho_th*q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)
31620# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31621 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))
31622# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31623 end if
31624# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31625
31626# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31627 q_prim_vf(eqn_idx%E)%sf(i, j, k) = p_th*rcut*xcut + p_am
31628# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31629 case (304) ! 3D Interface from file cartesian
31630# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31631 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)))
31632# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31633
31634# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31635 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
31636# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31637 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
31638# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31639
31640# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31641 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)
31642# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31643 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)
31644# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31645
31646# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31647 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, &
31648# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31649 & j, k))*g0_ic*(ih(start_idx(2) + j, start_idx(3) + k) - x_cc(i))
31650# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31651
31652# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31653 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
31654# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31655 case (305) ! 3D Interface from file axisymmetric
31656# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31657 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)))
31658# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31659
31660# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31661 q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k) = alph
31662# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31663 q_prim_vf(eqn_idx%adv%end)%sf(i, j, k) = 1._wp - alph
31664# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31665
31666# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31667 q_prim_vf(eqn_idx%cont%beg)%sf(i, j, k) = q_prim_vf(eqn_idx%adv%beg)%sf(i, j, k)*1._wp
31668# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31669 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)
31670# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31671
31672# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31673 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, &
31674# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31675 & j, k))*g0_ic*(ih(start_idx(1) + i, start_idx(3) + k) - y_cc(j))
31676# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31677
31678# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31679 if (surface_tension) q_prim_vf(eqn_idx%c)%sf(i, j, k) = alph
31680# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31681 case (370) ! 3D extrusion of 2D profile from external data
31682# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31683 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
31684# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31685 if (.not. files_loaded) then
31686# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31687 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
31688# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31689 do f = 1, max_files
31690# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31691 write (file_num_str, '(I0)') f
31692# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31693 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
31694# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31695 end do
31696# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31697
31698# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31699 ! Common file reading setup
31700# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31701 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
31702# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31703 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
31704# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31705
31706# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31707 select case (num_dims)
31708# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31709 case (1, 2) ! 1D and 2D cases are similar
31710# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31711 ! Count lines
31712# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31713 line_count = 0
31714# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31715 do
31716# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31717 read (unit2, *, iostat=ios2) dummy_x, dummy_y
31718# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31719 if (ios2 /= 0) exit
31720# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31721 line_count = line_count + 1
31722# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31723 end do
31724# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31725 close (unit2)
31726# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31727
31728# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31729 xrows = line_count
31730# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31731 yrows = 1
31732# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31733 index_x = 0
31734# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31735 if (num_dims == 2) index_x = i
31736# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31737#ifdef MFC_DEBUG
31738# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31739 block
31740# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31741 use iso_fortran_env, only: output_unit
31742# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31743
31744# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31745 print *, 'm_icpp_patches.fpp:1227: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
31746# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31747
31748# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31749 call flush (output_unit)
31750# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31751 end block
31752# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31753#endif
31754# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31755 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
31756# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31757
31758# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31759
31760# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31761
31762# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31763#if defined(MFC_OpenACC)
31764# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31765!$acc enter data create(x_coords, stored_values)
31766# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31767#elif defined(MFC_OpenMP)
31768# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31769!$omp target enter data map(always,alloc:x_coords, stored_values)
31770# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31771#endif
31772# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31773
31774# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31775 ! Read data from all files
31776# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31777 do f = 1, max_files
31778# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31779 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
31780# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31781 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
31782# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31783
31784# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31785 do iter = 1, xrows
31786# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31787 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
31788# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31789 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
31790# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31791 end do
31792# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31793 close (unit)
31794# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31795 end do
31796# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31797
31798# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31799 ! Calculate offsets
31800# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31801 domain_xstart = x_coords(1)
31802# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31803 x_step = x_cc(1) - x_cc(0)
31804# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31805 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
31806# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31807 global_offset_x = nint(abs(delta_x)/x_step)
31808# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31809 case (3) ! 3D case - determine grid structure
31810# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31811 ! Find yRows by counting rows with same x
31812# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31813 read (unit2, *, iostat=ios2) x0, y0, dummy_z
31814# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31815 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
31816# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31817
31818# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31819 yrows = 1
31820# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31821 do
31822# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31823 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
31824# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31825 if (ios2 /= 0) exit
31826# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31827 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
31828# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31829 yrows = yrows + 1
31830# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31831 else
31832# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31833 exit
31834# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31835 end if
31836# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31837 end do
31838# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31839 close (unit2)
31840# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31841
31842# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31843 ! Count total rows
31844# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31845 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
31846# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31847 nrows = 0
31848# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31849 do
31850# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31851 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
31852# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31853 if (ios2 /= 0) exit
31854# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31855 nrows = nrows + 1
31856# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31857 end do
31858# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31859 close (unit2)
31860# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31861
31862# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31863 xrows = nrows/yrows
31864# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31865#ifdef MFC_DEBUG
31866# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31867 block
31868# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31869 use iso_fortran_env, only: output_unit
31870# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31871
31872# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31873 print *, 'm_icpp_patches.fpp:1227: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
31874# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31875
31876# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31877 call flush (output_unit)
31878# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31879 end block
31880# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31881#endif
31882# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31883 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
31884# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31885
31886# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31887
31888# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31889
31890# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31891
31892# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31893#if defined(MFC_OpenACC)
31894# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31895!$acc enter data create(x_coords, y_coords, stored_values)
31896# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31897#elif defined(MFC_OpenMP)
31898# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31899!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
31900# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31901#endif
31902# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31903 index_x = i
31904# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31905 index_y = j
31906# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31907
31908# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31909 ! Read all files
31910# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31911 do f = 1, max_files
31912# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31913 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
31914# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31915 if (ios /= 0) then
31916# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31917 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
31918# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31919 cycle
31920# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31921 end if
31922# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31923
31924# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31925 iter = 0
31926# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31927 do iix = 1, xrows
31928# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31929 do iiy = 1, yrows
31930# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31931 iter = iter + 1
31932# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31933 if (f == 1) then
31934# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31935 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
31936# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31937 else
31938# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31939 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
31940# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31941 end if
31942# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31943 if (ios /= 0) call s_mpi_abort("Error reading data")
31944# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31945 end do
31946# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31947 end do
31948# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31949 close (unit)
31950# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31951 end do
31952# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31953
31954# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31955 ! Calculate offsets
31956# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31957 x_step = x_cc(1) - x_cc(0)
31958# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31959 y_step = y_cc(1) - y_cc(0)
31960# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31961 delta_x = x_cc(index_x) - x_coords(1)
31962# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31963 delta_y = y_cc(index_y) - y_coords(1)
31964# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31965 global_offset_x = nint(abs(delta_x)/x_step)
31966# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31967 global_offset_y = nint(abs(delta_y)/y_step)
31968# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31969
31970# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31971 ! The index check below only catches overruns, so a file that is merely too
31972# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31973 ! FINE stays in range and silently supplies a corner of itself. Check spacing
31974# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31975 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
31976# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31977 ! consecutive x values sit yRows apart.
31978# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31979 if (nrows > yrows) then
31980# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31981 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
31982# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31983 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
31984# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31985 end if
31986# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31987 if (yrows > 1) then
31988# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31989 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
31990# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31991 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
31992# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31993 end if
31994# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31995 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
31996# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31997 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
31998# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
31999 & wp)) > 1.e-6_wp) &
32000# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32001 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
32002# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32003 end select
32004# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32005
32006# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32007 files_loaded = .true.
32008# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32009 end if
32010# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32011
32012# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32013 ! Data assignment
32014# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32015 select case (num_dims)
32016# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32017 case (1)
32018# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32019 idx = i + 1 + global_offset_x
32020# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32021 ! idx must land inside the file's row range: this rank's subdomain offset
32022# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32023 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
32024# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32025 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
32026# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32027 if (idx < 1 .or. idx > xrows) &
32028# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32029 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
32030# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32031 do f = 1, sys_size
32032# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32033 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
32034# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32035 end do
32036# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32037 case (2)
32038# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32039 idx = i + 1 + global_offset_x - index_x
32040# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32041 if (idx < 1 .or. idx > xrows) &
32042# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32043 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
32044# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32045 do f = 1, sys_size - 1
32046# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32047 jump = merge(1, 0, f >= eqn_idx%mom%end)
32048# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32049 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
32050# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32051 end do
32052# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32053 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
32054# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32055 case (3)
32056# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32057 idx = i + 1 + global_offset_x - index_x
32058# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32059 idy = j + 1 + global_offset_y - index_y
32060# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32061 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
32062# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32063 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
32064# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32065 do f = 1, sys_size - 1
32066# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32067 jump = merge(1, 0, f >= eqn_idx%mom%end)
32068# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32069 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
32070# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32071 end do
32072# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32073 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
32074# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32075 end select
32076# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32077 case (371) ! hcid=370 + closed-form spanwise (z) modulation for genuine 3D content
32078# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32079 ! hcid=370's read extrudes the (x,y) file uniformly across z, leaving the flow
32080# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32081 ! z-invariant. Modulate the file's cross-stream (y) velocity by a z-dependent
32082# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32083 ! factor and set the spanwise (w) component from the result, so both inherit the
32084# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32085 ! file's shear-layer localization and amplitude scale. Streamwise (x) is left as
32086# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32087 ! read. This scales the whole y-velocity, which is the perturbation alone only
32088# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32089 ! when the base state has v == 0, as a temporal mixing layer does.
32090# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32091 !
32092# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32093 ! kz uses the GLOBAL z extent: p and z_cc(0:p) are per-rank under MPI, so a local
32094# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32095 ! extent would scale kz by num_procs_z and break periodicity at the z wrap.
32096# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32097 ! z_cc(k) is already absolute, so the phase needs no offset. Assumes uniform dz.
32098# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32099 if (.not. files_loaded) then
32100# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32101 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
32102# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32103 do f = 1, max_files
32104# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32105 write (file_num_str, '(I0)') f
32106# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32107 filenames(f) = trim(files_dir) // "/" // "prim." // trim(file_num_str) // ".00." // trim(file_extension) // ".dat"
32108# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32109 end do
32110# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32111
32112# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32113 ! Common file reading setup
32114# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32115 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
32116# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32117 if (ios2 /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(1)))
32118# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32119
32120# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32121 select case (num_dims)
32122# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32123 case (1, 2) ! 1D and 2D cases are similar
32124# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32125 ! Count lines
32126# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32127 line_count = 0
32128# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32129 do
32130# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32131 read (unit2, *, iostat=ios2) dummy_x, dummy_y
32132# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32133 if (ios2 /= 0) exit
32134# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32135 line_count = line_count + 1
32136# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32137 end do
32138# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32139 close (unit2)
32140# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32141
32142# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32143 xrows = line_count
32144# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32145 yrows = 1
32146# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32147 index_x = 0
32148# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32149 if (num_dims == 2) index_x = i
32150# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32151#ifdef MFC_DEBUG
32152# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32153 block
32154# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32155 use iso_fortran_env, only: output_unit
32156# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32157
32158# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32159 print *, 'm_icpp_patches.fpp:1227: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
32160# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32161
32162# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32163 call flush (output_unit)
32164# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32165 end block
32166# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32167#endif
32168# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32169 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
32170# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32171
32172# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32173
32174# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32175
32176# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32177#if defined(MFC_OpenACC)
32178# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32179!$acc enter data create(x_coords, stored_values)
32180# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32181#elif defined(MFC_OpenMP)
32182# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32183!$omp target enter data map(always,alloc:x_coords, stored_values)
32184# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32185#endif
32186# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32187
32188# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32189 ! Read data from all files
32190# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32191 do f = 1, max_files
32192# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32193 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
32194# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32195 if (ios /= 0) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
32196# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32197
32198# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32199 do iter = 1, xrows
32200# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32201 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
32202# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32203 if (ios /= 0) call s_mpi_abort("Error reading file: " // trim(filenames(f)))
32204# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32205 end do
32206# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32207 close (unit)
32208# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32209 end do
32210# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32211
32212# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32213 ! Calculate offsets
32214# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32215 domain_xstart = x_coords(1)
32216# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32217 x_step = x_cc(1) - x_cc(0)
32218# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32219 delta_x = merge(x_cc(0) - domain_xstart, x_cc(index_x) - domain_xstart, num_dims == 1)
32220# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32221 global_offset_x = nint(abs(delta_x)/x_step)
32222# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32223 case (3) ! 3D case - determine grid structure
32224# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32225 ! Find yRows by counting rows with same x
32226# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32227 read (unit2, *, iostat=ios2) x0, y0, dummy_z
32228# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32229 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
32230# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32231
32232# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32233 yrows = 1
32234# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32235 do
32236# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32237 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
32238# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32239 if (ios2 /= 0) exit
32240# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32241 if (f_approx_equal(dummy_x, x0) .and. (.not. f_approx_equal(dummy_y, y0))) then
32242# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32243 yrows = yrows + 1
32244# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32245 else
32246# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32247 exit
32248# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32249 end if
32250# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32251 end do
32252# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32253 close (unit2)
32254# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32255
32256# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32257 ! Count total rows
32258# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32259 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
32260# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32261 nrows = 0
32262# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32263 do
32264# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32265 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
32266# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32267 if (ios2 /= 0) exit
32268# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32269 nrows = nrows + 1
32270# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32271 end do
32272# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32273 close (unit2)
32274# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32275
32276# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32277 xrows = nrows/yrows
32278# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32279#ifdef MFC_DEBUG
32280# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32281 block
32282# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32283 use iso_fortran_env, only: output_unit
32284# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32285
32286# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32287 print *, 'm_icpp_patches.fpp:1227: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
32288# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32289
32290# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32291 call flush (output_unit)
32292# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32293 end block
32294# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32295#endif
32296# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32297 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
32298# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32299
32300# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32301
32302# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32303
32304# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32305
32306# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32307#if defined(MFC_OpenACC)
32308# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32309!$acc enter data create(x_coords, y_coords, stored_values)
32310# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32311#elif defined(MFC_OpenMP)
32312# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32313!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
32314# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32315#endif
32316# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32317 index_x = i
32318# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32319 index_y = j
32320# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32321
32322# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32323 ! Read all files
32324# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32325 do f = 1, max_files
32326# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32327 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
32328# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32329 if (ios /= 0) then
32330# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32331 if (f == 1) call s_mpi_abort("Error opening file: " // trim(filenames(f)))
32332# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32333 cycle
32334# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32335 end if
32336# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32337
32338# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32339 iter = 0
32340# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32341 do iix = 1, xrows
32342# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32343 do iiy = 1, yrows
32344# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32345 iter = iter + 1
32346# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32347 if (f == 1) then
32348# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32349 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
32350# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32351 else
32352# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32353 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
32354# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32355 end if
32356# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32357 if (ios /= 0) call s_mpi_abort("Error reading data")
32358# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32359 end do
32360# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32361 end do
32362# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32363 close (unit)
32364# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32365 end do
32366# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32367
32368# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32369 ! Calculate offsets
32370# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32371 x_step = x_cc(1) - x_cc(0)
32372# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32373 y_step = y_cc(1) - y_cc(0)
32374# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32375 delta_x = x_cc(index_x) - x_coords(1)
32376# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32377 delta_y = y_cc(index_y) - y_coords(1)
32378# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32379 global_offset_x = nint(abs(delta_x)/x_step)
32380# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32381 global_offset_y = nint(abs(delta_y)/y_step)
32382# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32383
32384# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32385 ! The index check below only catches overruns, so a file that is merely too
32386# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32387 ! FINE stays in range and silently supplies a corner of itself. Check spacing
32388# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32389 ! and alignment up front, as hcid=274 does. File order is x-major/y-minor, so
32390# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32391 ! consecutive x values sit yRows apart.
32392# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32393 if (nrows > yrows) then
32394# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32395 if (abs((x_coords(yrows + 1) - x_coords(1)) - x_step) > 1.e-6_wp*abs(x_step)) &
32396# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32397 & call s_mpi_abort("Hardcoded IC extrusion: file x-spacing does not match the run grid; regenerate the IC for this grid.")
32398# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32399 end if
32400# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32401 if (yrows > 1) then
32402# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32403 if (abs((y_coords(2) - y_coords(1)) - y_step) > 1.e-6_wp*abs(y_step)) &
32404# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32405 & call s_mpi_abort("Hardcoded IC extrusion: file y-spacing does not match the run grid; regenerate the IC for this grid.")
32406# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32407 end if
32408# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32409 if (abs(abs(delta_x)/x_step - real(global_offset_x, &
32410# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32411 & wp)) > 1.e-6_wp .or. abs(abs(delta_y)/y_step - real(global_offset_y, &
32412# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32413 & wp)) > 1.e-6_wp) &
32414# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32415 & call s_mpi_abort("Hardcoded IC extrusion: file grid is misaligned with the run grid; regenerate the IC for this grid.")
32416# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32417 end select
32418# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32419
32420# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32421 files_loaded = .true.
32422# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32423 end if
32424# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32425
32426# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32427 ! Data assignment
32428# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32429 select case (num_dims)
32430# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32431 case (1)
32432# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32433 idx = i + 1 + global_offset_x
32434# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32435 ! idx must land inside the file's row range: this rank's subdomain offset
32436# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32437 ! (global_offset_x) was derived from this rank's own grid, so a miss means the
32438# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32439 ! IC file is misaligned/mis-sized for the run grid, not a normal boundary case.
32440# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32441 if (idx < 1 .or. idx > xrows) &
32442# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32443 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
32444# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32445 do f = 1, sys_size
32446# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32447 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
32448# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32449 end do
32450# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32451 case (2)
32452# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32453 idx = i + 1 + global_offset_x - index_x
32454# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32455 if (idx < 1 .or. idx > xrows) &
32456# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32457 & call s_mpi_abort("Hardcoded IC extrusion: row index out of range (IC file misaligned with the run grid)")
32458# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32459 do f = 1, sys_size - 1
32460# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32461 jump = merge(1, 0, f >= eqn_idx%mom%end)
32462# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32463 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
32464# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32465 end do
32466# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32467 q_prim_vf(eqn_idx%mom%end)%sf(i, j, 0) = 0.0_wp
32468# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32469 case (3)
32470# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32471 idx = i + 1 + global_offset_x - index_x
32472# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32473 idy = j + 1 + global_offset_y - index_y
32474# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32475 if (idx < 1 .or. idx > xrows .or. idy < 1 .or. idy > yrows) &
32476# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32477 & call s_mpi_abort("Hardcoded IC extrusion: row/column index out of range (IC file misaligned with the run grid)")
32478# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32479 do f = 1, sys_size - 1
32480# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32481 jump = merge(1, 0, f >= eqn_idx%mom%end)
32482# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32483 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
32484# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32485 end do
32486# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32487 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.0_wp
32488# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32489 end select
32490# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32491 zlen371 = real(p_glb + 1, wp)*(z_cb(0) - z_cb(-1))
32492# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32493 kz371 = 2._wp*pi/zlen371
32494# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32495 q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k) = q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*(1._wp + 0.5_wp*cos(kz371*z_cc(k)))
32496# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32497 q_prim_vf(eqn_idx%mom%end)%sf(i, j, k) = 0.5_wp*q_prim_vf(eqn_idx%mom%beg + 1)%sf(i, j, k)*sin(kz371*z_cc(k) + pi/3._wp)
32498# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32499 case (380) ! Taylor-Green vortex
32500# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32501 ! This is patch is hard-coded for test suite optimization used in the 3D_TaylorGreenVortex case: This analytic patch used
32502# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32503 ! geometry 9
32504# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32505 mach = 0.1
32506# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32507 if (patch_id == 1) then
32508# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32509 q_prim_vf(eqn_idx%E)%sf(i, j, &
32510# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32511 & 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)
32512# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32513 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)
32514# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32515 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)
32516# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32517 end if
32518# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32519 case default
32520# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32521 call s_int_to_str(patch_id, istr)
32522# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32523 call s_mpi_abort("Invalid hcid specified for patch " // trim(istr))
32524# 1227 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32525 end select
32526# 1228 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32527 end if
32528
32529 ! Updating the patch identities bookkeeping variable
32530 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
32531 end if
32532 end do
32533 end do
32534 end do
32535 if (allocated(stored_values)) then
32536# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32537#ifdef MFC_DEBUG
32538# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32539 block
32540# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32541 use iso_fortran_env, only: output_unit
32542# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32543
32544# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32545 print *, 'm_icpp_patches.fpp:1236: ', '@:DEALLOCATE(stored_values)'
32546# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32547
32548# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32549 call flush (output_unit)
32550# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32551 end block
32552# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32553#endif
32554# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32555
32556# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32557#if defined(MFC_OpenACC)
32558# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32559!$acc exit data delete(stored_values)
32560# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32561#elif defined(MFC_OpenMP)
32562# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32563!$omp target exit data map(release:stored_values)
32564# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32565#endif
32566# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32567 deallocate (stored_values)
32568# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32569#ifdef MFC_DEBUG
32570# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32571 block
32572# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32573 use iso_fortran_env, only: output_unit
32574# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32575
32576# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32577 print *, 'm_icpp_patches.fpp:1236: ', '@:DEALLOCATE(x_coords)'
32578# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32579
32580# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32581 call flush (output_unit)
32582# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32583 end block
32584# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32585#endif
32586# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32587
32588# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32589#if defined(MFC_OpenACC)
32590# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32591!$acc exit data delete(x_coords)
32592# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32593#elif defined(MFC_OpenMP)
32594# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32595!$omp target exit data map(release:x_coords)
32596# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32597#endif
32598# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32599 deallocate (x_coords)
32600# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32601 end if
32602# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32603
32604# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32605 if (allocated(y_coords)) then
32606# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32607#ifdef MFC_DEBUG
32608# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32609 block
32610# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32611 use iso_fortran_env, only: output_unit
32612# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32613
32614# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32615 print *, 'm_icpp_patches.fpp:1236: ', '@:DEALLOCATE(y_coords)'
32616# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32617
32618# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32619 call flush (output_unit)
32620# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32621 end block
32622# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32623#endif
32624# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32625
32626# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32627#if defined(MFC_OpenACC)
32628# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32629!$acc exit data delete(y_coords)
32630# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32631#elif defined(MFC_OpenMP)
32632# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32633!$omp target exit data map(release:y_coords)
32634# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32635#endif
32636# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32637 deallocate (y_coords)
32638# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32639 end if
32640# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32641
32642# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32643 files_loaded = .false.
32644# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32645
32646# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32647 if (allocated(stored_values274)) then
32648# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32649#ifdef MFC_DEBUG
32650# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32651 block
32652# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32653 use iso_fortran_env, only: output_unit
32654# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32655
32656# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32657 print *, 'm_icpp_patches.fpp:1236: ', '@:DEALLOCATE(stored_values274)'
32658# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32659
32660# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32661 call flush (output_unit)
32662# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32663 end block
32664# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32665#endif
32666# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32667
32668# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32669#if defined(MFC_OpenACC)
32670# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32671!$acc exit data delete(stored_values274)
32672# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32673#elif defined(MFC_OpenMP)
32674# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32675!$omp target exit data map(release:stored_values274)
32676# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32677#endif
32678# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32679 deallocate (stored_values274)
32680# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32681 end if
32682# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32683
32684# 1236 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32685 files_loaded274 = .false.
32686# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32687
32688 end subroutine s_icpp_sweep_plane
32689
32690 !> The STL patch is a 2/3D geometry that is imported from an STL file.
32691 subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
32692
32693 integer, intent(in) :: patch_id
32694
32695#ifdef MFC_MIXED_PRECISION
32696 integer(kind=1), dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
32697#else
32698 integer, dimension(0:m,0:n,0:p), intent(inout) :: patch_id_fp
32699#endif
32700 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
32701 integer :: i, j, k !< loop iterators
32702 integer :: model_id !< Index into the preloading stl_models(:)
32703 real(wp) :: threshold !< Inside/outside cutoff for this model
32704 real(wp), dimension(1:3) :: point !< Cell-center query point
32705 logical :: in_box !< Whether the cell center lies in the model's bounding box
32706
32707 model_id = patch_icpp(patch_id)%model_id
32708 threshold = stl_models(model_id)%model_threshold
32709
32710 do i = 0, m; do j = 0, n; do k = 0, p
32711 point = (/x_cc(i), y_cc(j), 0._wp/)
32712 if (p > 0) point(3) = z_cc(k)
32713 if (grid_geometry == 3) point = f_convert_cyl_to_cart(point)
32714
32715 ! Run the winding test only on cells whose Cartesian point lies inside the bounding box, else skip the calculation
32716 in_box = point(1) >= stl_bounding_boxes(model_id, 1, 1) .and. point(1) <= stl_bounding_boxes(model_id, 1, &
32717 & 3) .and. point(2) >= stl_bounding_boxes(model_id, 2, &
32718 & 1) .and. point(2) <= stl_bounding_boxes(model_id, 2, 3)
32719 if (p > 0 .or. grid_geometry == 3) then
32720 in_box = in_box .and. point(3) >= stl_bounding_boxes(model_id, 3, &
32721 & 1) .and. point(3) <= stl_bounding_boxes(model_id, 3, 3)
32722 end if
32723
32724 if (in_box) then
32725 eta = f_model_is_inside(gpu_ntrs(model_id), model_id, point)
32726 else
32727 eta = 0._wp
32728 end if
32729
32730 if (eta > threshold) then
32731 eta = 1._wp
32732 else if (.not. patch_icpp(patch_id)%smoothen) then
32733 eta = 0._wp
32734 end if
32735
32736 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta, q_prim_vf, patch_id_fp)
32737
32738
32739# 1289 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32740 end do; end do; end do
32741
32742 end subroutine s_icpp_model
32743
32744 !> Convert cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
32746
32747
32748# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32749#if MFC_OpenACC
32750# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32751!$acc routine seq
32752# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32753#elif MFC_OpenMP
32754# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32755
32756# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32757
32758# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32759!$omp declare target device_type(any)
32760# 1296 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32761#endif
32762# 1297 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32763
32764 real(wp), intent(in) :: cyl_y, cyl_z
32765
32766 cart_y = cyl_y*sin(cyl_z)
32767 cart_z = cyl_y*cos(cyl_z)
32768
32770
32771 !> Return a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
32772 function f_convert_cyl_to_cart(cyl) result(cart)
32773
32774
32775# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32776#if MFC_OpenACC
32777# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32778!$acc routine seq
32779# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32780#elif MFC_OpenMP
32781# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32782
32783# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32784
32785# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32786!$omp declare target device_type(any)
32787# 1308 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32788#endif
32789# 1309 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32790
32791 real(wp), dimension(1:3), intent(in) :: cyl
32792 real(wp), dimension(1:3) :: cart
32793
32794 cart = (/cyl(1), cyl(2)*sin(cyl(3)), cyl(2)*cos(cyl(3))/)
32795
32796 end function f_convert_cyl_to_cart
32797
32798 !> Archimedes spiral function
32799 elemental function f_r(myth, offset, a)
32800
32801
32802# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32803#if MFC_OpenACC
32804# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32805!$acc routine seq
32806# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32807#elif MFC_OpenMP
32808# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32809
32810# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32811
32812# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32813!$omp declare target device_type(any)
32814# 1320 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32815#endif
32816# 1321 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
32817 real(wp), intent(in) :: myth, offset, a
32818 real(wp) :: b
32819 real(wp) :: f_r
32820
32821 ! r(th) = a + b*th
32822
32823 b = 2._wp*a/(2._wp*pi)
32824 f_r = a + b*myth + offset
32825
32826 end function f_r
32827
32828end 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).