MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_icpp_patches.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2!>
3!! @file
4!! @brief Contains module m_icpp_patches
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
7! This file exists so that Fypp can be run without generating case.fpp files for
8! each target. This is useful when generating documentation, for example. This
9! should also let MFC be built with CMake directly, without invoking mfc.sh.
10
11! For pre-process.
12# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
13
14! For moving immersed boundaries in simulation
15# 14 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
16# 6 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
17# 1 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp" 1
18!> @brief Allocate memory and read initial condition data for IC extrusion.
19!>
20!> @details
21!> This macro handles the complete initialization process for IC extrusion by:
22!>
23!> **Memory Allocation:**
24!> - stored_values(xRows, yRows, sys_size) - stores primitive variable data from files
25!> - x_coords(nrows) - stores x-coordinates from input files
26!> - y_coords(nrows) - stores y-coordinates from input files (3D case only)
27!>
28!> **File Reading Operations:**
29!> - Reads primitive variable data from multiple files with pattern:
30!> `prim.<file_number>.00.<timestep>.dat` where timestep uses `zeros_default` padding
31!> - Files are read from directory specified by `init_dir` parameter
32!> - Supports 1D, 2D, and 3D computational domains
33!>
34!> **Grid Structure Detection:**
35!> - 1D/2D: Counts lines in first file to determine xRows
36!> - 3D: Analyzes coordinate patterns to determine xRows and yRows structure
37!>
38!> **MPI Domain Mapping:**
39!> - Calculates global_offset_x and global_offset_y for MPI subdomain positioning
40!> - Maps file coordinates to local computational grid coordinates
41!>
42!> **Data Assignment:**
43!> - Populates q_prim_vf primitive variable arrays with file data
44!> - Handles momentum component indexing with special treatment for momxe
45!> - Sets momxe component to zero for 2D/3D cases
46!>
47!> **State Management:**
48!> - Uses files_loaded flag to prevent redundant file operations
49!> - Preserves data across multiple macro calls within same simulation
50!>
51!> @note File pattern uses `zeros_default` parameter (default: "000000") for timestep padding
52!> @note Directory path is hardcoded in `init_dir` parameter - modify as needed
53!> @warning Aborts execution if file reading errors occur.
54
55# 56 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
56
57# 199 "/home/runner/work/MFC/MFC/src/common/include/ExtrusionHardcodedIC.fpp"
58
59# 210 "/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# 67 "/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# 19 "/home/runner/work/MFC/MFC/src/common/include/2dHardcodedIC.fpp"
68
69# 343 "/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# 69 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
73
74# 198 "/home/runner/work/MFC/MFC/src/common/include/3dHardcodedIC.fpp"
75# 10 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
76# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
77# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
78# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
79# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
80# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
82# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
84
85# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
86# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
87# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
88
89# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
90
91# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
92
93# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
94
95# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
96
97# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
98
99# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
100
101# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
102! New line at end of file is required for FYPP
103# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
104# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
105# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
106# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
107# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
108# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
109# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
110# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
111
112# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
113# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
114# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
115
116# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
117
118# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
119
120# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
121
122# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
123
124# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
125
126# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
127
128# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
129! New line at end of file is required for FYPP
130# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
131
132# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151
152# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
153
154# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
155
156# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
157
158# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
159
160# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
161
162# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
163
164# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
165
166# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
167
168# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
169
170# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
171
172# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
173
174# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
175
176# 207 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
177
178# 232 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
179
180# 243 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
181
182# 245 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
183# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
184
185# 283 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
186
187# 293 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
188
189# 303 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
190
191# 312 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
192
193# 329 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
194
195# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
196
197# 346 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
198
199# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
200
201# 358 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
202
203# 364 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
204
205# 370 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
206
207# 376 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
208! New line at end of file is required for FYPP
209# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
210# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
211# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
212# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
213# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
214# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
215# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
216# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
217
218# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
219# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
220# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
221
222# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
223
224# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
225
226# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
227
228# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
229
230# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
231
232# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
233
234# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
235! New line at end of file is required for FYPP
236# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
237
238# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
239
240# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
241
242# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
243
244# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
245
246# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
247
248# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
249
250# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
251
252# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
253
254# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
255
256# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
257
258# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
259
260# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
261
262# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
263
264# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
265
266# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
267
268# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
269
270# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
271
272# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
273
274# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
275
276# 192 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
277
278# 213 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
279
280# 241 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
281
282# 256 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
283
284# 266 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
285
286# 275 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
287
288# 291 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
289
290# 301 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
291
292# 308 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
293! New line at end of file is required for FYPP
294# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
295
296# 21 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298# 37 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
299
300# 50 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
301
302# 76 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304# 91 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
305
306# 102 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
307
308# 115 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
311
312# 154 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
313
314# 165 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316# 176 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
317
318# 187 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
319
320# 198 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322# 208 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323
324# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
325
326# 220 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
327
328# 226 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
329
330# 232 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
331
332# 234 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
333# 235 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
334! New line at end of file is required for FYPP
335# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
336
337# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
338
339! Caution:
340! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
341! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
342! For an example see misc/nvidia_uvm/bind.sh.
343# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
344
345# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
346
347# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
352
353# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
354
355# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
356
357# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
358! New line at end of file is required for FYPP
359# 11 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
360
361!> @brief Constructs initial condition patch geometries (lines, circles, rectangles, spheres, etc.) on the grid
363
364 use m_model ! Subroutine(s) related to STL files
365
366 use m_derived_types ! Definitions of the derived types
367
368 use m_global_parameters !< definitions of the global parameters
369
370 use m_helper_basic !< functions to compare floating point numbers
371
372 use m_helper
373
374 use m_mpi_common
375
377
378 use m_mpi_common
379
381
382 implicit none
383
384 private; public :: s_apply_icpp_patches
385
388
390 real(wp) :: smooth_coeff !<
391 !! These variables are analogous in both meaning and use to the similarly
392 !! named components in the ic_patch_parameters type (see m_derived_types.f90
393 !! for additional details). They are employed as a means to more concisely
394 !! perform the actions necessary to lay out a particular patch on the grid.
395
396 real(wp) :: eta !<
397 !! In the case that smoothing of patch boundaries is enabled and the boundary
398 !! between two adjacent patches is to be smeared out, this variable's purpose
399 !! is to act as a pseudo volume fraction to indicate the contribution of each
400 !! patch toward the composition of a cell's fluid state.
401
402 real(wp) :: cart_x, cart_y, cart_z
403 real(wp) :: sph_phi !<
404 !! Variables to be used to hold cell locations in Cartesian coordinates if
405 !! 3D simulation is using cylindrical coordinates
406
408 !! These variables combine the centroid and length parameters associated with
409 !! a particular patch to yield the locations of the patch boundaries in the
410 !! x-, y- and z-coordinate directions. They are used as a means to concisely
411 !! perform the actions necessary to lay out a particular patch on the grid.
412
413 character(len=5) :: istr ! string to store int to string result for error checking
414
415contains
416
417 !> @brief Dispatches each initial condition patch to its geometry-specific initialization routine.
418 impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf)
419
420 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
421#ifdef MFC_MIXED_PRECISION
422 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
423#else
424 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
425#endif
426 integer :: i
427
428 ! 3D Patch Geometries
429 if (p > 0) then
430
431 do i = 1, num_patches
432
433 if (proc_rank == 0) then
434 print *, 'Processing patch', i
435 end if
436
437 !> ICPP Patches
438 !> @{
439 ! Spherical patch
440 if (patch_icpp(i)%geometry == 8) then
441 call s_icpp_sphere(i, patch_id_fp, q_prim_vf)
442 ! Cuboidal patch
443 elseif (patch_icpp(i)%geometry == 9) then
444 call s_icpp_cuboid(i, patch_id_fp, q_prim_vf)
445 ! Cylindrical patch
446 elseif (patch_icpp(i)%geometry == 10) then
447 call s_icpp_cylinder(i, patch_id_fp, q_prim_vf)
448 ! Swept plane patch
449 elseif (patch_icpp(i)%geometry == 11) then
450 call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf)
451 ! Ellipsoidal patch
452 elseif (patch_icpp(i)%geometry == 12) then
453 call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf)
454 ! Spherical harmonic patch
455 elseif (patch_icpp(i)%geometry == 14) then
456 call s_icpp_spherical_harmonic(i, patch_id_fp, q_prim_vf)
457 ! 3D Modified circular patch
458 elseif (patch_icpp(i)%geometry == 19) then
459 call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf)
460 ! 3D STL patch
461 elseif (patch_icpp(i)%geometry == 21) then
462 call s_icpp_model(i, patch_id_fp, q_prim_vf)
463 end if
464 end do
465 !> @}
466
467 ! 2D Patch Geometries
468 elseif (n > 0) then
469
470 do i = 1, num_patches
471
472 if (proc_rank == 0) then
473 print *, 'Processing patch', i
474 end if
475
476 !> ICPP Patches
477 !> @{
478 ! Circular patch
479 if (patch_icpp(i)%geometry == 2) then
480 call s_icpp_circle(i, patch_id_fp, q_prim_vf)
481 ! Rectangular patch
482 elseif (patch_icpp(i)%geometry == 3) then
483 call s_icpp_rectangle(i, patch_id_fp, q_prim_vf)
484 ! Swept line patch
485 elseif (patch_icpp(i)%geometry == 4) then
486 call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf)
487 ! Elliptical patch
488 elseif (patch_icpp(i)%geometry == 5) then
489 call s_icpp_ellipse(i, patch_id_fp, q_prim_vf)
490 ! Unimplemented patch (formerly isentropic vortex)
491 elseif (patch_icpp(i)%geometry == 6) then
492 call s_mpi_abort('This used to be the isentropic vortex patch, '// &
493 'which no longer exists. See Examples. Exiting.')
494 ! Spherical Harmonic Patch
495 elseif (patch_icpp(i)%geometry == 14) then
496 call s_icpp_spherical_harmonic(i, patch_id_fp, q_prim_vf)
497 ! Spiral patch
498 elseif (patch_icpp(i)%geometry == 17) then
499 call s_icpp_spiral(i, patch_id_fp, q_prim_vf)
500 ! Modified circular patch
501 elseif (patch_icpp(i)%geometry == 18) then
502 call s_icpp_varcircle(i, patch_id_fp, q_prim_vf)
503 ! TaylorGreen vortex patch
504 elseif (patch_icpp(i)%geometry == 20) then
505 call s_icpp_2d_taylorgreen_vortex(i, patch_id_fp, q_prim_vf)
506 ! STL patch
507 elseif (patch_icpp(i)%geometry == 21) then
508 call s_icpp_model(i, patch_id_fp, q_prim_vf)
509 end if
510 !> @}
511 end do
512
513 ! 1D Patch Geometries
514 else
515
516 do i = 1, num_patches
517
518 if (proc_rank == 0) then
519 print *, 'Processing patch', i
520 end if
521
522 ! Line segment patch
523 if (patch_icpp(i)%geometry == 1) then
524 call s_icpp_line_segment(i, patch_id_fp, q_prim_vf)
525 ! 1d analytical
526 elseif (patch_icpp(i)%geometry == 16) then
527 call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf)
528 end if
529 end do
530
531 end if
532
533 end subroutine s_apply_icpp_patches
534
535 !> The line segment patch is a 1D geometry that may be used,
536 !! for example, in creating a Riemann problem. The geometry
537 !! of the patch is well-defined when its centroid and length
538 !! in the x-coordinate direction are provided. Note that the
539 !! line segment patch DOES NOT allow for the smearing of its
540 !! boundaries.
541 !! @param patch_id patch identifier
542 !! @param patch_id_fp Array to track patch ids
543 !! @param q_prim_vf Array of primitive variables
544 subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
545
546 integer, intent(in) :: patch_id
547#ifdef MFC_MIXED_PRECISION
548 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
549#else
550 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
551#endif
552 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
553
554 ! Generic loop iterators
555 integer :: i, j, k
556
557 ! Placeholders for the cell boundary values
558 real(wp) :: pi_inf, gamma, lit_gamma
559 integer :: xRows, yRows, nRows, iix, iiy, max_files
560# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
561 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
562# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
563 real(wp) :: x_len, x_step, y_len, y_step
564# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
565 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
566# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
567 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
568# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
569 real(wp) :: delta_x, delta_y
570# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
571 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
572# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
573 character(len=200) :: errmsg
574# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
575 real(wp), allocatable :: stored_values(:, :, :)
576# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
577 real(wp), allocatable :: x_coords(:), y_coords(:)
578# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
579 logical :: files_loaded = .false.
580# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
581 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
582# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
583 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
584# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
585 character(len=20) :: file_num_str ! For storing the file number as a string
586# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
587 character(len=20) :: zeros_part ! For the trailing zeros part
588# 210 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
589 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
590 ! Place any declaration of intermediate variables here
591# 211 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
592 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
593
594 pi_inf = pi_infs(1)
595 gamma = gammas(1)
596 lit_gamma = gs_min(1)
597 j = 0
598 k = 0
599
600 ! Transferring the line segment's centroid and length information
601 x_centroid = patch_icpp(patch_id)%x_centroid
602 length_x = patch_icpp(patch_id)%length_x
603
604 ! Computing the beginning and end x-coordinates of the line segment
605 ! based on its centroid and length
606 x_boundary%beg = x_centroid - 0.5_wp*length_x
607 x_boundary%end = x_centroid + 0.5_wp*length_x
608
609 ! Since the line segment patch does not allow for its boundaries to
610 ! be smoothed out, the pseudo volume fraction is set to 1 to ensure
611 ! that only the current patch contributes to the fluid state in the
612 ! cells that this patch covers.
613 eta = 1._wp
614
615 ! Checking whether the line segment covers a particular cell in the
616 ! domain and verifying whether the current patch has the permission
617 ! to write to that cell. If both queries check out, the primitive
618 ! variables of the current patch are assigned to this cell.
619 do i = 0, m
620 if (x_boundary%beg <= x_cc(i) .and. &
621 x_boundary%end >= x_cc(i) .and. &
622 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, 0, 0))) then
623
624 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, &
625 eta, q_prim_vf, patch_id_fp)
626
627
628
629 ! check if this should load a hardcoded patch
630 if (patch_icpp(patch_id)%hcid /= dflt_int) then
631 select case (patch_icpp(patch_id)%hcid)
632# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
633 case (150) ! 1D Smooth Alfven Case for MHD
634# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
635 ! velocity
636# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
637 q_prim_vf(momxb + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
638# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
639 q_prim_vf(momxb + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
640# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
641
642# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
643 ! magnetic field
644# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
645 q_prim_vf(b_idx%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
646# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
647 q_prim_vf(b_idx%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
648# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
649
650# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
651 case (170)
652# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
653 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera, SDtoolbox)
654# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
655
656# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
657 if (.not. files_loaded) then
658# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
659 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
660# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
661 do f = 1, max_files
662# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
663 write (file_num_str, '(I0)') f
664# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
665 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
666# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
667 end do
668# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
669
670# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
671 ! Common file reading setup
672# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
673 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
674# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
675 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
676# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
677
678# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
679 select case (num_dims)
680# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
681 case (1, 2) ! 1D and 2D cases are similar
682# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
683 ! Count lines
684# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
685 line_count = 0
686# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
687 do
688# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
689 read (unit2, *, iostat=ios2) dummy_x, dummy_y
690# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
691 if (ios2 /= 0) exit
692# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
693 line_count = line_count + 1
694# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
695 end do
696# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
697 close (unit2)
698# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
699
700# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
701 xrows = line_count
702# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
703 yrows = 1
704# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
705 index_x = 0
706# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
707 if (num_dims == 2) index_x = i
708# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
709#ifdef MFC_DEBUG
710# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
711 block
712# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
713 use iso_fortran_env, only: output_unit
714# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
715
716# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
717 print *, 'm_icpp_patches.fpp:250: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
718# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
719
720# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
721 call flush (output_unit)
722# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
723 end block
724# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
725#endif
726# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
727 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
728# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
729
730# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
731
732# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
733
734# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
735#if defined(MFC_OpenACC)
736# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
737!$acc enter data create(x_coords, stored_values)
738# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
739#elif defined(MFC_OpenMP)
740# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
741!$omp target enter data map(always,alloc:x_coords, stored_values)
742# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
743#endif
744# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
745
746# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
747 ! Read data from all files
748# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
749 do f = 1, max_files
750# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
751 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
752# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
753 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
754# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
755
756# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
757 do iter = 1, xrows
758# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
759 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
760# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
761 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
762# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
763 end do
764# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
765 close (unit)
766# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
767 end do
768# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
769
770# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
771 ! Calculate offsets
772# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
773 domain_xstart = x_coords(1)
774# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
775 x_step = x_cc(1) - x_cc(0)
776# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
777 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
778# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
779 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
780# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
781 global_offset_x = nint(abs(delta_x)/x_step)
782# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
783
784# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
785 case (3) ! 3D case - determine grid structure
786# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
787 ! Find yRows by counting rows with same x
788# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
789 read (unit2, *, iostat=ios2) x0, y0, dummy_z
790# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
791 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
792# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
793
794# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
795 yrows = 1
796# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
797 do
798# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
799 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
800# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
801 if (ios2 /= 0) exit
802# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
803 if (dummy_x == x0 .and. dummy_y /= y0) then
804# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
805 yrows = yrows + 1
806# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
807 else
808# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
809 exit
810# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
811 end if
812# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
813 end do
814# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
815 close (unit2)
816# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
817
818# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
819 ! Count total rows
820# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
821 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
822# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
823 nrows = 0
824# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
825 do
826# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
827 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
828# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
829 if (ios2 /= 0) exit
830# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
831 nrows = nrows + 1
832# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
833 end do
834# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
835 close (unit2)
836# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
837
838# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
839 xrows = nrows/yrows
840# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
841#ifdef MFC_DEBUG
842# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
843 block
844# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
845 use iso_fortran_env, only: output_unit
846# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
847
848# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
849 print *, 'm_icpp_patches.fpp:250: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
850# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
851
852# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
853 call flush (output_unit)
854# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
855 end block
856# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
857#endif
858# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
859 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
860# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
861
862# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
863
864# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
865
866# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
867
868# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
869#if defined(MFC_OpenACC)
870# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
871!$acc enter data create(x_coords, y_coords, stored_values)
872# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
873#elif defined(MFC_OpenMP)
874# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
875!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
876# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
877#endif
878# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
879 index_x = i
880# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
881 index_y = j
882# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
883
884# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
885 ! Read all files
886# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
887 do f = 1, max_files
888# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
889 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
890# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
891 if (ios /= 0) then
892# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
893 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
894# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
895 cycle
896# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
897 end if
898# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
899
900# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
901 iter = 0
902# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
903 do iix = 1, xrows
904# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
905 do iiy = 1, yrows
906# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
907 iter = iter + 1
908# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
909 if (f == 1) then
910# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
911 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
912# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
913 else
914# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
915 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
916# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
917 end if
918# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
919 if (ios /= 0) call s_mpi_abort("Error reading data")
920# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
921 end do
922# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
923 end do
924# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
925 close (unit)
926# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
927 end do
928# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
929
930# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
931 ! Calculate offsets
932# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
933 x_step = x_cc(1) - x_cc(0)
934# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
935 y_step = y_cc(1) - y_cc(0)
936# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
937 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
938# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
939 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
940# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
941 global_offset_x = nint(abs(delta_x)/x_step)
942# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
943 global_offset_y = nint(abs(delta_y)/y_step)
944# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
945 end select
946# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
947
948# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
949 files_loaded = .true.
950# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
951 end if
952# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
953
954# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
955 ! Data assignment
956# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
957 select case (num_dims)
958# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
959 case (1)
960# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
961 idx = i + 1 + global_offset_x
962# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
963 do f = 1, sys_size
964# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
965 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
966# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
967 end do
968# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
969
970# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
971 case (2)
972# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
973 idx = i + 1 + global_offset_x - index_x
974# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
975 do f = 1, sys_size - 1
976# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
977 jump = merge(1, 0, f >= momxe)
978# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
979 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
980# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
981 end do
982# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
983 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
984# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
985
986# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
987 case (3)
988# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
989 idx = i + 1 + global_offset_x - index_x
990# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
991 idy = j + 1 + global_offset_y - index_y
992# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
993 do f = 1, sys_size - 1
994# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
995 jump = merge(1, 0, f >= momxe)
996# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
997 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
998# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
999 end do
1000# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1001 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
1002# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1003 end select
1004# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1005
1006# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1007 case (180)
1008# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1009 ! This is patch is hard-coded for test suite optimization used in the
1010# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1011 ! 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 + 0.2*sin(5*x)"
1012# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1013 if (patch_id == 2) then
1014# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1015 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
1016# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1017 end if
1018# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1019
1020# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1021 case (181)
1022# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1023 ! This is patch is hard-coded for test suite optimization used in the
1024# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1025 ! 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)": "1 + 0.1*sin(20*x*pi)"
1026# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1027 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
1028# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1029
1030# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1031 case (182)
1032# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1033 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
1034# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1035 x_mid_diffu = 0.05_wp/2.0_wp
1036# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1037 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
1038# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1039 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
1040# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1041 q_prim_vf(momxb)%sf(i, 0, 0) = 0.0_wp
1042# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1043 q_prim_vf(e_idx)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
1044# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1045 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp
1046# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1047
1048# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1049 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
1050# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1051 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
1052# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1053 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
1054# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1055 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
1056# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1057
1058# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1059 q_prim_vf(chemxb)%sf(i, 0, 0) = y1
1060# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1061 q_prim_vf(chemxb + 1)%sf(i, 0, 0) = y2
1062# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1063 q_prim_vf(chemxb + 2)%sf(i, 0, 0) = y3
1064# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1065 q_prim_vf(chemxb + 3)%sf(i, 0, 0) = y4
1066# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1067
1068# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1069 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
1070# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1071
1072# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1073 molar_mass_inv = y1/31.998_wp + &
1074# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1075 y2/18.01508_wp + &
1076# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1077 y3/16.04256_wp + &
1078# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1079 y4/28.0134_wp
1080# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1081
1082# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1083 q_prim_vf(contxb)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
1084# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1085
1086# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1087 case default
1088# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1089 call s_int_to_str(patch_id, istr)
1090# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1091 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
1092# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1093 end select
1094# 250 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1095
1096 end if
1097
1098 ! Updating the patch identities bookkeeping variable
1099 if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id
1100
1101 end if
1102 end do
1103 if (allocated(stored_values)) then
1104# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1105#ifdef MFC_DEBUG
1106# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1107 block
1108# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1109 use iso_fortran_env, only: output_unit
1110# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1111
1112# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1113 print *, 'm_icpp_patches.fpp:258: ', '@:DEALLOCATE(stored_values)'
1114# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1115
1116# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1117 call flush (output_unit)
1118# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1119 end block
1120# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1121#endif
1122# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1123
1124# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1125#if defined(MFC_OpenACC)
1126# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1127!$acc exit data delete(stored_values)
1128# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1129#elif defined(MFC_OpenMP)
1130# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1131!$omp target exit data map(release:stored_values)
1132# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1133#endif
1134# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1135 deallocate (stored_values)
1136# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1137#ifdef MFC_DEBUG
1138# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1139 block
1140# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1141 use iso_fortran_env, only: output_unit
1142# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1143
1144# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1145 print *, 'm_icpp_patches.fpp:258: ', '@:DEALLOCATE(x_coords)'
1146# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1147
1148# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1149 call flush (output_unit)
1150# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1151 end block
1152# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1153#endif
1154# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1155
1156# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1157#if defined(MFC_OpenACC)
1158# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1159!$acc exit data delete(x_coords)
1160# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1161#elif defined(MFC_OpenMP)
1162# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1163!$omp target exit data map(release:x_coords)
1164# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1165#endif
1166# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1167 deallocate (x_coords)
1168# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1169 end if
1170# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1171
1172# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1173 if (allocated(y_coords)) then
1174# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1175#ifdef MFC_DEBUG
1176# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1177 block
1178# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1179 use iso_fortran_env, only: output_unit
1180# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1181
1182# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1183 print *, 'm_icpp_patches.fpp:258: ', '@:DEALLOCATE(y_coords)'
1184# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1185
1186# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1187 call flush (output_unit)
1188# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1189 end block
1190# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1191#endif
1192# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1193
1194# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1195#if defined(MFC_OpenACC)
1196# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1197!$acc exit data delete(y_coords)
1198# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1199#elif defined(MFC_OpenMP)
1200# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1201!$omp target exit data map(release:y_coords)
1202# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1203#endif
1204# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1205 deallocate (y_coords)
1206# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1207 end if
1208
1209 end subroutine s_icpp_line_segment
1210
1211 !> The spiral patch is a 2D geometry that may be used, The geometry
1212 !! of the patch is well-defined when its centroid and radius
1213 !! are provided. Note that the circular patch DOES allow for
1214 !! the smoothing of its boundary.
1215 !! @param patch_id patch identifier
1216 !! @param patch_id_fp Array to track patch ids
1217 !! @param q_prim_vf Array of primitive variables
1218 impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
1219
1220 integer, intent(in) :: patch_id
1221#ifdef MFC_MIXED_PRECISION
1222 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
1223#else
1224 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
1225#endif
1226 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
1227
1228 integer :: i, j, k !< Generic loop iterators
1229 real(wp) :: th, thickness, nturns, mya
1230 real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max
1231 integer :: xrows, yrows, nrows, iix, iiy, max_files
1232# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1233 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
1234# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1235 real(wp) :: x_len, x_step, y_len, y_step
1236# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1237 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
1238# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1239 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
1240# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1241 real(wp) :: delta_x, delta_y
1242# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1243 character(len=100), dimension(sys_size) :: filenames ! Arrays to store all data from files
1244# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1245 character(len=200) :: errmsg
1246# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1247 real(wp), allocatable :: stored_values(:, :, :)
1248# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1249 real(wp), allocatable :: x_coords(:), y_coords(:)
1250# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1251 logical :: files_loaded = .false.
1252# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1253 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
1254# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1255 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
1256# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1257 character(len=20) :: file_num_str ! For storing the file number as a string
1258# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1259 character(len=20) :: zeros_part ! For the trailing zeros part
1260# 282 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1261 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
1262 ! Place any declaration of intermediate variables here
1263# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1264 real(wp) :: eps, eps_mhd, c_mhd
1265# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1266 real(wp) :: r, rmax, gam, umax, p0
1267# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1268 real(wp) :: rhoh, rhol, pref, pint, h, lam, wl, amp, inth, intl, alph
1269# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1270 real(wp) :: factor
1271# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1272 real(wp) :: r0, alpha, r2
1273# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1274 real(wp) :: sina, cosa
1275# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1276
1277# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1278 real(wp) :: r_sq
1279# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1280
1281# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1282 ! # 207
1283# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1284 real(wp) :: sigma, gauss1, gauss2
1285# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1286 ! # 208
1287# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1288 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
1289# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1290
1291# 283 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1292 eps = 1.e-9_wp
1293
1294 ! Transferring the circular patch's radius, centroid, smearing patch
1295 ! identity and smearing coefficient information
1296 x_centroid = patch_icpp(patch_id)%x_centroid
1297 y_centroid = patch_icpp(patch_id)%y_centroid
1298 mya = patch_icpp(patch_id)%radius
1299 thickness = patch_icpp(patch_id)%length_x
1300 nturns = patch_icpp(patch_id)%length_y
1301
1302 !
1303 logic_grid = 0
1304 do k = 0, int(m*91*nturns)
1305 th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi
1306
1307 spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), &
1308 f_r(th, thickness, mya)*cos(th)/))
1309 spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), &
1310 f_r(th, thickness, mya)*sin(th)/))
1311
1312 spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), &
1313 f_r(th, thickness, mya)*cos(th)/))
1314 spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), &
1315 f_r(th, thickness, mya)*sin(th)/))
1316
1317 do j = 0, n; do i = 0, m;
1318 if ((x_cc(i) > spiral_x_min) .and. (x_cc(i) < spiral_x_max) .and. &
1319 (y_cc(j) > spiral_y_min) .and. (y_cc(j) < spiral_y_max)) then
1320 logic_grid(i, j, 0) = 1
1321 end if
1322 end do; end do
1323 end do
1324
1325 do j = 0, n
1326 do i = 0, m
1327 if ((logic_grid(i, j, 0) == 1)) then
1328 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
1329 eta, q_prim_vf, patch_id_fp)
1330
1331
1332 if (patch_icpp(patch_id)%hcid /= dflt_int) then
1333
1334# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1335 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
1336# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1337
1338# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1339 case (200)
1340# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1341 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
1342# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1343 ! Volume Fractions
1344# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1345 q_prim_vf(advxb)%sf(i, j, 0) = eps
1346# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1347 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
1348# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1349 ! Denssities
1350# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1351 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
1352# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1353 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
1354# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1355 ! Pressure
1356# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1357 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
1358# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1359 end if
1360# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1361 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
1362# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1363 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1364# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1365 rmax = 0.2_wp
1366# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1367
1368# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1369 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1370# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1371 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1372# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1373 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1374# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1375
1376# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1377 if (r < rmax) then
1378# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1379 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1380# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1381 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1382# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1383 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1384# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1385 else if (r < 2*rmax) then
1386# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1387 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1388# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1389 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1390# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1391 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
1392# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1393 else
1394# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1395 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
1396# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1397 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
1398# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1399 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
1400# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1401 end if
1402# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1403 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
1404# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1405 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1406# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1407 rmax = 0.2_wp
1408# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1409
1410# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1411 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1412# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1413 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1414# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1415 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1416# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1417
1418# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1419 if (r < rmax) then
1420# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1421 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1422# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1423 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1424# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1425 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1426# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1427 else if (r < 2*rmax) then
1428# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1429 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1430# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1431 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1432# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1433 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
1434# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1435 else
1436# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1437 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
1438# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1439 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
1440# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1441 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
1442# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1443 end if
1444# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1445
1446# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1447 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
1448# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1449 case (204) ! Rayleigh-Taylor instability
1450# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1451 rhoh = 3._wp
1452# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1453 rhol = 1._wp
1454# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1455 pref = 1.e5_wp
1456# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1457 pint = pref
1458# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1459 h = 0.7_wp
1460# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1461 lam = 0.2_wp
1462# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1463 wl = 2._wp*pi/lam
1464# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1465 amp = 0.05_wp/wl
1466# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1467
1468# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1469 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
1470# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1471
1472# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1473 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
1474# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1475
1476# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1477 if (alph < eps) alph = eps
1478# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1479 if (alph > 1._wp - eps) alph = 1._wp - eps
1480# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1481
1482# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1483 if (y_cc(j) > inth) then
1484# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1485 q_prim_vf(advxb)%sf(i, j, 0) = alph
1486# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1487 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
1488# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1489 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
1490# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1491 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
1492# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1493 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
1494# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1495 else
1496# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1497 q_prim_vf(advxb)%sf(i, j, 0) = alph
1498# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1499 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
1500# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1501 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
1502# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1503 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
1504# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1505 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
1506# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1507 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
1508# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1509 end if
1510# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1511
1512# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1513 case (205) ! 2D lung wave interaction problem
1514# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1515 h = 0.0_wp !non dim origin y
1516# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1517 lam = 1.0_wp !non dim lambda
1518# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1519 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
1520# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1521
1522# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1523 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
1524# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1525
1526# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1527 if (y_cc(j) > inth) then
1528# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1529 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1530# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1531 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1532# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1533 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
1534# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1535 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1536# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1537 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1538# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1539 end if
1540# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1541
1542# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1543 case (206) ! 2D lung wave interaction problem - horizontal domain
1544# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1545 h = 0.0_wp !non dim origin y
1546# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1547 lam = 1.0_wp !non dim lambda
1548# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1549 amp = patch_icpp(patch_id)%a(2)
1550# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1551
1552# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1553 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
1554# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1555
1556# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1557 if (x_cc(i) > intl) then !this is the liquid
1558# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1559 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1560# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1561 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1562# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1563 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
1564# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1565 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1566# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1567 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1568# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1569 end if
1570# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1571
1572# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1573 case (207) ! Kelvin Helmholtz Instability
1574# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1575 sigma = 0.05_wp/sqrt(2.0_wp)
1576# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1577 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
1578# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1579 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
1580# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1581 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
1582# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1583 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
1584# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1585
1586# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1587 case (208) ! Richtmeyer Meshkov Instability
1588# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1589 lam = 1.0_wp
1590# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1591 eps = 1.0e-6_wp
1592# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1593 ei = 5.0_wp
1594# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1595 ! Smoothening function to smooth out sharp discontinuity in the interface
1596# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1597 if (x_cc(i) <= 0.7_wp*lam) then
1598# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1599 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
1600# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1601 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
1602# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1603 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
1604# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1605 alpha_sf6 = 1.0_wp - alpha_air
1606# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1607 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
1608# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1609 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
1610# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1611 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
1612# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1613 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
1614# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1615 end if
1616# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1617
1618# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1619 case (250) ! MHD Orszag-Tang vortex
1620# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1621 ! gamma = 5/3
1622# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1623 ! rho = 25/(36*pi)
1624# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1625 ! p = 5/(12*pi)
1626# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1627 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
1628# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1629 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
1630# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1631
1632# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1633 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
1634# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1635 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
1636# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1637
1638# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1639 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
1640# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1641 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
1642# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1643
1644# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1645 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
1646# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1647 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
1648# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1649 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
1650# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1651 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
1652# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1653 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
1654# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1655 ! Linear interpolation between r=0.08 and r=1.0
1656# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1657 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
1658# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1659 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
1660# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1661 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
1662# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1663 else
1664# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1665 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
1666# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1667 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
1668# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1669 end if
1670# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1671
1672# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1673 ! case 252 is for the 2D MHD Rotor problem
1674# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1675 case (252) ! 2D MHD Rotor Problem
1676# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1677 ! Ambient conditions are set in the JSON file.
1678# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1679 ! This case imposes the dense, rotating cylinder.
1680# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1681 !
1682# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1683 ! gamma = 1.4
1684# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1685 ! Ambient medium (r > 0.1):
1686# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1687 ! rho = 1, p = 1, v = 0, B = (1,0,0)
1688# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1689 ! Rotor (r <= 0.1):
1690# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1691 ! rho = 10, p = 1
1692# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1693 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
1694# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1695
1696# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1697 ! Calculate distance squared from the center
1698# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1699 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
1700# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1701
1702# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1703 ! inner radius of 0.1
1704# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1705 if (r_sq <= 0.1**2) then
1706# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1707 ! -- Inside the rotor --
1708# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1709 ! Set density uniformly to 10
1710# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1711 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
1712# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1713
1714# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1715 ! Set vup constant rotation of rate v=2
1716# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1717 ! v_x = -omega * (y - y_c)
1718# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1719 ! v_y = omega * (x - x_c)
1720# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1721 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
1722# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1723 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
1724# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1725
1726# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1727 ! taper width of 0.015
1728# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1729 else if (r_sq <= 0.115**2) then
1730# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1731 ! linearly smooth the function between r = 0.1 and 0.115
1732# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1733 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1734# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1735
1736# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1737 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1738# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1739 q_prim_vf(momxb + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1740# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1741 end if
1742# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1743
1744# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1745 case (253) ! MHD Smooth Magnetic Vortex
1746# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1747 ! Section 5.2 of
1748# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1749 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
1750# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1751 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
1752# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1753
1754# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1755 ! velocity
1756# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1757 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
1758# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1759 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
1760# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1761
1762# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1763 ! magnetic field
1764# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1765 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
1766# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1767 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
1768# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1769
1770# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1771 ! pressure
1772# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1773 q_prim_vf(e_idx)%sf(i, j, 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)
1774# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1775
1776# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1777 case (260) ! Gaussian Divergence Pulse
1778# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1779 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
1780# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1781 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
1782# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1783 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
1784# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1785 ! ψ is initialized to zero everywhere.
1786# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1787
1788# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1789 eps_mhd = patch_icpp(patch_id)%a(2)
1790# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1791 sigma = patch_icpp(patch_id)%a(3)
1792# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1793 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
1794# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1795
1796# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1797 ! B-field
1798# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1799 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
1800# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1801
1802# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1803 case (261) ! Blob
1804# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1805 r0 = 1._wp/sqrt(8._wp)
1806# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1807 r2 = x_cc(i)**2 + y_cc(j)**2
1808# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1809 r = sqrt(r2)
1810# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1811 alpha = r/r0
1812# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1813 if (alpha < 1) then
1814# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1815 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
1816# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1817 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
1818# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1819 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
1820# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1821 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
1822# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1823 end if
1824# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1825
1826# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1827 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
1828# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1829 ! rotate by α = atan(2)
1830# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1831 alpha = atan(2._wp)
1832# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1833 cosa = cos(alpha)
1834# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1835 sina = sin(alpha)
1836# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1837 ! projection along shock normal
1838# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1839 r = x_cc(i)*cosa + y_cc(j)*sina
1840# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1841
1842# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1843 if (r <= 0.5_wp) then
1844# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1845 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
1846# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1847 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
1848# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1849 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
1850# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1851 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
1852# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1853 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
1854# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1855 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
1856# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1857 - (5._wp/sqrt(4._wp*pi))*sina
1858# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1859 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
1860# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1861 + (5._wp/sqrt(4._wp*pi))*cosa
1862# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1863 else
1864# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1865 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
1866# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1867 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
1868# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1869 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
1870# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1871 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
1872# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1873 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
1874# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1875 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
1876# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1877 - (5._wp/sqrt(4._wp*pi))*sina
1878# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1879 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
1880# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1881 + (5._wp/sqrt(4._wp*pi))*cosa
1882# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1883 end if
1884# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1885 ! v^z and B^z remain zero by default
1886# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1887
1888# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1889 case (270)
1890# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1891 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
1892# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1893
1894# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1895 if (.not. files_loaded) then
1896# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1897 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
1898# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1899 do f = 1, max_files
1900# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1901 write (file_num_str, '(I0)') f
1902# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1903 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
1904# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1905 end do
1906# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1907
1908# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1909 ! Common file reading setup
1910# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1911 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1912# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1913 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
1914# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1915
1916# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1917 select case (num_dims)
1918# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1919 case (1, 2) ! 1D and 2D cases are similar
1920# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1921 ! Count lines
1922# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1923 line_count = 0
1924# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1925 do
1926# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1927 read (unit2, *, iostat=ios2) dummy_x, dummy_y
1928# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1929 if (ios2 /= 0) exit
1930# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1931 line_count = line_count + 1
1932# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1933 end do
1934# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1935 close (unit2)
1936# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1937
1938# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1939 xrows = line_count
1940# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1941 yrows = 1
1942# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1943 index_x = 0
1944# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1945 if (num_dims == 2) index_x = i
1946# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1947#ifdef MFC_DEBUG
1948# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1949 block
1950# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1951 use iso_fortran_env, only: output_unit
1952# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1953
1954# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1955 print *, 'm_icpp_patches.fpp:324: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
1956# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1957
1958# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1959 call flush (output_unit)
1960# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1961 end block
1962# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1963#endif
1964# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1965 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
1966# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1967
1968# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1969
1970# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1971
1972# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1973#if defined(MFC_OpenACC)
1974# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1975!$acc enter data create(x_coords, stored_values)
1976# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1977#elif defined(MFC_OpenMP)
1978# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1979!$omp target enter data map(always,alloc:x_coords, stored_values)
1980# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1981#endif
1982# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1983
1984# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1985 ! Read data from all files
1986# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1987 do f = 1, max_files
1988# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1989 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
1990# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1991 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
1992# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1993
1994# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1995 do iter = 1, xrows
1996# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1997 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
1998# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1999 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
2000# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2001 end do
2002# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2003 close (unit)
2004# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2005 end do
2006# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2007
2008# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2009 ! Calculate offsets
2010# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2011 domain_xstart = x_coords(1)
2012# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2013 x_step = x_cc(1) - x_cc(0)
2014# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2015 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
2016# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2017 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
2018# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2019 global_offset_x = nint(abs(delta_x)/x_step)
2020# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2021
2022# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2023 case (3) ! 3D case - determine grid structure
2024# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2025 ! Find yRows by counting rows with same x
2026# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2027 read (unit2, *, iostat=ios2) x0, y0, dummy_z
2028# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2029 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
2030# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2031
2032# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2033 yrows = 1
2034# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2035 do
2036# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2037 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2038# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2039 if (ios2 /= 0) exit
2040# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2041 if (dummy_x == x0 .and. dummy_y /= y0) then
2042# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2043 yrows = yrows + 1
2044# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2045 else
2046# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2047 exit
2048# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2049 end if
2050# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2051 end do
2052# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2053 close (unit2)
2054# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2055
2056# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2057 ! Count total rows
2058# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2059 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2060# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2061 nrows = 0
2062# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2063 do
2064# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2065 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2066# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2067 if (ios2 /= 0) exit
2068# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2069 nrows = nrows + 1
2070# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2071 end do
2072# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2073 close (unit2)
2074# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2075
2076# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2077 xrows = nrows/yrows
2078# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2079#ifdef MFC_DEBUG
2080# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2081 block
2082# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2083 use iso_fortran_env, only: output_unit
2084# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2085
2086# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2087 print *, 'm_icpp_patches.fpp:324: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2088# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2089
2090# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2091 call flush (output_unit)
2092# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2093 end block
2094# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2095#endif
2096# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2097 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2098# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2099
2100# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2101
2102# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2103
2104# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2105
2106# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2107#if defined(MFC_OpenACC)
2108# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2109!$acc enter data create(x_coords, y_coords, stored_values)
2110# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2111#elif defined(MFC_OpenMP)
2112# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2113!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2114# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2115#endif
2116# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2117 index_x = i
2118# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2119 index_y = j
2120# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2121
2122# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2123 ! Read all files
2124# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2125 do f = 1, max_files
2126# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2127 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2128# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2129 if (ios /= 0) then
2130# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2131 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
2132# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2133 cycle
2134# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2135 end if
2136# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2137
2138# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2139 iter = 0
2140# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2141 do iix = 1, xrows
2142# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2143 do iiy = 1, yrows
2144# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2145 iter = iter + 1
2146# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2147 if (f == 1) then
2148# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2149 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2150# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2151 else
2152# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2153 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2154# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2155 end if
2156# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2157 if (ios /= 0) call s_mpi_abort("Error reading data")
2158# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2159 end do
2160# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2161 end do
2162# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2163 close (unit)
2164# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2165 end do
2166# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2167
2168# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2169 ! Calculate offsets
2170# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2171 x_step = x_cc(1) - x_cc(0)
2172# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2173 y_step = y_cc(1) - y_cc(0)
2174# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2175 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
2176# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2177 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
2178# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2179 global_offset_x = nint(abs(delta_x)/x_step)
2180# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2181 global_offset_y = nint(abs(delta_y)/y_step)
2182# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2183 end select
2184# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2185
2186# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2187 files_loaded = .true.
2188# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2189 end if
2190# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2191
2192# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2193 ! Data assignment
2194# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2195 select case (num_dims)
2196# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2197 case (1)
2198# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2199 idx = i + 1 + global_offset_x
2200# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2201 do f = 1, sys_size
2202# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2203 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2204# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2205 end do
2206# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2207
2208# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2209 case (2)
2210# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2211 idx = i + 1 + global_offset_x - index_x
2212# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2213 do f = 1, sys_size - 1
2214# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2215 jump = merge(1, 0, f >= momxe)
2216# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2217 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2218# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2219 end do
2220# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2221 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
2222# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2223
2224# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2225 case (3)
2226# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2227 idx = i + 1 + global_offset_x - index_x
2228# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2229 idy = j + 1 + global_offset_y - index_y
2230# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2231 do f = 1, sys_size - 1
2232# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2233 jump = merge(1, 0, f >= momxe)
2234# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2235 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2236# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2237 end do
2238# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2239 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
2240# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2241 end select
2242# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2243
2244# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2245 case (280)
2246# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2247 ! This is patch is hard-coded for test suite optimization used in the
2248# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2249 ! 2D_isentropicvortex case:
2250# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2251 ! This analytic patch uses geometry 2
2252# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2253 if (patch_id == 1) then
2254# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2255 q_prim_vf(e_idx)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
2256# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2257 q_prim_vf(contxb + 0)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
2258# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2259 q_prim_vf(momxb + 0)%sf(i, j, 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2260# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2261 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
2262# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2263 end if
2264# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2265
2266# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2267 case (281)
2268# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2269 ! This is patch is hard-coded for test suite optimization used in the
2270# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2271 ! 2D_acoustic_pulse case:
2272# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2273 ! This analytic patch uses geometry 2
2274# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2275 if (patch_id == 2) then
2276# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2277 q_prim_vf(e_idx)%sf(i, j, 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))
2278# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2279 q_prim_vf(contxb + 0)%sf(i, j, 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))
2280# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2281 end if
2282# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2283
2284# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2285 case (282)
2286# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2287 ! This is patch is hard-coded for test suite optimization used in the
2288# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2289 ! 2D_zero_circ_vortex case:
2290# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2291 ! This analytic patch uses geometry 2
2292# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2293 if (patch_id == 2) then
2294# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2295 q_prim_vf(e_idx)%sf(i, j, 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))
2296# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2297 q_prim_vf(contxb + 0)%sf(i, j, 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))
2298# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2299 q_prim_vf(momxb + 0)%sf(i, j, 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2300# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2301 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
2302# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2303 end if
2304# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2305
2306# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2307 case default
2308# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2309 if (proc_rank == 0) then
2310# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2311 call s_int_to_str(patch_id, istr)
2312# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2313 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
2314# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2315 end if
2316# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2317
2318# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2319 end select
2320# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2321
2322 end if
2323
2324 ! Updating the patch identities bookkeeping variable
2325 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
2326 end if
2327 end do
2328 end do
2329 if (allocated(stored_values)) then
2330# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2331#ifdef MFC_DEBUG
2332# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2333 block
2334# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2335 use iso_fortran_env, only: output_unit
2336# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2337
2338# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2339 print *, 'm_icpp_patches.fpp:332: ', '@:DEALLOCATE(stored_values)'
2340# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2341
2342# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2343 call flush (output_unit)
2344# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2345 end block
2346# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2347#endif
2348# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2349
2350# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2351#if defined(MFC_OpenACC)
2352# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2353!$acc exit data delete(stored_values)
2354# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2355#elif defined(MFC_OpenMP)
2356# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2357!$omp target exit data map(release:stored_values)
2358# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2359#endif
2360# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2361 deallocate (stored_values)
2362# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2363#ifdef MFC_DEBUG
2364# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2365 block
2366# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2367 use iso_fortran_env, only: output_unit
2368# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2369
2370# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2371 print *, 'm_icpp_patches.fpp:332: ', '@:DEALLOCATE(x_coords)'
2372# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2373
2374# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2375 call flush (output_unit)
2376# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2377 end block
2378# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2379#endif
2380# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2381
2382# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2383#if defined(MFC_OpenACC)
2384# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2385!$acc exit data delete(x_coords)
2386# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2387#elif defined(MFC_OpenMP)
2388# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2389!$omp target exit data map(release:x_coords)
2390# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2391#endif
2392# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2393 deallocate (x_coords)
2394# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2395 end if
2396# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2397
2398# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2399 if (allocated(y_coords)) then
2400# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2401#ifdef MFC_DEBUG
2402# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2403 block
2404# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2405 use iso_fortran_env, only: output_unit
2406# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2407
2408# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2409 print *, 'm_icpp_patches.fpp:332: ', '@:DEALLOCATE(y_coords)'
2410# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2411
2412# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2413 call flush (output_unit)
2414# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2415 end block
2416# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2417#endif
2418# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2419
2420# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2421#if defined(MFC_OpenACC)
2422# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2423!$acc exit data delete(y_coords)
2424# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2425#elif defined(MFC_OpenMP)
2426# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2427!$omp target exit data map(release:y_coords)
2428# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2429#endif
2430# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2431 deallocate (y_coords)
2432# 332 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2433 end if
2434
2435 end subroutine s_icpp_spiral
2436
2437 !> The circular patch is a 2D geometry that may be used, for
2438 !! example, in creating a bubble or a droplet. The geometry
2439 !! of the patch is well-defined when its centroid and radius
2440 !! are provided. Note that the circular patch DOES allow for
2441 !! the smoothing of its boundary.
2442 !! @param patch_id is the patch identifier
2443 !! @param patch_id_fp Array to track patch ids
2444 !! @param q_prim_vf Array of primitive variables
2445 subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
2446
2447 integer, intent(in) :: patch_id
2448#ifdef MFC_MIXED_PRECISION
2449 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
2450#else
2451 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
2452#endif
2453 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
2454
2455 real(wp) :: radius
2456
2457 integer :: i, j, k !< Generic loop iterators
2458 integer :: xRows, yRows, nRows, iix, iiy, max_files
2459# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2460 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
2461# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2462 real(wp) :: x_len, x_step, y_len, y_step
2463# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2464 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
2465# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2466 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
2467# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2468 real(wp) :: delta_x, delta_y
2469# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2470 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
2471# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2472 character(len=200) :: errmsg
2473# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2474 real(wp), allocatable :: stored_values(:, :, :)
2475# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2476 real(wp), allocatable :: x_coords(:), y_coords(:)
2477# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2478 logical :: files_loaded = .false.
2479# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2480 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
2481# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2482 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
2483# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2484 character(len=20) :: file_num_str ! For storing the file number as a string
2485# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2486 character(len=20) :: zeros_part ! For the trailing zeros part
2487# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2488 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
2489 ! Place any declaration of intermediate variables here
2490# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2491 real(wp) :: eps, eps_mhd, C_mhd
2492# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2493 real(wp) :: r, rmax, gam, umax, p0
2494# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2495 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
2496# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2497 real(wp) :: factor
2498# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2499 real(wp) :: r0, alpha, r2
2500# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2501 real(wp) :: sinA, cosA
2502# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2503
2504# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2505 real(wp) :: r_sq
2506# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2507
2508# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2509 ! # 207
2510# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2511 real(wp) :: sigma, gauss1, gauss2
2512# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2513 ! # 208
2514# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2515 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
2516# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2517
2518# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2519 eps = 1.e-9_wp
2520
2521 ! Transferring the circular patch's radius, centroid, smearing patch
2522 ! identity and smearing coefficient information
2523
2524 x_centroid = patch_icpp(patch_id)%x_centroid
2525 y_centroid = patch_icpp(patch_id)%y_centroid
2526 radius = patch_icpp(patch_id)%radius
2527 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
2528 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
2529
2530 ! Initializing the pseudo volume fraction value to 1. The value will
2531 ! be modified as the patch is laid out on the grid, but only in the
2532 ! case that smoothing of the circular patch's boundary is enabled.
2533 eta = 1._wp
2534
2535 ! Checking whether the circle covers a particular cell in the domain
2536 ! and verifying whether the current patch has permission to write to
2537 ! that cell. If both queries check out, the primitive variables of
2538 ! the current patch are assigned to this cell.
2539
2540 do j = 0, n
2541 do i = 0, m
2542
2543 if (patch_icpp(patch_id)%smoothen) then
2544
2545 eta = tanh(smooth_coeff/min(dx, dy)* &
2546 (sqrt((x_cc(i) - x_centroid)**2 &
2547 + (y_cc(j) - y_centroid)**2) &
2548 - radius))*(-0.5_wp) + 0.5_wp
2549
2550 end if
2551
2552 if (((x_cc(i) - x_centroid)**2 &
2553 + (y_cc(j) - y_centroid)**2 <= radius**2 &
2554 .and. &
2555 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
2556 .or. &
2557 patch_id_fp(i, j, 0) == smooth_patch_id) &
2558 then
2559
2560 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
2561 eta, q_prim_vf, patch_id_fp)
2562
2563
2564 if (patch_icpp(patch_id)%hcid /= dflt_int) then
2565
2566# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2567 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
2568# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2569
2570# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2571 case (200)
2572# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2573 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
2574# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2575 ! Volume Fractions
2576# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2577 q_prim_vf(advxb)%sf(i, j, 0) = eps
2578# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2579 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
2580# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2581 ! Denssities
2582# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2583 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
2584# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2585 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
2586# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2587 ! Pressure
2588# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2589 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
2590# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2591 end if
2592# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2593 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
2594# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2595 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2596# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2597 rmax = 0.2_wp
2598# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2599
2600# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2601 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2602# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2603 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2604# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2605 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2606# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2607
2608# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2609 if (r < rmax) then
2610# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2611 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2612# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2613 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2614# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2615 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2616# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2617 else if (r < 2*rmax) then
2618# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2619 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2620# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2621 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2622# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2623 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
2624# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2625 else
2626# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2627 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
2628# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2629 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
2630# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2631 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
2632# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2633 end if
2634# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2635 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
2636# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2637 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2638# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2639 rmax = 0.2_wp
2640# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2641
2642# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2643 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2644# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2645 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2646# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2647 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2648# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2649
2650# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2651 if (r < rmax) then
2652# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2653 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2654# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2655 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2656# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2657 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2658# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2659 else if (r < 2*rmax) then
2660# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2661 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2662# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2663 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2664# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2665 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
2666# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2667 else
2668# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2669 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
2670# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2671 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
2672# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2673 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
2674# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2675 end if
2676# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2677
2678# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2679 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
2680# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2681 case (204) ! Rayleigh-Taylor instability
2682# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2683 rhoh = 3._wp
2684# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2685 rhol = 1._wp
2686# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2687 pref = 1.e5_wp
2688# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2689 pint = pref
2690# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2691 h = 0.7_wp
2692# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2693 lam = 0.2_wp
2694# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2695 wl = 2._wp*pi/lam
2696# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2697 amp = 0.05_wp/wl
2698# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2699
2700# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2701 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
2702# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2703
2704# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2705 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
2706# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2707
2708# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2709 if (alph < eps) alph = eps
2710# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2711 if (alph > 1._wp - eps) alph = 1._wp - eps
2712# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2713
2714# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2715 if (y_cc(j) > inth) then
2716# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2717 q_prim_vf(advxb)%sf(i, j, 0) = alph
2718# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2719 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
2720# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2721 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
2722# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2723 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
2724# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2725 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
2726# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2727 else
2728# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2729 q_prim_vf(advxb)%sf(i, j, 0) = alph
2730# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2731 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
2732# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2733 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
2734# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2735 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
2736# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2737 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
2738# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2739 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
2740# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2741 end if
2742# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2743
2744# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2745 case (205) ! 2D lung wave interaction problem
2746# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2747 h = 0.0_wp !non dim origin y
2748# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2749 lam = 1.0_wp !non dim lambda
2750# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2751 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
2752# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2753
2754# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2755 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
2756# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2757
2758# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2759 if (y_cc(j) > inth) then
2760# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2761 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2762# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2763 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2764# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2765 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
2766# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2767 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2768# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2769 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2770# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2771 end if
2772# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2773
2774# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2775 case (206) ! 2D lung wave interaction problem - horizontal domain
2776# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2777 h = 0.0_wp !non dim origin y
2778# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2779 lam = 1.0_wp !non dim lambda
2780# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2781 amp = patch_icpp(patch_id)%a(2)
2782# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2783
2784# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2785 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
2786# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2787
2788# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2789 if (x_cc(i) > intl) then !this is the liquid
2790# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2791 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2792# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2793 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2794# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2795 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
2796# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2797 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2798# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2799 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2800# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2801 end if
2802# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2803
2804# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2805 case (207) ! Kelvin Helmholtz Instability
2806# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2807 sigma = 0.05_wp/sqrt(2.0_wp)
2808# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2809 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
2810# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2811 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
2812# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2813 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
2814# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2815 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
2816# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2817
2818# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2819 case (208) ! Richtmeyer Meshkov Instability
2820# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2821 lam = 1.0_wp
2822# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2823 eps = 1.0e-6_wp
2824# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2825 ei = 5.0_wp
2826# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2827 ! Smoothening function to smooth out sharp discontinuity in the interface
2828# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2829 if (x_cc(i) <= 0.7_wp*lam) then
2830# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2831 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
2832# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2833 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
2834# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2835 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
2836# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2837 alpha_sf6 = 1.0_wp - alpha_air
2838# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2839 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
2840# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2841 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
2842# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2843 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
2844# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2845 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
2846# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2847 end if
2848# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2849
2850# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2851 case (250) ! MHD Orszag-Tang vortex
2852# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2853 ! gamma = 5/3
2854# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2855 ! rho = 25/(36*pi)
2856# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2857 ! p = 5/(12*pi)
2858# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2859 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
2860# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2861 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
2862# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2863
2864# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2865 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
2866# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2867 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
2868# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2869
2870# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2871 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
2872# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2873 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
2874# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2875
2876# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2877 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
2878# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2879 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
2880# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2881 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
2882# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2883 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
2884# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2885 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
2886# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2887 ! Linear interpolation between r=0.08 and r=1.0
2888# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2889 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
2890# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2891 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
2892# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2893 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
2894# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2895 else
2896# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2897 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
2898# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2899 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
2900# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2901 end if
2902# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2903
2904# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2905 ! case 252 is for the 2D MHD Rotor problem
2906# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2907 case (252) ! 2D MHD Rotor Problem
2908# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2909 ! Ambient conditions are set in the JSON file.
2910# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2911 ! This case imposes the dense, rotating cylinder.
2912# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2913 !
2914# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2915 ! gamma = 1.4
2916# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2917 ! Ambient medium (r > 0.1):
2918# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2919 ! rho = 1, p = 1, v = 0, B = (1,0,0)
2920# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2921 ! Rotor (r <= 0.1):
2922# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2923 ! rho = 10, p = 1
2924# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2925 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
2926# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2927
2928# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2929 ! Calculate distance squared from the center
2930# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2931 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
2932# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2933
2934# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2935 ! inner radius of 0.1
2936# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2937 if (r_sq <= 0.1**2) then
2938# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2939 ! -- Inside the rotor --
2940# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2941 ! Set density uniformly to 10
2942# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2943 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
2944# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2945
2946# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2947 ! Set vup constant rotation of rate v=2
2948# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2949 ! v_x = -omega * (y - y_c)
2950# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2951 ! v_y = omega * (x - x_c)
2952# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2953 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
2954# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2955 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
2956# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2957
2958# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2959 ! taper width of 0.015
2960# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2961 else if (r_sq <= 0.115**2) then
2962# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2963 ! linearly smooth the function between r = 0.1 and 0.115
2964# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2965 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
2966# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2967
2968# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2969 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
2970# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2971 q_prim_vf(momxb + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
2972# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2973 end if
2974# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2975
2976# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2977 case (253) ! MHD Smooth Magnetic Vortex
2978# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2979 ! Section 5.2 of
2980# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2981 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
2982# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2983 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
2984# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2985
2986# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2987 ! velocity
2988# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2989 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
2990# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2991 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
2992# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2993
2994# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2995 ! magnetic field
2996# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2997 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
2998# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2999 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
3000# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3001
3002# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3003 ! pressure
3004# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3005 q_prim_vf(e_idx)%sf(i, j, 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)
3006# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3007
3008# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3009 case (260) ! Gaussian Divergence Pulse
3010# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3011 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
3012# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3013 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
3014# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3015 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
3016# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3017 ! ψ is initialized to zero everywhere.
3018# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3019
3020# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3021 eps_mhd = patch_icpp(patch_id)%a(2)
3022# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3023 sigma = patch_icpp(patch_id)%a(3)
3024# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3025 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
3026# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3027
3028# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3029 ! B-field
3030# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3031 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
3032# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3033
3034# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3035 case (261) ! Blob
3036# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3037 r0 = 1._wp/sqrt(8._wp)
3038# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3039 r2 = x_cc(i)**2 + y_cc(j)**2
3040# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3041 r = sqrt(r2)
3042# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3043 alpha = r/r0
3044# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3045 if (alpha < 1) then
3046# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3047 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
3048# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3049 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
3050# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3051 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
3052# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3053 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
3054# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3055 end if
3056# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3057
3058# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3059 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
3060# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3061 ! rotate by α = atan(2)
3062# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3063 alpha = atan(2._wp)
3064# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3065 cosa = cos(alpha)
3066# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3067 sina = sin(alpha)
3068# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3069 ! projection along shock normal
3070# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3071 r = x_cc(i)*cosa + y_cc(j)*sina
3072# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3073
3074# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3075 if (r <= 0.5_wp) then
3076# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3077 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
3078# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3079 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
3080# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3081 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
3082# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3083 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
3084# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3085 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
3086# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3087 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
3088# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3089 - (5._wp/sqrt(4._wp*pi))*sina
3090# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3091 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
3092# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3093 + (5._wp/sqrt(4._wp*pi))*cosa
3094# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3095 else
3096# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3097 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
3098# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3099 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
3100# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3101 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
3102# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3103 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
3104# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3105 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
3106# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3107 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
3108# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3109 - (5._wp/sqrt(4._wp*pi))*sina
3110# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3111 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
3112# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3113 + (5._wp/sqrt(4._wp*pi))*cosa
3114# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3115 end if
3116# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3117 ! v^z and B^z remain zero by default
3118# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3119
3120# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3121 case (270)
3122# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3123 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
3124# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3125
3126# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3127 if (.not. files_loaded) then
3128# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3129 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
3130# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3131 do f = 1, max_files
3132# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3133 write (file_num_str, '(I0)') f
3134# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3135 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
3136# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3137 end do
3138# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3139
3140# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3141 ! Common file reading setup
3142# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3143 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3144# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3145 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
3146# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3147
3148# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3149 select case (num_dims)
3150# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3151 case (1, 2) ! 1D and 2D cases are similar
3152# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3153 ! Count lines
3154# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3155 line_count = 0
3156# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3157 do
3158# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3159 read (unit2, *, iostat=ios2) dummy_x, dummy_y
3160# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3161 if (ios2 /= 0) exit
3162# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3163 line_count = line_count + 1
3164# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3165 end do
3166# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3167 close (unit2)
3168# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3169
3170# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3171 xrows = line_count
3172# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3173 yrows = 1
3174# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3175 index_x = 0
3176# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3177 if (num_dims == 2) index_x = i
3178# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3179#ifdef MFC_DEBUG
3180# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3181 block
3182# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3183 use iso_fortran_env, only: output_unit
3184# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3185
3186# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3187 print *, 'm_icpp_patches.fpp:404: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
3188# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3189
3190# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3191 call flush (output_unit)
3192# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3193 end block
3194# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3195#endif
3196# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3197 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
3198# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3199
3200# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3201
3202# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3203
3204# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3205#if defined(MFC_OpenACC)
3206# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3207!$acc enter data create(x_coords, stored_values)
3208# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3209#elif defined(MFC_OpenMP)
3210# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3211!$omp target enter data map(always,alloc:x_coords, stored_values)
3212# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3213#endif
3214# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3215
3216# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3217 ! Read data from all files
3218# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3219 do f = 1, max_files
3220# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3221 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3222# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3223 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
3224# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3225
3226# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3227 do iter = 1, xrows
3228# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3229 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3230# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3231 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
3232# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3233 end do
3234# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3235 close (unit)
3236# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3237 end do
3238# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3239
3240# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3241 ! Calculate offsets
3242# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3243 domain_xstart = x_coords(1)
3244# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3245 x_step = x_cc(1) - x_cc(0)
3246# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3247 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
3248# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3249 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
3250# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3251 global_offset_x = nint(abs(delta_x)/x_step)
3252# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3253
3254# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3255 case (3) ! 3D case - determine grid structure
3256# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3257 ! Find yRows by counting rows with same x
3258# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3259 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3260# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3261 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3262# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3263
3264# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3265 yrows = 1
3266# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3267 do
3268# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3269 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3270# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3271 if (ios2 /= 0) exit
3272# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3273 if (dummy_x == x0 .and. dummy_y /= y0) then
3274# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3275 yrows = yrows + 1
3276# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3277 else
3278# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3279 exit
3280# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3281 end if
3282# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3283 end do
3284# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3285 close (unit2)
3286# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3287
3288# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3289 ! Count total rows
3290# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3291 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3292# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3293 nrows = 0
3294# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3295 do
3296# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3297 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3298# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3299 if (ios2 /= 0) exit
3300# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3301 nrows = nrows + 1
3302# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3303 end do
3304# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3305 close (unit2)
3306# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3307
3308# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3309 xrows = nrows/yrows
3310# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3311#ifdef MFC_DEBUG
3312# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3313 block
3314# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3315 use iso_fortran_env, only: output_unit
3316# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3317
3318# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3319 print *, 'm_icpp_patches.fpp:404: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3320# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3321
3322# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3323 call flush (output_unit)
3324# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3325 end block
3326# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3327#endif
3328# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3329 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3330# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3331
3332# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3333
3334# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3335
3336# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3337
3338# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3339#if defined(MFC_OpenACC)
3340# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3341!$acc enter data create(x_coords, y_coords, stored_values)
3342# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3343#elif defined(MFC_OpenMP)
3344# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3345!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3346# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3347#endif
3348# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3349 index_x = i
3350# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3351 index_y = j
3352# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3353
3354# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3355 ! Read all files
3356# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3357 do f = 1, max_files
3358# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3359 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3360# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3361 if (ios /= 0) then
3362# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3363 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
3364# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3365 cycle
3366# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3367 end if
3368# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3369
3370# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3371 iter = 0
3372# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3373 do iix = 1, xrows
3374# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3375 do iiy = 1, yrows
3376# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3377 iter = iter + 1
3378# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3379 if (f == 1) then
3380# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3381 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3382# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3383 else
3384# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3385 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3386# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3387 end if
3388# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3389 if (ios /= 0) call s_mpi_abort("Error reading data")
3390# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3391 end do
3392# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3393 end do
3394# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3395 close (unit)
3396# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3397 end do
3398# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3399
3400# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3401 ! Calculate offsets
3402# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3403 x_step = x_cc(1) - x_cc(0)
3404# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3405 y_step = y_cc(1) - y_cc(0)
3406# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3407 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
3408# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3409 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
3410# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3411 global_offset_x = nint(abs(delta_x)/x_step)
3412# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3413 global_offset_y = nint(abs(delta_y)/y_step)
3414# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3415 end select
3416# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3417
3418# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3419 files_loaded = .true.
3420# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3421 end if
3422# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3423
3424# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3425 ! Data assignment
3426# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3427 select case (num_dims)
3428# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3429 case (1)
3430# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3431 idx = i + 1 + global_offset_x
3432# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3433 do f = 1, sys_size
3434# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3435 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3436# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3437 end do
3438# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3439
3440# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3441 case (2)
3442# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3443 idx = i + 1 + global_offset_x - index_x
3444# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3445 do f = 1, sys_size - 1
3446# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3447 jump = merge(1, 0, f >= momxe)
3448# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3449 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3450# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3451 end do
3452# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3453 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
3454# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3455
3456# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3457 case (3)
3458# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3459 idx = i + 1 + global_offset_x - index_x
3460# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3461 idy = j + 1 + global_offset_y - index_y
3462# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3463 do f = 1, sys_size - 1
3464# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3465 jump = merge(1, 0, f >= momxe)
3466# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3467 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3468# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3469 end do
3470# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3471 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
3472# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3473 end select
3474# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3475
3476# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3477 case (280)
3478# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3479 ! This is patch is hard-coded for test suite optimization used in the
3480# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3481 ! 2D_isentropicvortex case:
3482# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3483 ! This analytic patch uses geometry 2
3484# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3485 if (patch_id == 1) then
3486# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3487 q_prim_vf(e_idx)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
3488# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3489 q_prim_vf(contxb + 0)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
3490# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3491 q_prim_vf(momxb + 0)%sf(i, j, 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3492# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3493 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
3494# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3495 end if
3496# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3497
3498# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3499 case (281)
3500# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3501 ! This is patch is hard-coded for test suite optimization used in the
3502# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3503 ! 2D_acoustic_pulse case:
3504# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3505 ! This analytic patch uses geometry 2
3506# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3507 if (patch_id == 2) then
3508# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3509 q_prim_vf(e_idx)%sf(i, j, 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))
3510# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3511 q_prim_vf(contxb + 0)%sf(i, j, 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))
3512# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3513 end if
3514# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3515
3516# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3517 case (282)
3518# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3519 ! This is patch is hard-coded for test suite optimization used in the
3520# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3521 ! 2D_zero_circ_vortex case:
3522# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3523 ! This analytic patch uses geometry 2
3524# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3525 if (patch_id == 2) then
3526# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3527 q_prim_vf(e_idx)%sf(i, j, 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))
3528# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3529 q_prim_vf(contxb + 0)%sf(i, j, 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))
3530# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3531 q_prim_vf(momxb + 0)%sf(i, j, 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3532# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3533 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
3534# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3535 end if
3536# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3537
3538# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3539 case default
3540# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3541 if (proc_rank == 0) then
3542# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3543 call s_int_to_str(patch_id, istr)
3544# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3545 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
3546# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3547 end if
3548# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3549
3550# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3551 end select
3552# 404 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3553
3554 end if
3555
3556 end if
3557 end do
3558 end do
3559 if (allocated(stored_values)) then
3560# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3561#ifdef MFC_DEBUG
3562# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3563 block
3564# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3565 use iso_fortran_env, only: output_unit
3566# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3567
3568# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3569 print *, 'm_icpp_patches.fpp:410: ', '@:DEALLOCATE(stored_values)'
3570# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3571
3572# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3573 call flush (output_unit)
3574# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3575 end block
3576# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3577#endif
3578# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3579
3580# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3581#if defined(MFC_OpenACC)
3582# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3583!$acc exit data delete(stored_values)
3584# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3585#elif defined(MFC_OpenMP)
3586# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3587!$omp target exit data map(release:stored_values)
3588# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3589#endif
3590# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3591 deallocate (stored_values)
3592# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3593#ifdef MFC_DEBUG
3594# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3595 block
3596# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3597 use iso_fortran_env, only: output_unit
3598# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3599
3600# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3601 print *, 'm_icpp_patches.fpp:410: ', '@:DEALLOCATE(x_coords)'
3602# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3603
3604# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3605 call flush (output_unit)
3606# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3607 end block
3608# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3609#endif
3610# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3611
3612# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3613#if defined(MFC_OpenACC)
3614# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3615!$acc exit data delete(x_coords)
3616# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3617#elif defined(MFC_OpenMP)
3618# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3619!$omp target exit data map(release:x_coords)
3620# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3621#endif
3622# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3623 deallocate (x_coords)
3624# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3625 end if
3626# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3627
3628# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3629 if (allocated(y_coords)) then
3630# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3631#ifdef MFC_DEBUG
3632# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3633 block
3634# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3635 use iso_fortran_env, only: output_unit
3636# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3637
3638# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3639 print *, 'm_icpp_patches.fpp:410: ', '@:DEALLOCATE(y_coords)'
3640# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3641
3642# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3643 call flush (output_unit)
3644# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3645 end block
3646# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3647#endif
3648# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3649
3650# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3651#if defined(MFC_OpenACC)
3652# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3653!$acc exit data delete(y_coords)
3654# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3655#elif defined(MFC_OpenMP)
3656# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3657!$omp target exit data map(release:y_coords)
3658# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3659#endif
3660# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3661 deallocate (y_coords)
3662# 410 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3663 end if
3664
3665 end subroutine s_icpp_circle
3666
3667 !> The varcircle patch is a 2D geometry that may be used
3668 !! . It generatres an annulus
3669 !! @param patch_id is the patch identifier
3670 !! @param patch_id_fp Array to track patch ids
3671 !! @param q_prim_vf Array of primitive variables
3672 subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
3673
3674 ! Patch identifier
3675 integer, intent(in) :: patch_id
3676#ifdef MFC_MIXED_PRECISION
3677 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
3678#else
3679 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
3680#endif
3681 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
3682
3683 ! Generic loop iterators
3684 integer :: i, j, k
3685 real(wp) :: radius, myr, thickness
3686 integer :: xRows, yRows, nRows, iix, iiy, max_files
3687# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3688 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
3689# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3690 real(wp) :: x_len, x_step, y_len, y_step
3691# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3692 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
3693# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3694 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
3695# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3696 real(wp) :: delta_x, delta_y
3697# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3698 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
3699# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3700 character(len=200) :: errmsg
3701# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3702 real(wp), allocatable :: stored_values(:, :, :)
3703# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3704 real(wp), allocatable :: x_coords(:), y_coords(:)
3705# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3706 logical :: files_loaded = .false.
3707# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3708 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
3709# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3710 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
3711# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3712 character(len=20) :: file_num_str ! For storing the file number as a string
3713# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3714 character(len=20) :: zeros_part ! For the trailing zeros part
3715# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3716 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
3717 ! Place any declaration of intermediate variables here
3718# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3719 real(wp) :: eps, eps_mhd, C_mhd
3720# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3721 real(wp) :: r, rmax, gam, umax, p0
3722# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3723 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
3724# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3725 real(wp) :: factor
3726# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3727 real(wp) :: r0, alpha, r2
3728# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3729 real(wp) :: sinA, cosA
3730# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3731
3732# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3733 real(wp) :: r_sq
3734# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3735
3736# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3737 ! # 207
3738# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3739 real(wp) :: sigma, gauss1, gauss2
3740# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3741 ! # 208
3742# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3743 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
3744# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3745
3746# 434 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3747 eps = 1.e-9_wp
3748
3749 ! Transferring the circular patch's radius, centroid, smearing patch
3750 ! identity and smearing coefficient information
3751 x_centroid = patch_icpp(patch_id)%x_centroid
3752 y_centroid = patch_icpp(patch_id)%y_centroid
3753 radius = patch_icpp(patch_id)%radius
3754 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
3755 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
3756 thickness = patch_icpp(patch_id)%epsilon
3757
3758 ! Initializing the pseudo volume fraction value to 1. The value will
3759 ! be modified as the patch is laid out on the grid, but only in the
3760 ! case that smoothing of the circular patch's boundary is enabled.
3761 eta = 1._wp
3762
3763 ! Checking whether the circle covers a particular cell in the domain
3764 ! and verifying whether the current patch has permission to write to
3765 ! that cell. If both queries check out, the primitive variables of
3766 ! the current patch are assigned to this cell.
3767 do j = 0, n
3768 do i = 0, m
3769 myr = sqrt((x_cc(i) - x_centroid)**2 &
3770 + (y_cc(j) - y_centroid)**2)
3771
3772 if (myr <= radius + thickness/2._wp .and. &
3773 myr >= radius - thickness/2._wp .and. &
3774 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
3775
3776 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
3777 eta, q_prim_vf, patch_id_fp)
3778
3779
3780 if (patch_icpp(patch_id)%hcid /= dflt_int) then
3781
3782# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3783 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
3784# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3785
3786# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3787 case (200)
3788# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3789 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
3790# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3791 ! Volume Fractions
3792# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3793 q_prim_vf(advxb)%sf(i, j, 0) = eps
3794# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3795 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
3796# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3797 ! Denssities
3798# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3799 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
3800# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3801 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
3802# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3803 ! Pressure
3804# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3805 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
3806# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3807 end if
3808# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3809 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
3810# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3811 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3812# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3813 rmax = 0.2_wp
3814# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3815
3816# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3817 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3818# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3819 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3820# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3821 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3822# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3823
3824# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3825 if (r < rmax) then
3826# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3827 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3828# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3829 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3830# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3831 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3832# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3833 else if (r < 2*rmax) then
3834# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3835 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3836# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3837 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3838# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3839 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
3840# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3841 else
3842# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3843 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
3844# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3845 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
3846# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3847 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
3848# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3849 end if
3850# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3851 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
3852# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3853 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3854# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3855 rmax = 0.2_wp
3856# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3857
3858# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3859 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3860# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3861 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3862# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3863 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3864# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3865
3866# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3867 if (r < rmax) then
3868# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3869 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3870# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3871 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3872# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3873 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3874# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3875 else if (r < 2*rmax) then
3876# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3877 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3878# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3879 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3880# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3881 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
3882# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3883 else
3884# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3885 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
3886# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3887 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
3888# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3889 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
3890# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3891 end if
3892# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3893
3894# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3895 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
3896# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3897 case (204) ! Rayleigh-Taylor instability
3898# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3899 rhoh = 3._wp
3900# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3901 rhol = 1._wp
3902# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3903 pref = 1.e5_wp
3904# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3905 pint = pref
3906# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3907 h = 0.7_wp
3908# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3909 lam = 0.2_wp
3910# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3911 wl = 2._wp*pi/lam
3912# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3913 amp = 0.05_wp/wl
3914# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3915
3916# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3917 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
3918# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3919
3920# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3921 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
3922# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3923
3924# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3925 if (alph < eps) alph = eps
3926# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3927 if (alph > 1._wp - eps) alph = 1._wp - eps
3928# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3929
3930# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3931 if (y_cc(j) > inth) then
3932# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3933 q_prim_vf(advxb)%sf(i, j, 0) = alph
3934# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3935 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
3936# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3937 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
3938# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3939 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
3940# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3941 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
3942# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3943 else
3944# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3945 q_prim_vf(advxb)%sf(i, j, 0) = alph
3946# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3947 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
3948# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3949 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
3950# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3951 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
3952# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3953 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
3954# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3955 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
3956# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3957 end if
3958# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3959
3960# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3961 case (205) ! 2D lung wave interaction problem
3962# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3963 h = 0.0_wp !non dim origin y
3964# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3965 lam = 1.0_wp !non dim lambda
3966# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3967 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
3968# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3969
3970# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3971 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
3972# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3973
3974# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3975 if (y_cc(j) > inth) then
3976# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3977 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
3978# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3979 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
3980# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3981 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
3982# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3983 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
3984# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3985 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
3986# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3987 end if
3988# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3989
3990# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3991 case (206) ! 2D lung wave interaction problem - horizontal domain
3992# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3993 h = 0.0_wp !non dim origin y
3994# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3995 lam = 1.0_wp !non dim lambda
3996# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3997 amp = patch_icpp(patch_id)%a(2)
3998# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3999
4000# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4001 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
4002# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4003
4004# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4005 if (x_cc(i) > intl) then !this is the liquid
4006# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4007 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4008# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4009 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4010# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4011 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
4012# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4013 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4014# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4015 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4016# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4017 end if
4018# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4019
4020# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4021 case (207) ! Kelvin Helmholtz Instability
4022# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4023 sigma = 0.05_wp/sqrt(2.0_wp)
4024# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4025 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
4026# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4027 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
4028# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4029 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
4030# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4031 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
4032# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4033
4034# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4035 case (208) ! Richtmeyer Meshkov Instability
4036# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4037 lam = 1.0_wp
4038# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4039 eps = 1.0e-6_wp
4040# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4041 ei = 5.0_wp
4042# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4043 ! Smoothening function to smooth out sharp discontinuity in the interface
4044# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4045 if (x_cc(i) <= 0.7_wp*lam) then
4046# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4047 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
4048# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4049 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
4050# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4051 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
4052# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4053 alpha_sf6 = 1.0_wp - alpha_air
4054# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4055 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
4056# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4057 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
4058# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4059 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
4060# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4061 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
4062# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4063 end if
4064# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4065
4066# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4067 case (250) ! MHD Orszag-Tang vortex
4068# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4069 ! gamma = 5/3
4070# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4071 ! rho = 25/(36*pi)
4072# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4073 ! p = 5/(12*pi)
4074# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4075 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
4076# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4077 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
4078# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4079
4080# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4081 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
4082# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4083 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
4084# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4085
4086# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4087 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
4088# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4089 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
4090# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4091
4092# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4093 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
4094# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4095 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
4096# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4097 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
4098# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4099 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
4100# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4101 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
4102# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4103 ! Linear interpolation between r=0.08 and r=1.0
4104# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4105 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
4106# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4107 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
4108# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4109 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
4110# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4111 else
4112# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4113 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
4114# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4115 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
4116# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4117 end if
4118# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4119
4120# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4121 ! case 252 is for the 2D MHD Rotor problem
4122# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4123 case (252) ! 2D MHD Rotor Problem
4124# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4125 ! Ambient conditions are set in the JSON file.
4126# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4127 ! This case imposes the dense, rotating cylinder.
4128# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4129 !
4130# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4131 ! gamma = 1.4
4132# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4133 ! Ambient medium (r > 0.1):
4134# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4135 ! rho = 1, p = 1, v = 0, B = (1,0,0)
4136# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4137 ! Rotor (r <= 0.1):
4138# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4139 ! rho = 10, p = 1
4140# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4141 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
4142# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4143
4144# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4145 ! Calculate distance squared from the center
4146# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4147 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
4148# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4149
4150# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4151 ! inner radius of 0.1
4152# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4153 if (r_sq <= 0.1**2) then
4154# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4155 ! -- Inside the rotor --
4156# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4157 ! Set density uniformly to 10
4158# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4159 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
4160# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4161
4162# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4163 ! Set vup constant rotation of rate v=2
4164# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4165 ! v_x = -omega * (y - y_c)
4166# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4167 ! v_y = omega * (x - x_c)
4168# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4169 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
4170# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4171 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
4172# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4173
4174# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4175 ! taper width of 0.015
4176# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4177 else if (r_sq <= 0.115**2) then
4178# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4179 ! linearly smooth the function between r = 0.1 and 0.115
4180# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4181 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4182# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4183
4184# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4185 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4186# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4187 q_prim_vf(momxb + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4188# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4189 end if
4190# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4191
4192# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4193 case (253) ! MHD Smooth Magnetic Vortex
4194# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4195 ! Section 5.2 of
4196# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4197 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
4198# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4199 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
4200# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4201
4202# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4203 ! velocity
4204# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4205 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
4206# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4207 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
4208# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4209
4210# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4211 ! magnetic field
4212# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4213 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
4214# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4215 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
4216# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4217
4218# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4219 ! pressure
4220# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4221 q_prim_vf(e_idx)%sf(i, j, 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)
4222# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4223
4224# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4225 case (260) ! Gaussian Divergence Pulse
4226# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4227 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
4228# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4229 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
4230# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4231 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
4232# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4233 ! ψ is initialized to zero everywhere.
4234# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4235
4236# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4237 eps_mhd = patch_icpp(patch_id)%a(2)
4238# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4239 sigma = patch_icpp(patch_id)%a(3)
4240# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4241 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
4242# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4243
4244# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4245 ! B-field
4246# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4247 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
4248# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4249
4250# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4251 case (261) ! Blob
4252# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4253 r0 = 1._wp/sqrt(8._wp)
4254# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4255 r2 = x_cc(i)**2 + y_cc(j)**2
4256# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4257 r = sqrt(r2)
4258# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4259 alpha = r/r0
4260# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4261 if (alpha < 1) then
4262# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4263 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
4264# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4265 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
4266# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4267 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
4268# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4269 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
4270# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4271 end if
4272# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4273
4274# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4275 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
4276# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4277 ! rotate by α = atan(2)
4278# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4279 alpha = atan(2._wp)
4280# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4281 cosa = cos(alpha)
4282# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4283 sina = sin(alpha)
4284# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4285 ! projection along shock normal
4286# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4287 r = x_cc(i)*cosa + y_cc(j)*sina
4288# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4289
4290# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4291 if (r <= 0.5_wp) then
4292# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4293 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
4294# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4295 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
4296# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4297 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
4298# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4299 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
4300# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4301 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
4302# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4303 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
4304# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4305 - (5._wp/sqrt(4._wp*pi))*sina
4306# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4307 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
4308# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4309 + (5._wp/sqrt(4._wp*pi))*cosa
4310# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4311 else
4312# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4313 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
4314# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4315 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
4316# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4317 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
4318# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4319 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
4320# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4321 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
4322# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4323 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
4324# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4325 - (5._wp/sqrt(4._wp*pi))*sina
4326# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4327 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
4328# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4329 + (5._wp/sqrt(4._wp*pi))*cosa
4330# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4331 end if
4332# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4333 ! v^z and B^z remain zero by default
4334# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4335
4336# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4337 case (270)
4338# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4339 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
4340# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4341
4342# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4343 if (.not. files_loaded) then
4344# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4345 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
4346# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4347 do f = 1, max_files
4348# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4349 write (file_num_str, '(I0)') f
4350# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4351 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
4352# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4353 end do
4354# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4355
4356# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4357 ! Common file reading setup
4358# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4359 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4360# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4361 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
4362# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4363
4364# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4365 select case (num_dims)
4366# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4367 case (1, 2) ! 1D and 2D cases are similar
4368# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4369 ! Count lines
4370# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4371 line_count = 0
4372# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4373 do
4374# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4375 read (unit2, *, iostat=ios2) dummy_x, dummy_y
4376# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4377 if (ios2 /= 0) exit
4378# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4379 line_count = line_count + 1
4380# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4381 end do
4382# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4383 close (unit2)
4384# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4385
4386# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4387 xrows = line_count
4388# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4389 yrows = 1
4390# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4391 index_x = 0
4392# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4393 if (num_dims == 2) index_x = i
4394# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4395#ifdef MFC_DEBUG
4396# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4397 block
4398# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4399 use iso_fortran_env, only: output_unit
4400# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4401
4402# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4403 print *, 'm_icpp_patches.fpp:468: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
4404# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4405
4406# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4407 call flush (output_unit)
4408# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4409 end block
4410# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4411#endif
4412# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4413 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
4414# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4415
4416# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4417
4418# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4419
4420# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4421#if defined(MFC_OpenACC)
4422# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4423!$acc enter data create(x_coords, stored_values)
4424# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4425#elif defined(MFC_OpenMP)
4426# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4427!$omp target enter data map(always,alloc:x_coords, stored_values)
4428# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4429#endif
4430# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4431
4432# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4433 ! Read data from all files
4434# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4435 do f = 1, max_files
4436# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4437 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4438# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4439 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
4440# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4441
4442# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4443 do iter = 1, xrows
4444# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4445 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
4446# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4447 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
4448# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4449 end do
4450# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4451 close (unit)
4452# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4453 end do
4454# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4455
4456# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4457 ! Calculate offsets
4458# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4459 domain_xstart = x_coords(1)
4460# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4461 x_step = x_cc(1) - x_cc(0)
4462# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4463 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
4464# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4465 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
4466# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4467 global_offset_x = nint(abs(delta_x)/x_step)
4468# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4469
4470# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4471 case (3) ! 3D case - determine grid structure
4472# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4473 ! Find yRows by counting rows with same x
4474# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4475 read (unit2, *, iostat=ios2) x0, y0, dummy_z
4476# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4477 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
4478# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4479
4480# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4481 yrows = 1
4482# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4483 do
4484# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4485 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4486# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4487 if (ios2 /= 0) exit
4488# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4489 if (dummy_x == x0 .and. dummy_y /= y0) then
4490# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4491 yrows = yrows + 1
4492# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4493 else
4494# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4495 exit
4496# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4497 end if
4498# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4499 end do
4500# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4501 close (unit2)
4502# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4503
4504# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4505 ! Count total rows
4506# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4507 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4508# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4509 nrows = 0
4510# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4511 do
4512# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4513 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4514# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4515 if (ios2 /= 0) exit
4516# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4517 nrows = nrows + 1
4518# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4519 end do
4520# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4521 close (unit2)
4522# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4523
4524# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4525 xrows = nrows/yrows
4526# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4527#ifdef MFC_DEBUG
4528# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4529 block
4530# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4531 use iso_fortran_env, only: output_unit
4532# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4533
4534# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4535 print *, 'm_icpp_patches.fpp:468: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
4536# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4537
4538# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4539 call flush (output_unit)
4540# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4541 end block
4542# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4543#endif
4544# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4545 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
4546# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4547
4548# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4549
4550# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4551
4552# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4553
4554# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4555#if defined(MFC_OpenACC)
4556# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4557!$acc enter data create(x_coords, y_coords, stored_values)
4558# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4559#elif defined(MFC_OpenMP)
4560# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4561!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
4562# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4563#endif
4564# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4565 index_x = i
4566# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4567 index_y = j
4568# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4569
4570# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4571 ! Read all files
4572# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4573 do f = 1, max_files
4574# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4575 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4576# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4577 if (ios /= 0) then
4578# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4579 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
4580# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4581 cycle
4582# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4583 end if
4584# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4585
4586# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4587 iter = 0
4588# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4589 do iix = 1, xrows
4590# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4591 do iiy = 1, yrows
4592# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4593 iter = iter + 1
4594# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4595 if (f == 1) then
4596# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4597 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
4598# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4599 else
4600# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4601 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
4602# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4603 end if
4604# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4605 if (ios /= 0) call s_mpi_abort("Error reading data")
4606# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4607 end do
4608# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4609 end do
4610# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4611 close (unit)
4612# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4613 end do
4614# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4615
4616# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4617 ! Calculate offsets
4618# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4619 x_step = x_cc(1) - x_cc(0)
4620# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4621 y_step = y_cc(1) - y_cc(0)
4622# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4623 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
4624# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4625 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
4626# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4627 global_offset_x = nint(abs(delta_x)/x_step)
4628# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4629 global_offset_y = nint(abs(delta_y)/y_step)
4630# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4631 end select
4632# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4633
4634# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4635 files_loaded = .true.
4636# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4637 end if
4638# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4639
4640# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4641 ! Data assignment
4642# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4643 select case (num_dims)
4644# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4645 case (1)
4646# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4647 idx = i + 1 + global_offset_x
4648# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4649 do f = 1, sys_size
4650# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4651 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
4652# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4653 end do
4654# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4655
4656# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4657 case (2)
4658# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4659 idx = i + 1 + global_offset_x - index_x
4660# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4661 do f = 1, sys_size - 1
4662# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4663 jump = merge(1, 0, f >= momxe)
4664# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4665 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
4666# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4667 end do
4668# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4669 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
4670# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4671
4672# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4673 case (3)
4674# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4675 idx = i + 1 + global_offset_x - index_x
4676# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4677 idy = j + 1 + global_offset_y - index_y
4678# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4679 do f = 1, sys_size - 1
4680# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4681 jump = merge(1, 0, f >= momxe)
4682# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4683 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
4684# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4685 end do
4686# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4687 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
4688# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4689 end select
4690# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4691
4692# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4693 case (280)
4694# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4695 ! This is patch is hard-coded for test suite optimization used in the
4696# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4697 ! 2D_isentropicvortex case:
4698# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4699 ! This analytic patch uses geometry 2
4700# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4701 if (patch_id == 1) then
4702# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4703 q_prim_vf(e_idx)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
4704# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4705 q_prim_vf(contxb + 0)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
4706# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4707 q_prim_vf(momxb + 0)%sf(i, j, 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4708# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4709 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
4710# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4711 end if
4712# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4713
4714# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4715 case (281)
4716# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4717 ! This is patch is hard-coded for test suite optimization used in the
4718# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4719 ! 2D_acoustic_pulse case:
4720# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4721 ! This analytic patch uses geometry 2
4722# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4723 if (patch_id == 2) then
4724# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4725 q_prim_vf(e_idx)%sf(i, j, 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))
4726# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4727 q_prim_vf(contxb + 0)%sf(i, j, 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))
4728# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4729 end if
4730# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4731
4732# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4733 case (282)
4734# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4735 ! This is patch is hard-coded for test suite optimization used in the
4736# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4737 ! 2D_zero_circ_vortex case:
4738# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4739 ! This analytic patch uses geometry 2
4740# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4741 if (patch_id == 2) then
4742# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4743 q_prim_vf(e_idx)%sf(i, j, 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))
4744# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4745 q_prim_vf(contxb + 0)%sf(i, j, 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))
4746# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4747 q_prim_vf(momxb + 0)%sf(i, j, 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4748# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4749 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
4750# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4751 end if
4752# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4753
4754# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4755 case default
4756# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4757 if (proc_rank == 0) then
4758# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4759 call s_int_to_str(patch_id, istr)
4760# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4761 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
4762# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4763 end if
4764# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4765
4766# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4767 end select
4768# 468 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4769
4770 end if
4771
4772 ! Updating the patch identities bookkeeping variable
4773 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
4774
4775 q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* &
4776 exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
4777 end if
4778
4779 end do
4780 end do
4781 if (allocated(stored_values)) then
4782# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4783#ifdef MFC_DEBUG
4784# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4785 block
4786# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4787 use iso_fortran_env, only: output_unit
4788# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4789
4790# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4791 print *, 'm_icpp_patches.fpp:480: ', '@:DEALLOCATE(stored_values)'
4792# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4793
4794# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4795 call flush (output_unit)
4796# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4797 end block
4798# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4799#endif
4800# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4801
4802# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4803#if defined(MFC_OpenACC)
4804# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4805!$acc exit data delete(stored_values)
4806# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4807#elif defined(MFC_OpenMP)
4808# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4809!$omp target exit data map(release:stored_values)
4810# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4811#endif
4812# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4813 deallocate (stored_values)
4814# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4815#ifdef MFC_DEBUG
4816# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4817 block
4818# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4819 use iso_fortran_env, only: output_unit
4820# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4821
4822# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4823 print *, 'm_icpp_patches.fpp:480: ', '@:DEALLOCATE(x_coords)'
4824# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4825
4826# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4827 call flush (output_unit)
4828# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4829 end block
4830# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4831#endif
4832# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4833
4834# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4835#if defined(MFC_OpenACC)
4836# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4837!$acc exit data delete(x_coords)
4838# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4839#elif defined(MFC_OpenMP)
4840# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4841!$omp target exit data map(release:x_coords)
4842# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4843#endif
4844# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4845 deallocate (x_coords)
4846# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4847 end if
4848# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4849
4850# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4851 if (allocated(y_coords)) then
4852# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4853#ifdef MFC_DEBUG
4854# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4855 block
4856# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4857 use iso_fortran_env, only: output_unit
4858# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4859
4860# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4861 print *, 'm_icpp_patches.fpp:480: ', '@:DEALLOCATE(y_coords)'
4862# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4863
4864# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4865 call flush (output_unit)
4866# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4867 end block
4868# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4869#endif
4870# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4871
4872# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4873#if defined(MFC_OpenACC)
4874# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4875!$acc exit data delete(y_coords)
4876# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4877#elif defined(MFC_OpenMP)
4878# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4879!$omp target exit data map(release:y_coords)
4880# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4881#endif
4882# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4883 deallocate (y_coords)
4884# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4885 end if
4886
4887 end subroutine s_icpp_varcircle
4888
4889 !> @brief Initializes a 3D variable-thickness circular annulus patch extruded along the z-axis.
4890 !! @param patch_id is the patch identifier
4891 !! @param patch_id_fp Array to track patch ids
4892 !! @param q_prim_vf Array of primitive variables
4893 subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
4894
4895 ! Patch identifier
4896 integer, intent(in) :: patch_id
4897#ifdef MFC_MIXED_PRECISION
4898 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
4899#else
4900 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
4901#endif
4902 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
4903
4904 ! Generic loop iterators
4905 integer :: i, j, k
4906 real(wp) :: radius, myr, thickness
4907 integer :: xRows, yRows, nRows, iix, iiy, max_files
4908# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4909 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
4910# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4911 real(wp) :: x_len, x_step, y_len, y_step
4912# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4913 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
4914# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4915 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
4916# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4917 real(wp) :: delta_x, delta_y
4918# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4919 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
4920# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4921 character(len=200) :: errmsg
4922# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4923 real(wp), allocatable :: stored_values(:, :, :)
4924# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4925 real(wp), allocatable :: x_coords(:), y_coords(:)
4926# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4927 logical :: files_loaded = .false.
4928# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4929 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
4930# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4931 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
4932# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4933 character(len=20) :: file_num_str ! For storing the file number as a string
4934# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4935 character(len=20) :: zeros_part ! For the trailing zeros part
4936# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4937 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
4938 ! Place any declaration of intermediate variables here
4939# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4940 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
4941# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4942 real(wp) :: eps
4943# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4944
4945# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4946 ! IGR Jets
4947# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4948 ! Arrays to stor position and radii of jets from input file
4949# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4950 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
4951# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4952 ! Variables to describe initial condition of jet
4953# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4954 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
4955# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4956 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
4957# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4958
4959# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4960 real(wp), dimension(0:n, 0:p) :: rcut_arr
4961# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4962 integer :: l, q, s ! Iterators for reading input files
4963# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4964 integer :: start, end ! Ints to keep track of position in file
4965# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4966 character(len=1000) :: line ! String to store line in ile
4967# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4968 character(len=25) :: value ! String to store value in line
4969# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4970 integer :: NJet ! Number of jets
4971# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4972
4973# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4974 eps = 1e-9_wp
4975# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4976
4977# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4978 if (patch_icpp(patch_id)%hcid == 303) then
4979# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4980 eps_smooth = 3._wp
4981# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4982 open (unit=10, file="njet.txt", status="old", action="read")
4983# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4984 read (10, *) njet
4985# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4986 close (10)
4987# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4988
4989# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4990 allocate (y_th_arr(0:njet - 1))
4991# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4992 allocate (z_th_arr(0:njet - 1))
4993# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4994 allocate (r_th_arr(0:njet - 1))
4995# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4996
4997# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4998 open (unit=10, file="jets.csv", status="old", action="read")
4999# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5000 do q = 0, njet - 1
5001# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5002 read (10, '(A)') line ! Read a full line as a string
5003# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5004 start = 1
5005# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5006
5007# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5008 do l = 0, 2
5009# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5010 end = index(line(start:), ',') ! Find the next comma
5011# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5012 if (end == 0) then
5013# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5014 value = trim(adjustl(line(start:))) ! Last value in the line
5015# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5016 else
5017# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5018 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
5019# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5020 start = start + end ! Move to next value
5021# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5022 end if
5023# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5024 if (l == 0) then
5025# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5026 read (value, *) y_th_arr(q) ! Convert string to numeric value
5027# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5028 elseif (l == 1) then
5029# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5030 read (value, *) z_th_arr(q)
5031# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5032 else
5033# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5034 read (value, *) r_th_arr(q)
5035# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5036 end if
5037# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5038 end do
5039# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5040 end do
5041# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5042 close (10)
5043# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5044
5045# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5046 do q = 0, p
5047# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5048 do l = 0, n
5049# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5050 rcut = 0._wp
5051# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5052 do s = 0, njet - 1
5053# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5054 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
5055# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5056 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
5057# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5058 end do
5059# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5060 rcut_arr(l, q) = rcut
5061# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5062 end do
5063# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5064 end do
5065# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5066 end if
5067# 503 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5068
5069
5070 ! Transferring the circular patch's radius, centroid, smearing patch
5071 ! identity and smearing coefficient information
5072 x_centroid = patch_icpp(patch_id)%x_centroid
5073 y_centroid = patch_icpp(patch_id)%y_centroid
5074 z_centroid = patch_icpp(patch_id)%z_centroid
5075 length_z = patch_icpp(patch_id)%length_z
5076 radius = patch_icpp(patch_id)%radius
5077 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
5078 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
5079 thickness = patch_icpp(patch_id)%epsilon
5080
5081 ! Initializing the pseudo volume fraction value to 1. The value will
5082 ! be modified as the patch is laid out on the grid, but only in the
5083 ! case that smoothing of the circular patch's boundary is enabled.
5084 eta = 1._wp
5085
5086 ! write for all z
5087
5088 ! Checking whether the circle covers a particular cell in the domain
5089 ! and verifying whether the current patch has permission to write to
5090 ! that cell. If both queries check out, the primitive variables of
5091 ! the current patch are assigned to this cell.
5092 do k = 0, p
5093 do j = 0, n
5094 do i = 0, m
5095 myr = sqrt((x_cc(i) - x_centroid)**2 &
5096 + (y_cc(j) - y_centroid)**2)
5097
5098 if (myr <= radius + thickness/2._wp .and. &
5099 myr >= radius - thickness/2._wp .and. &
5100 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
5101
5102 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
5103 eta, q_prim_vf, patch_id_fp)
5104
5105
5106 if (patch_icpp(patch_id)%hcid /= dflt_int) then
5107
5108# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5109 select case (patch_icpp(patch_id)%hcid)
5110# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5111 case (300) ! Rayleigh-Taylor instability
5112# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5113 rhoh = 3._wp
5114# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5115 rhol = 1._wp
5116# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5117 pref = 1.e5_wp
5118# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5119 pint = pref
5120# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5121 h = 0.7_wp
5122# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5123 lam = 0.2_wp
5124# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5125 wl = 2._wp*pi/lam
5126# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5127 amp = 0.025_wp/wl
5128# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5129
5130# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5131 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
5132# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5133
5134# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5135 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
5136# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5137
5138# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5139 if (alph < eps) alph = eps
5140# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5141 if (alph > 1._wp - eps) alph = 1._wp - eps
5142# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5143
5144# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5145 if (y_cc(j) > inth) then
5146# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5147 q_prim_vf(advxb)%sf(i, j, k) = alph
5148# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5149 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
5150# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5151 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
5152# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5153 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
5154# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5155 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
5156# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5157 else
5158# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5159 q_prim_vf(advxb)%sf(i, j, k) = alph
5160# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5161 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
5162# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5163 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
5164# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5165 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
5166# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5167 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
5168# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5169 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
5170# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5171 end if
5172# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5173
5174# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5175 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
5176# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5177 h = 0.0_wp
5178# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5179 lam = 1.0_wp
5180# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5181 amp = patch_icpp(patch_id)%a(2)
5182# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5183 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
5184# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5185 if (x_cc(i) > inth) then
5186# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5187 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
5188# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5189 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
5190# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5191 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
5192# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5193 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
5194# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5195 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
5196# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5197 end if
5198# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5199
5200# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5201 case (302) ! 3D Jet with IGR
5202# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5203 ux_th = 10*sqrt(1.4*0.4)
5204# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5205 ux_am = 0.0*sqrt(1.4)
5206# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5207 p_th = 2.0_wp
5208# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5209 p_am = 1.0_wp
5210# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5211 rho_th = 1._wp
5212# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5213 rho_am = 1._wp
5214# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5215 y_th = 0.0_wp
5216# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5217 z_th = 0.0_wp
5218# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5219 r_th = 1._wp
5220# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5221 eps_smooth = 1._wp
5222# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5223 eps = 1e-6
5224# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5225
5226# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5227 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
5228# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5229 rcut = f_cut_on(r - r_th, eps_smooth)
5230# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5231 xcut = f_cut_on(x_cc(i), eps_smooth)
5232# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5233
5234# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5235 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5236# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5237 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
5238# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5239 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
5240# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5241
5242# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5243 if (num_fluids == 1) then
5244# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5245 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5246# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5247 else
5248# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5249 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5250# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5251 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
5252# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5253 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
5254# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5255 end if
5256# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5257
5258# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5259 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
5260# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5261
5262# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5263 case (303) ! 3D Multijet
5264# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5265
5266# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5267 eps_smooth = 3.0_wp
5268# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5269 ux_th = 10*sqrt(1.4*0.4)
5270# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5271 ux_am = 2.5*sqrt(1.4*0.4)
5272# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5273 p_th = 0.8_wp
5274# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5275 p_am = 0.4_wp
5276# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5277 rho_th = 1._wp
5278# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5279 rho_am = 1._wp
5280# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5281 eps = 1e-6
5282# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5283
5284# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5285 rcut = rcut_arr(j, k)
5286# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5287 xcut = f_cut_on(x_cc(i), eps_smooth)
5288# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5289
5290# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5291 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5292# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5293 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
5294# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5295 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
5296# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5297
5298# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5299 if (num_fluids == 1) then
5300# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5301 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5302# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5303 else
5304# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5305 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5306# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5307 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
5308# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5309 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
5310# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5311 end if
5312# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5313
5314# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5315 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
5316# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5317
5318# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5319 case (370)
5320# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5321 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
5322# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5323
5324# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5325 if (.not. files_loaded) then
5326# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5327 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5328# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5329 do f = 1, max_files
5330# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5331 write (file_num_str, '(I0)') f
5332# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5333 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
5334# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5335 end do
5336# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5337
5338# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5339 ! Common file reading setup
5340# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5341 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5342# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5343 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
5344# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5345
5346# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5347 select case (num_dims)
5348# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5349 case (1, 2) ! 1D and 2D cases are similar
5350# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5351 ! Count lines
5352# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5353 line_count = 0
5354# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5355 do
5356# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5357 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5358# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5359 if (ios2 /= 0) exit
5360# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5361 line_count = line_count + 1
5362# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5363 end do
5364# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5365 close (unit2)
5366# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5367
5368# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5369 xrows = line_count
5370# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5371 yrows = 1
5372# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5373 index_x = 0
5374# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5375 if (num_dims == 2) index_x = i
5376# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5377#ifdef MFC_DEBUG
5378# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5379 block
5380# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5381 use iso_fortran_env, only: output_unit
5382# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5383
5384# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5385 print *, 'm_icpp_patches.fpp:542: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5386# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5387
5388# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5389 call flush (output_unit)
5390# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5391 end block
5392# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5393#endif
5394# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5395 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5396# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5397
5398# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5399
5400# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5401
5402# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5403#if defined(MFC_OpenACC)
5404# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5405!$acc enter data create(x_coords, stored_values)
5406# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5407#elif defined(MFC_OpenMP)
5408# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5409!$omp target enter data map(always,alloc:x_coords, stored_values)
5410# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5411#endif
5412# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5413
5414# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5415 ! Read data from all files
5416# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5417 do f = 1, max_files
5418# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5419 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5420# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5421 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
5422# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5423
5424# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5425 do iter = 1, xrows
5426# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5427 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5428# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5429 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
5430# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5431 end do
5432# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5433 close (unit)
5434# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5435 end do
5436# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5437
5438# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5439 ! Calculate offsets
5440# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5441 domain_xstart = x_coords(1)
5442# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5443 x_step = x_cc(1) - x_cc(0)
5444# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5445 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
5446# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5447 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
5448# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5449 global_offset_x = nint(abs(delta_x)/x_step)
5450# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5451
5452# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5453 case (3) ! 3D case - determine grid structure
5454# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5455 ! Find yRows by counting rows with same x
5456# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5457 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5458# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5459 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5460# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5461
5462# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5463 yrows = 1
5464# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5465 do
5466# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5467 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5468# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5469 if (ios2 /= 0) exit
5470# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5471 if (dummy_x == x0 .and. dummy_y /= y0) then
5472# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5473 yrows = yrows + 1
5474# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5475 else
5476# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5477 exit
5478# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5479 end if
5480# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5481 end do
5482# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5483 close (unit2)
5484# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5485
5486# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5487 ! Count total rows
5488# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5489 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5490# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5491 nrows = 0
5492# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5493 do
5494# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5495 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5496# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5497 if (ios2 /= 0) exit
5498# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5499 nrows = nrows + 1
5500# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5501 end do
5502# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5503 close (unit2)
5504# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5505
5506# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5507 xrows = nrows/yrows
5508# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5509#ifdef MFC_DEBUG
5510# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5511 block
5512# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5513 use iso_fortran_env, only: output_unit
5514# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5515
5516# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5517 print *, 'm_icpp_patches.fpp:542: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5518# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5519
5520# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5521 call flush (output_unit)
5522# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5523 end block
5524# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5525#endif
5526# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5527 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5528# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5529
5530# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5531
5532# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5533
5534# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5535
5536# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5537#if defined(MFC_OpenACC)
5538# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5539!$acc enter data create(x_coords, y_coords, stored_values)
5540# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5541#elif defined(MFC_OpenMP)
5542# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5543!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5544# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5545#endif
5546# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5547 index_x = i
5548# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5549 index_y = j
5550# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5551
5552# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5553 ! Read all files
5554# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5555 do f = 1, max_files
5556# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5557 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5558# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5559 if (ios /= 0) then
5560# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5561 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
5562# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5563 cycle
5564# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5565 end if
5566# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5567
5568# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5569 iter = 0
5570# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5571 do iix = 1, xrows
5572# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5573 do iiy = 1, yrows
5574# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5575 iter = iter + 1
5576# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5577 if (f == 1) then
5578# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5579 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5580# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5581 else
5582# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5583 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5584# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5585 end if
5586# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5587 if (ios /= 0) call s_mpi_abort("Error reading data")
5588# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5589 end do
5590# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5591 end do
5592# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5593 close (unit)
5594# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5595 end do
5596# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5597
5598# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5599 ! Calculate offsets
5600# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5601 x_step = x_cc(1) - x_cc(0)
5602# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5603 y_step = y_cc(1) - y_cc(0)
5604# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5605 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
5606# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5607 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
5608# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5609 global_offset_x = nint(abs(delta_x)/x_step)
5610# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5611 global_offset_y = nint(abs(delta_y)/y_step)
5612# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5613 end select
5614# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5615
5616# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5617 files_loaded = .true.
5618# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5619 end if
5620# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5621
5622# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5623 ! Data assignment
5624# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5625 select case (num_dims)
5626# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5627 case (1)
5628# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5629 idx = i + 1 + global_offset_x
5630# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5631 do f = 1, sys_size
5632# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5633 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5634# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5635 end do
5636# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5637
5638# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5639 case (2)
5640# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5641 idx = i + 1 + global_offset_x - index_x
5642# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5643 do f = 1, sys_size - 1
5644# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5645 jump = merge(1, 0, f >= momxe)
5646# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5647 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5648# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5649 end do
5650# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5651 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
5652# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5653
5654# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5655 case (3)
5656# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5657 idx = i + 1 + global_offset_x - index_x
5658# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5659 idy = j + 1 + global_offset_y - index_y
5660# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5661 do f = 1, sys_size - 1
5662# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5663 jump = merge(1, 0, f >= momxe)
5664# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5665 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5666# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5667 end do
5668# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5669 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
5670# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5671 end select
5672# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5673
5674# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5675 case (380)
5676# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5677 ! This is patch is hard-coded for test suite optimization used in the
5678# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5679 ! 3D_TaylorGreenVortex case:
5680# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5681 ! This analytic patch used geometry 9
5682# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5683 mach = 0.1
5684# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5685 if (patch_id == 1) then
5686# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5687 q_prim_vf(e_idx)%sf(i, j, 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)
5688# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5689 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
5690# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5691 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
5692# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5693 end if
5694# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5695
5696# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5697 case default
5698# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5699 call s_int_to_str(patch_id, istr)
5700# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5701 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
5702# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5703 end select
5704# 542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5705
5706 end if
5707
5708 ! Updating the patch identities bookkeeping variable
5709 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
5710
5711 q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* &
5712 exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
5713 end if
5714
5715 end do
5716 end do
5717 end do
5718 if (allocated(stored_values)) then
5719# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5720#ifdef MFC_DEBUG
5721# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5722 block
5723# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5724 use iso_fortran_env, only: output_unit
5725# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5726
5727# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5728 print *, 'm_icpp_patches.fpp:555: ', '@:DEALLOCATE(stored_values)'
5729# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5730
5731# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5732 call flush (output_unit)
5733# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5734 end block
5735# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5736#endif
5737# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5738
5739# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5740#if defined(MFC_OpenACC)
5741# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5742!$acc exit data delete(stored_values)
5743# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5744#elif defined(MFC_OpenMP)
5745# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5746!$omp target exit data map(release:stored_values)
5747# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5748#endif
5749# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5750 deallocate (stored_values)
5751# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5752#ifdef MFC_DEBUG
5753# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5754 block
5755# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5756 use iso_fortran_env, only: output_unit
5757# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5758
5759# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5760 print *, 'm_icpp_patches.fpp:555: ', '@:DEALLOCATE(x_coords)'
5761# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5762
5763# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5764 call flush (output_unit)
5765# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5766 end block
5767# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5768#endif
5769# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5770
5771# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5772#if defined(MFC_OpenACC)
5773# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5774!$acc exit data delete(x_coords)
5775# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5776#elif defined(MFC_OpenMP)
5777# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5778!$omp target exit data map(release:x_coords)
5779# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5780#endif
5781# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5782 deallocate (x_coords)
5783# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5784 end if
5785# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5786
5787# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5788 if (allocated(y_coords)) then
5789# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5790#ifdef MFC_DEBUG
5791# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5792 block
5793# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5794 use iso_fortran_env, only: output_unit
5795# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5796
5797# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5798 print *, 'm_icpp_patches.fpp:555: ', '@:DEALLOCATE(y_coords)'
5799# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5800
5801# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5802 call flush (output_unit)
5803# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5804 end block
5805# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5806#endif
5807# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5808
5809# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5810#if defined(MFC_OpenACC)
5811# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5812!$acc exit data delete(y_coords)
5813# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5814#elif defined(MFC_OpenMP)
5815# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5816!$omp target exit data map(release:y_coords)
5817# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5818#endif
5819# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5820 deallocate (y_coords)
5821# 555 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5822 end if
5823
5824 end subroutine s_icpp_3dvarcircle
5825
5826 !> The elliptical patch is a 2D geometry. The geometry of
5827 !! the patch is well-defined when its centroid and radii
5828 !! are provided. Note that the elliptical patch DOES allow
5829 !! for the smoothing of its boundary
5830 !! @param patch_id is the patch identifier
5831 !! @param patch_id_fp Array to track patch ids
5832 !! @param q_prim_vf Array of primitive variables
5833 subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
5834
5835 integer, intent(in) :: patch_id
5836#ifdef MFC_MIXED_PRECISION
5837 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
5838#else
5839 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
5840#endif
5841 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
5842
5843 integer :: i, j, k !< Generic loop operators
5844 real(wp) :: a, b
5845 integer :: xRows, yRows, nRows, iix, iiy, max_files
5846# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5847 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
5848# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5849 real(wp) :: x_len, x_step, y_len, y_step
5850# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5851 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
5852# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5853 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
5854# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5855 real(wp) :: delta_x, delta_y
5856# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5857 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
5858# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5859 character(len=200) :: errmsg
5860# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5861 real(wp), allocatable :: stored_values(:, :, :)
5862# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5863 real(wp), allocatable :: x_coords(:), y_coords(:)
5864# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5865 logical :: files_loaded = .false.
5866# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5867 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
5868# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5869 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
5870# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5871 character(len=20) :: file_num_str ! For storing the file number as a string
5872# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5873 character(len=20) :: zeros_part ! For the trailing zeros part
5874# 578 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5875 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
5876 ! Place any declaration of intermediate variables here
5877# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5878 real(wp) :: eps, eps_mhd, C_mhd
5879# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5880 real(wp) :: r, rmax, gam, umax, p0
5881# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5882 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
5883# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5884 real(wp) :: factor
5885# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5886 real(wp) :: r0, alpha, r2
5887# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5888 real(wp) :: sinA, cosA
5889# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5890
5891# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5892 real(wp) :: r_sq
5893# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5894
5895# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5896 ! # 207
5897# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5898 real(wp) :: sigma, gauss1, gauss2
5899# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5900 ! # 208
5901# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5902 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
5903# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5904
5905# 579 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5906 eps = 1.e-9_wp
5907
5908 ! Transferring the elliptical patch's radii, centroid, smearing
5909 ! patch identity, and smearing coefficient information
5910 x_centroid = patch_icpp(patch_id)%x_centroid
5911 y_centroid = patch_icpp(patch_id)%y_centroid
5912 a = patch_icpp(patch_id)%radii(1)
5913 b = patch_icpp(patch_id)%radii(2)
5914 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
5915 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
5916
5917 ! Initializing the pseudo volume fraction value to 1. The value
5918 ! be modified as the patch is laid out on the grid, but only in
5919 ! the case that smoothing of the elliptical patch's boundary is
5920 ! enabled.
5921 eta = 1._wp
5922
5923 ! Checking whether the ellipse covers a particular cell in the
5924 ! domain and verifying whether the current patch has permission
5925 ! to write to that cell. If both queries check out, the primitive
5926 ! variables of the current patch are assigned to this cell.
5927 do j = 0, n
5928 do i = 0, m
5929
5930 if (patch_icpp(patch_id)%smoothen) then
5931 eta = tanh(smooth_coeff/min(dx, dy)* &
5932 (sqrt(((x_cc(i) - x_centroid)/a)**2 + &
5933 ((y_cc(j) - y_centroid)/b)**2) &
5934 - 1._wp))*(-0.5_wp) + 0.5_wp
5935 end if
5936
5937 if ((((x_cc(i) - x_centroid)/a)**2 + &
5938 ((y_cc(j) - y_centroid)/b)**2 <= 1._wp &
5939 .and. &
5940 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
5941 .or. &
5942 patch_id_fp(i, j, 0) == smooth_patch_id) &
5943 then
5944
5945 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
5946 eta, q_prim_vf, patch_id_fp)
5947
5948
5949 if (patch_icpp(patch_id)%hcid /= dflt_int) then
5950
5951# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5952 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
5953# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5954
5955# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5956 case (200)
5957# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5958 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
5959# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5960 ! Volume Fractions
5961# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5962 q_prim_vf(advxb)%sf(i, j, 0) = eps
5963# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5964 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
5965# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5966 ! Denssities
5967# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5968 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
5969# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5970 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
5971# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5972 ! Pressure
5973# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5974 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
5975# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5976 end if
5977# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5978 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
5979# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5980 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
5981# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5982 rmax = 0.2_wp
5983# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5984
5985# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5986 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
5987# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5988 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
5989# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5990 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
5991# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5992
5993# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5994 if (r < rmax) then
5995# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5996 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
5997# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5998 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
5999# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6000 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6001# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6002 else if (r < 2*rmax) then
6003# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6004 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6005# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6006 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6007# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6008 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
6009# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6010 else
6011# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6012 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
6013# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6014 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
6015# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6016 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
6017# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6018 end if
6019# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6020 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
6021# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6022 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
6023# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6024 rmax = 0.2_wp
6025# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6026
6027# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6028 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
6029# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6030 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
6031# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6032 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
6033# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6034
6035# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6036 if (r < rmax) then
6037# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6038 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6039# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6040 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6041# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6042 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6043# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6044 else if (r < 2*rmax) then
6045# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6046 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6047# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6048 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6049# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6050 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
6051# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6052 else
6053# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6054 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
6055# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6056 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
6057# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6058 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
6059# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6060 end if
6061# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6062
6063# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6064 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
6065# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6066 case (204) ! Rayleigh-Taylor instability
6067# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6068 rhoh = 3._wp
6069# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6070 rhol = 1._wp
6071# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6072 pref = 1.e5_wp
6073# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6074 pint = pref
6075# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6076 h = 0.7_wp
6077# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6078 lam = 0.2_wp
6079# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6080 wl = 2._wp*pi/lam
6081# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6082 amp = 0.05_wp/wl
6083# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6084
6085# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6086 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
6087# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6088
6089# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6090 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
6091# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6092
6093# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6094 if (alph < eps) alph = eps
6095# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6096 if (alph > 1._wp - eps) alph = 1._wp - eps
6097# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6098
6099# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6100 if (y_cc(j) > inth) then
6101# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6102 q_prim_vf(advxb)%sf(i, j, 0) = alph
6103# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6104 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
6105# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6106 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
6107# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6108 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
6109# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6110 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
6111# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6112 else
6113# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6114 q_prim_vf(advxb)%sf(i, j, 0) = alph
6115# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6116 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
6117# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6118 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
6119# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6120 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
6121# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6122 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
6123# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6124 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
6125# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6126 end if
6127# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6128
6129# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6130 case (205) ! 2D lung wave interaction problem
6131# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6132 h = 0.0_wp !non dim origin y
6133# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6134 lam = 1.0_wp !non dim lambda
6135# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6136 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
6137# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6138
6139# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6140 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
6141# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6142
6143# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6144 if (y_cc(j) > inth) then
6145# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6146 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6147# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6148 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6149# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6150 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
6151# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6152 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6153# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6154 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6155# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6156 end if
6157# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6158
6159# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6160 case (206) ! 2D lung wave interaction problem - horizontal domain
6161# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6162 h = 0.0_wp !non dim origin y
6163# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6164 lam = 1.0_wp !non dim lambda
6165# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6166 amp = patch_icpp(patch_id)%a(2)
6167# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6168
6169# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6170 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
6171# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6172
6173# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6174 if (x_cc(i) > intl) then !this is the liquid
6175# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6176 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6177# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6178 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6179# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6180 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
6181# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6182 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6183# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6184 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6185# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6186 end if
6187# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6188
6189# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6190 case (207) ! Kelvin Helmholtz Instability
6191# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6192 sigma = 0.05_wp/sqrt(2.0_wp)
6193# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6194 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
6195# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6196 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
6197# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6198 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
6199# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6200 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
6201# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6202
6203# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6204 case (208) ! Richtmeyer Meshkov Instability
6205# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6206 lam = 1.0_wp
6207# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6208 eps = 1.0e-6_wp
6209# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6210 ei = 5.0_wp
6211# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6212 ! Smoothening function to smooth out sharp discontinuity in the interface
6213# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6214 if (x_cc(i) <= 0.7_wp*lam) then
6215# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6216 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
6217# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6218 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
6219# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6220 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
6221# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6222 alpha_sf6 = 1.0_wp - alpha_air
6223# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6224 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
6225# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6226 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
6227# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6228 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
6229# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6230 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
6231# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6232 end if
6233# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6234
6235# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6236 case (250) ! MHD Orszag-Tang vortex
6237# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6238 ! gamma = 5/3
6239# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6240 ! rho = 25/(36*pi)
6241# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6242 ! p = 5/(12*pi)
6243# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6244 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
6245# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6246 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
6247# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6248
6249# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6250 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
6251# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6252 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
6253# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6254
6255# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6256 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
6257# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6258 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
6259# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6260
6261# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6262 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
6263# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6264 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
6265# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6266 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
6267# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6268 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
6269# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6270 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
6271# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6272 ! Linear interpolation between r=0.08 and r=1.0
6273# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6274 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
6275# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6276 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
6277# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6278 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
6279# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6280 else
6281# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6282 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
6283# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6284 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
6285# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6286 end if
6287# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6288
6289# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6290 ! case 252 is for the 2D MHD Rotor problem
6291# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6292 case (252) ! 2D MHD Rotor Problem
6293# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6294 ! Ambient conditions are set in the JSON file.
6295# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6296 ! This case imposes the dense, rotating cylinder.
6297# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6298 !
6299# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6300 ! gamma = 1.4
6301# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6302 ! Ambient medium (r > 0.1):
6303# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6304 ! rho = 1, p = 1, v = 0, B = (1,0,0)
6305# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6306 ! Rotor (r <= 0.1):
6307# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6308 ! rho = 10, p = 1
6309# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6310 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
6311# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6312
6313# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6314 ! Calculate distance squared from the center
6315# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6316 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
6317# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6318
6319# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6320 ! inner radius of 0.1
6321# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6322 if (r_sq <= 0.1**2) then
6323# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6324 ! -- Inside the rotor --
6325# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6326 ! Set density uniformly to 10
6327# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6328 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
6329# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6330
6331# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6332 ! Set vup constant rotation of rate v=2
6333# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6334 ! v_x = -omega * (y - y_c)
6335# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6336 ! v_y = omega * (x - x_c)
6337# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6338 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
6339# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6340 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
6341# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6342
6343# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6344 ! taper width of 0.015
6345# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6346 else if (r_sq <= 0.115**2) then
6347# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6348 ! linearly smooth the function between r = 0.1 and 0.115
6349# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6350 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6351# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6352
6353# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6354 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6355# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6356 q_prim_vf(momxb + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6357# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6358 end if
6359# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6360
6361# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6362 case (253) ! MHD Smooth Magnetic Vortex
6363# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6364 ! Section 5.2 of
6365# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6366 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
6367# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6368 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
6369# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6370
6371# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6372 ! velocity
6373# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6374 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
6375# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6376 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
6377# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6378
6379# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6380 ! magnetic field
6381# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6382 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
6383# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6384 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
6385# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6386
6387# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6388 ! pressure
6389# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6390 q_prim_vf(e_idx)%sf(i, j, 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)
6391# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6392
6393# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6394 case (260) ! Gaussian Divergence Pulse
6395# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6396 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
6397# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6398 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
6399# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6400 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
6401# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6402 ! ψ is initialized to zero everywhere.
6403# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6404
6405# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6406 eps_mhd = patch_icpp(patch_id)%a(2)
6407# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6408 sigma = patch_icpp(patch_id)%a(3)
6409# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6410 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
6411# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6412
6413# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6414 ! B-field
6415# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6416 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
6417# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6418
6419# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6420 case (261) ! Blob
6421# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6422 r0 = 1._wp/sqrt(8._wp)
6423# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6424 r2 = x_cc(i)**2 + y_cc(j)**2
6425# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6426 r = sqrt(r2)
6427# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6428 alpha = r/r0
6429# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6430 if (alpha < 1) then
6431# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6432 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
6433# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6434 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
6435# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6436 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
6437# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6438 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
6439# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6440 end if
6441# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6442
6443# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6444 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
6445# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6446 ! rotate by α = atan(2)
6447# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6448 alpha = atan(2._wp)
6449# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6450 cosa = cos(alpha)
6451# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6452 sina = sin(alpha)
6453# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6454 ! projection along shock normal
6455# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6456 r = x_cc(i)*cosa + y_cc(j)*sina
6457# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6458
6459# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6460 if (r <= 0.5_wp) then
6461# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6462 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
6463# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6464 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
6465# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6466 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
6467# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6468 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
6469# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6470 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
6471# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6472 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
6473# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6474 - (5._wp/sqrt(4._wp*pi))*sina
6475# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6476 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
6477# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6478 + (5._wp/sqrt(4._wp*pi))*cosa
6479# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6480 else
6481# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6482 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
6483# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6484 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
6485# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6486 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
6487# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6488 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
6489# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6490 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
6491# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6492 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
6493# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6494 - (5._wp/sqrt(4._wp*pi))*sina
6495# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6496 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
6497# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6498 + (5._wp/sqrt(4._wp*pi))*cosa
6499# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6500 end if
6501# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6502 ! v^z and B^z remain zero by default
6503# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6504
6505# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6506 case (270)
6507# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6508 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
6509# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6510
6511# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6512 if (.not. files_loaded) then
6513# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6514 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6515# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6516 do f = 1, max_files
6517# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6518 write (file_num_str, '(I0)') f
6519# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6520 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
6521# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6522 end do
6523# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6524
6525# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6526 ! Common file reading setup
6527# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6528 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6529# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6530 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
6531# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6532
6533# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6534 select case (num_dims)
6535# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6536 case (1, 2) ! 1D and 2D cases are similar
6537# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6538 ! Count lines
6539# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6540 line_count = 0
6541# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6542 do
6543# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6544 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6545# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6546 if (ios2 /= 0) exit
6547# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6548 line_count = line_count + 1
6549# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6550 end do
6551# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6552 close (unit2)
6553# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6554
6555# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6556 xrows = line_count
6557# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6558 yrows = 1
6559# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6560 index_x = 0
6561# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6562 if (num_dims == 2) index_x = i
6563# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6564#ifdef MFC_DEBUG
6565# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6566 block
6567# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6568 use iso_fortran_env, only: output_unit
6569# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6570
6571# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6572 print *, 'm_icpp_patches.fpp:623: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
6573# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6574
6575# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6576 call flush (output_unit)
6577# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6578 end block
6579# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6580#endif
6581# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6582 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6583# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6584
6585# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6586
6587# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6588
6589# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6590#if defined(MFC_OpenACC)
6591# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6592!$acc enter data create(x_coords, stored_values)
6593# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6594#elif defined(MFC_OpenMP)
6595# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6596!$omp target enter data map(always,alloc:x_coords, stored_values)
6597# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6598#endif
6599# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6600
6601# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6602 ! Read data from all files
6603# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6604 do f = 1, max_files
6605# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6606 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6607# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6608 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
6609# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6610
6611# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6612 do iter = 1, xrows
6613# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6614 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6615# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6616 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
6617# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6618 end do
6619# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6620 close (unit)
6621# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6622 end do
6623# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6624
6625# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6626 ! Calculate offsets
6627# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6628 domain_xstart = x_coords(1)
6629# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6630 x_step = x_cc(1) - x_cc(0)
6631# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6632 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
6633# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6634 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
6635# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6636 global_offset_x = nint(abs(delta_x)/x_step)
6637# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6638
6639# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6640 case (3) ! 3D case - determine grid structure
6641# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6642 ! Find yRows by counting rows with same x
6643# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6644 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6645# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6646 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
6647# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6648
6649# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6650 yrows = 1
6651# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6652 do
6653# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6654 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6655# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6656 if (ios2 /= 0) exit
6657# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6658 if (dummy_x == x0 .and. dummy_y /= y0) then
6659# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6660 yrows = yrows + 1
6661# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6662 else
6663# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6664 exit
6665# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6666 end if
6667# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6668 end do
6669# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6670 close (unit2)
6671# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6672
6673# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6674 ! Count total rows
6675# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6676 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6677# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6678 nrows = 0
6679# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6680 do
6681# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6682 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6683# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6684 if (ios2 /= 0) exit
6685# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6686 nrows = nrows + 1
6687# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6688 end do
6689# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6690 close (unit2)
6691# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6692
6693# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6694 xrows = nrows/yrows
6695# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6696#ifdef MFC_DEBUG
6697# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6698 block
6699# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6700 use iso_fortran_env, only: output_unit
6701# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6702
6703# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6704 print *, 'm_icpp_patches.fpp:623: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6705# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6706
6707# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6708 call flush (output_unit)
6709# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6710 end block
6711# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6712#endif
6713# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6714 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6715# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6716
6717# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6718
6719# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6720
6721# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6722
6723# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6724#if defined(MFC_OpenACC)
6725# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6726!$acc enter data create(x_coords, y_coords, stored_values)
6727# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6728#elif defined(MFC_OpenMP)
6729# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6730!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6731# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6732#endif
6733# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6734 index_x = i
6735# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6736 index_y = j
6737# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6738
6739# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6740 ! Read all files
6741# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6742 do f = 1, max_files
6743# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6744 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6745# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6746 if (ios /= 0) then
6747# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6748 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
6749# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6750 cycle
6751# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6752 end if
6753# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6754
6755# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6756 iter = 0
6757# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6758 do iix = 1, xrows
6759# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6760 do iiy = 1, yrows
6761# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6762 iter = iter + 1
6763# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6764 if (f == 1) then
6765# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6766 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6767# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6768 else
6769# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6770 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6771# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6772 end if
6773# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6774 if (ios /= 0) call s_mpi_abort("Error reading data")
6775# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6776 end do
6777# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6778 end do
6779# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6780 close (unit)
6781# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6782 end do
6783# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6784
6785# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6786 ! Calculate offsets
6787# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6788 x_step = x_cc(1) - x_cc(0)
6789# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6790 y_step = y_cc(1) - y_cc(0)
6791# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6792 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
6793# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6794 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
6795# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6796 global_offset_x = nint(abs(delta_x)/x_step)
6797# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6798 global_offset_y = nint(abs(delta_y)/y_step)
6799# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6800 end select
6801# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6802
6803# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6804 files_loaded = .true.
6805# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6806 end if
6807# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6808
6809# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6810 ! Data assignment
6811# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6812 select case (num_dims)
6813# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6814 case (1)
6815# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6816 idx = i + 1 + global_offset_x
6817# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6818 do f = 1, sys_size
6819# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6820 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6821# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6822 end do
6823# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6824
6825# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6826 case (2)
6827# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6828 idx = i + 1 + global_offset_x - index_x
6829# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6830 do f = 1, sys_size - 1
6831# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6832 jump = merge(1, 0, f >= momxe)
6833# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6834 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6835# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6836 end do
6837# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6838 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
6839# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6840
6841# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6842 case (3)
6843# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6844 idx = i + 1 + global_offset_x - index_x
6845# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6846 idy = j + 1 + global_offset_y - index_y
6847# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6848 do f = 1, sys_size - 1
6849# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6850 jump = merge(1, 0, f >= momxe)
6851# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6852 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6853# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6854 end do
6855# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6856 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
6857# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6858 end select
6859# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6860
6861# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6862 case (280)
6863# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6864 ! This is patch is hard-coded for test suite optimization used in the
6865# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6866 ! 2D_isentropicvortex case:
6867# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6868 ! This analytic patch uses geometry 2
6869# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6870 if (patch_id == 1) then
6871# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6872 q_prim_vf(e_idx)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
6873# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6874 q_prim_vf(contxb + 0)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
6875# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6876 q_prim_vf(momxb + 0)%sf(i, j, 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6877# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6878 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
6879# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6880 end if
6881# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6882
6883# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6884 case (281)
6885# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6886 ! This is patch is hard-coded for test suite optimization used in the
6887# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6888 ! 2D_acoustic_pulse case:
6889# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6890 ! This analytic patch uses geometry 2
6891# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6892 if (patch_id == 2) then
6893# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6894 q_prim_vf(e_idx)%sf(i, j, 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))
6895# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6896 q_prim_vf(contxb + 0)%sf(i, j, 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))
6897# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6898 end if
6899# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6900
6901# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6902 case (282)
6903# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6904 ! This is patch is hard-coded for test suite optimization used in the
6905# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6906 ! 2D_zero_circ_vortex case:
6907# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6908 ! This analytic patch uses geometry 2
6909# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6910 if (patch_id == 2) then
6911# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6912 q_prim_vf(e_idx)%sf(i, j, 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))
6913# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6914 q_prim_vf(contxb + 0)%sf(i, j, 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))
6915# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6916 q_prim_vf(momxb + 0)%sf(i, j, 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
6917# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6918 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
6919# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6920 end if
6921# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6922
6923# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6924 case default
6925# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6926 if (proc_rank == 0) then
6927# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6928 call s_int_to_str(patch_id, istr)
6929# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6930 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
6931# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6932 end if
6933# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6934
6935# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6936 end select
6937# 623 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6938
6939 end if
6940
6941 ! Updating the patch identities bookkeeping variable
6942 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
6943 end if
6944 end do
6945 end do
6946 if (allocated(stored_values)) then
6947# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6948#ifdef MFC_DEBUG
6949# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6950 block
6951# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6952 use iso_fortran_env, only: output_unit
6953# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6954
6955# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6956 print *, 'm_icpp_patches.fpp:631: ', '@:DEALLOCATE(stored_values)'
6957# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6958
6959# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6960 call flush (output_unit)
6961# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6962 end block
6963# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6964#endif
6965# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6966
6967# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6968#if defined(MFC_OpenACC)
6969# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6970!$acc exit data delete(stored_values)
6971# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6972#elif defined(MFC_OpenMP)
6973# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6974!$omp target exit data map(release:stored_values)
6975# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6976#endif
6977# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6978 deallocate (stored_values)
6979# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6980#ifdef MFC_DEBUG
6981# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6982 block
6983# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6984 use iso_fortran_env, only: output_unit
6985# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6986
6987# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6988 print *, 'm_icpp_patches.fpp:631: ', '@:DEALLOCATE(x_coords)'
6989# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6990
6991# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6992 call flush (output_unit)
6993# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6994 end block
6995# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6996#endif
6997# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6998
6999# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7000#if defined(MFC_OpenACC)
7001# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7002!$acc exit data delete(x_coords)
7003# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7004#elif defined(MFC_OpenMP)
7005# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7006!$omp target exit data map(release:x_coords)
7007# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7008#endif
7009# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7010 deallocate (x_coords)
7011# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7012 end if
7013# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7014
7015# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7016 if (allocated(y_coords)) then
7017# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7018#ifdef MFC_DEBUG
7019# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7020 block
7021# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7022 use iso_fortran_env, only: output_unit
7023# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7024
7025# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7026 print *, 'm_icpp_patches.fpp:631: ', '@:DEALLOCATE(y_coords)'
7027# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7028
7029# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7030 call flush (output_unit)
7031# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7032 end block
7033# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7034#endif
7035# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7036
7037# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7038#if defined(MFC_OpenACC)
7039# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7040!$acc exit data delete(y_coords)
7041# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7042#elif defined(MFC_OpenMP)
7043# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7044!$omp target exit data map(release:y_coords)
7045# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7046#endif
7047# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7048 deallocate (y_coords)
7049# 631 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7050 end if
7051
7052 end subroutine s_icpp_ellipse
7053
7054 !> The ellipsoidal patch is a 3D geometry. The geometry of
7055 !! the patch is well-defined when its centroid and radii
7056 !! are provided. Note that the ellipsoidal patch DOES allow
7057 !! for the smoothing of its boundary
7058 !! @param patch_id is the patch identifier
7059 !! @param patch_id_fp Array to track patch ids
7060 !! @param q_prim_vf Array of primitive variables
7061 subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
7062
7063 ! Patch identifier
7064 integer, intent(in) :: patch_id
7065#ifdef MFC_MIXED_PRECISION
7066 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
7067#else
7068 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
7069#endif
7070 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
7071
7072 ! Generic loop iterators
7073 integer :: i, j, k
7074 real(wp) :: a, b, c
7075 integer :: xRows, yRows, nRows, iix, iiy, max_files
7076# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7077 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
7078# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7079 real(wp) :: x_len, x_step, y_len, y_step
7080# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7081 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
7082# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7083 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
7084# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7085 real(wp) :: delta_x, delta_y
7086# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7087 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
7088# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7089 character(len=200) :: errmsg
7090# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7091 real(wp), allocatable :: stored_values(:, :, :)
7092# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7093 real(wp), allocatable :: x_coords(:), y_coords(:)
7094# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7095 logical :: files_loaded = .false.
7096# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7097 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
7098# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7099 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
7100# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7101 character(len=20) :: file_num_str ! For storing the file number as a string
7102# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7103 character(len=20) :: zeros_part ! For the trailing zeros part
7104# 656 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7105 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
7106 ! Place any declaration of intermediate variables here
7107# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7108 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
7109# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7110 real(wp) :: eps
7111# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7112
7113# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7114 ! IGR Jets
7115# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7116 ! Arrays to stor position and radii of jets from input file
7117# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7118 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
7119# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7120 ! Variables to describe initial condition of jet
7121# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7122 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
7123# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7124 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
7125# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7126
7127# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7128 real(wp), dimension(0:n, 0:p) :: rcut_arr
7129# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7130 integer :: l, q, s ! Iterators for reading input files
7131# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7132 integer :: start, end ! Ints to keep track of position in file
7133# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7134 character(len=1000) :: line ! String to store line in ile
7135# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7136 character(len=25) :: value ! String to store value in line
7137# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7138 integer :: NJet ! Number of jets
7139# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7140
7141# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7142 eps = 1e-9_wp
7143# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7144
7145# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7146 if (patch_icpp(patch_id)%hcid == 303) then
7147# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7148 eps_smooth = 3._wp
7149# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7150 open (unit=10, file="njet.txt", status="old", action="read")
7151# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7152 read (10, *) njet
7153# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7154 close (10)
7155# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7156
7157# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7158 allocate (y_th_arr(0:njet - 1))
7159# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7160 allocate (z_th_arr(0:njet - 1))
7161# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7162 allocate (r_th_arr(0:njet - 1))
7163# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7164
7165# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7166 open (unit=10, file="jets.csv", status="old", action="read")
7167# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7168 do q = 0, njet - 1
7169# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7170 read (10, '(A)') line ! Read a full line as a string
7171# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7172 start = 1
7173# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7174
7175# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7176 do l = 0, 2
7177# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7178 end = index(line(start:), ',') ! Find the next comma
7179# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7180 if (end == 0) then
7181# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7182 value = trim(adjustl(line(start:))) ! Last value in the line
7183# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7184 else
7185# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7186 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
7187# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7188 start = start + end ! Move to next value
7189# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7190 end if
7191# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7192 if (l == 0) then
7193# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7194 read (value, *) y_th_arr(q) ! Convert string to numeric value
7195# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7196 elseif (l == 1) then
7197# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7198 read (value, *) z_th_arr(q)
7199# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7200 else
7201# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7202 read (value, *) r_th_arr(q)
7203# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7204 end if
7205# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7206 end do
7207# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7208 end do
7209# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7210 close (10)
7211# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7212
7213# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7214 do q = 0, p
7215# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7216 do l = 0, n
7217# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7218 rcut = 0._wp
7219# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7220 do s = 0, njet - 1
7221# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7222 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
7223# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7224 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
7225# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7226 end do
7227# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7228 rcut_arr(l, q) = rcut
7229# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7230 end do
7231# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7232 end do
7233# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7234 end if
7235# 657 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7236
7237
7238 ! Transferring the ellipsoidal patch's radii, centroid, smearing
7239 ! patch identity, and smearing coefficient information
7240 x_centroid = patch_icpp(patch_id)%x_centroid
7241 y_centroid = patch_icpp(patch_id)%y_centroid
7242 z_centroid = patch_icpp(patch_id)%z_centroid
7243 a = patch_icpp(patch_id)%radii(1)
7244 b = patch_icpp(patch_id)%radii(2)
7245 c = patch_icpp(patch_id)%radii(3)
7246 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
7247 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
7248
7249 ! Initializing the pseudo volume fraction value to 1. The value
7250 ! be modified as the patch is laid out on the grid, but only in
7251 ! the case that smoothing of the ellipsoidal patch's boundary is
7252 ! enabled.
7253 eta = 1._wp
7254
7255 ! Checking whether the ellipsoid covers a particular cell in the
7256 ! domain and verifying whether the current patch has permission
7257 ! to write to that cell. If both queries check out, the primitive
7258 ! variables of the current patch are assigned to this cell.
7259 do k = 0, p
7260 do j = 0, n
7261 do i = 0, m
7262
7263 if (grid_geometry == 3) then
7265 else
7266 cart_y = y_cc(j)
7267 cart_z = z_cc(k)
7268 end if
7269
7270 if (patch_icpp(patch_id)%smoothen) then
7271 eta = tanh(smooth_coeff/min(dx, dy, dz)* &
7272 (sqrt(((x_cc(i) - x_centroid)/a)**2 + &
7273 ((cart_y - y_centroid)/b)**2 + &
7274 ((cart_z - z_centroid)/c)**2) &
7275 - 1._wp))*(-0.5_wp) + 0.5_wp
7276 end if
7277
7278 if ((((x_cc(i) - x_centroid)/a)**2 + &
7279 ((cart_y - y_centroid)/b)**2 + &
7280 ((cart_z - z_centroid)/c)**2 <= 1._wp &
7281 .and. &
7282 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) &
7283 .or. &
7284 patch_id_fp(i, j, k) == smooth_patch_id) &
7285 then
7286
7287 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
7288 eta, q_prim_vf, patch_id_fp)
7289
7290
7291 if (patch_icpp(patch_id)%hcid /= dflt_int) then
7292
7293# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7294 select case (patch_icpp(patch_id)%hcid)
7295# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7296 case (300) ! Rayleigh-Taylor instability
7297# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7298 rhoh = 3._wp
7299# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7300 rhol = 1._wp
7301# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7302 pref = 1.e5_wp
7303# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7304 pint = pref
7305# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7306 h = 0.7_wp
7307# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7308 lam = 0.2_wp
7309# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7310 wl = 2._wp*pi/lam
7311# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7312 amp = 0.025_wp/wl
7313# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7314
7315# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7316 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
7317# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7318
7319# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7320 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
7321# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7322
7323# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7324 if (alph < eps) alph = eps
7325# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7326 if (alph > 1._wp - eps) alph = 1._wp - eps
7327# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7328
7329# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7330 if (y_cc(j) > inth) then
7331# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7332 q_prim_vf(advxb)%sf(i, j, k) = alph
7333# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7334 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
7335# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7336 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
7337# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7338 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
7339# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7340 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
7341# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7342 else
7343# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7344 q_prim_vf(advxb)%sf(i, j, k) = alph
7345# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7346 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
7347# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7348 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
7349# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7350 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
7351# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7352 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
7353# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7354 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
7355# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7356 end if
7357# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7358
7359# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7360 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
7361# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7362 h = 0.0_wp
7363# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7364 lam = 1.0_wp
7365# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7366 amp = patch_icpp(patch_id)%a(2)
7367# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7368 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
7369# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7370 if (x_cc(i) > inth) then
7371# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7372 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
7373# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7374 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
7375# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7376 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
7377# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7378 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
7379# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7380 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
7381# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7382 end if
7383# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7384
7385# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7386 case (302) ! 3D Jet with IGR
7387# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7388 ux_th = 10*sqrt(1.4*0.4)
7389# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7390 ux_am = 0.0*sqrt(1.4)
7391# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7392 p_th = 2.0_wp
7393# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7394 p_am = 1.0_wp
7395# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7396 rho_th = 1._wp
7397# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7398 rho_am = 1._wp
7399# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7400 y_th = 0.0_wp
7401# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7402 z_th = 0.0_wp
7403# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7404 r_th = 1._wp
7405# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7406 eps_smooth = 1._wp
7407# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7408 eps = 1e-6
7409# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7410
7411# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7412 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
7413# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7414 rcut = f_cut_on(r - r_th, eps_smooth)
7415# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7416 xcut = f_cut_on(x_cc(i), eps_smooth)
7417# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7418
7419# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7420 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7421# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7422 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
7423# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7424 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
7425# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7426
7427# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7428 if (num_fluids == 1) then
7429# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7430 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7431# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7432 else
7433# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7434 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7435# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7436 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
7437# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7438 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
7439# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7440 end if
7441# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7442
7443# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7444 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
7445# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7446
7447# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7448 case (303) ! 3D Multijet
7449# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7450
7451# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7452 eps_smooth = 3.0_wp
7453# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7454 ux_th = 10*sqrt(1.4*0.4)
7455# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7456 ux_am = 2.5*sqrt(1.4*0.4)
7457# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7458 p_th = 0.8_wp
7459# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7460 p_am = 0.4_wp
7461# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7462 rho_th = 1._wp
7463# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7464 rho_am = 1._wp
7465# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7466 eps = 1e-6
7467# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7468
7469# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7470 rcut = rcut_arr(j, k)
7471# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7472 xcut = f_cut_on(x_cc(i), eps_smooth)
7473# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7474
7475# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7476 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7477# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7478 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
7479# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7480 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
7481# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7482
7483# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7484 if (num_fluids == 1) then
7485# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7486 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7487# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7488 else
7489# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7490 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7491# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7492 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
7493# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7494 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
7495# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7496 end if
7497# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7498
7499# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7500 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
7501# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7502
7503# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7504 case (370)
7505# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7506 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
7507# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7508
7509# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7510 if (.not. files_loaded) then
7511# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7512 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
7513# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7514 do f = 1, max_files
7515# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7516 write (file_num_str, '(I0)') f
7517# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7518 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
7519# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7520 end do
7521# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7522
7523# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7524 ! Common file reading setup
7525# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7526 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7527# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7528 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
7529# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7530
7531# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7532 select case (num_dims)
7533# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7534 case (1, 2) ! 1D and 2D cases are similar
7535# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7536 ! Count lines
7537# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7538 line_count = 0
7539# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7540 do
7541# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7542 read (unit2, *, iostat=ios2) dummy_x, dummy_y
7543# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7544 if (ios2 /= 0) exit
7545# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7546 line_count = line_count + 1
7547# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7548 end do
7549# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7550 close (unit2)
7551# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7552
7553# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7554 xrows = line_count
7555# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7556 yrows = 1
7557# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7558 index_x = 0
7559# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7560 if (num_dims == 2) index_x = i
7561# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7562#ifdef MFC_DEBUG
7563# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7564 block
7565# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7566 use iso_fortran_env, only: output_unit
7567# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7568
7569# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7570 print *, 'm_icpp_patches.fpp:713: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
7571# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7572
7573# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7574 call flush (output_unit)
7575# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7576 end block
7577# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7578#endif
7579# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7580 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
7581# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7582
7583# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7584
7585# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7586
7587# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7588#if defined(MFC_OpenACC)
7589# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7590!$acc enter data create(x_coords, stored_values)
7591# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7592#elif defined(MFC_OpenMP)
7593# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7594!$omp target enter data map(always,alloc:x_coords, stored_values)
7595# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7596#endif
7597# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7598
7599# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7600 ! Read data from all files
7601# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7602 do f = 1, max_files
7603# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7604 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7605# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7606 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
7607# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7608
7609# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7610 do iter = 1, xrows
7611# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7612 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
7613# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7614 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
7615# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7616 end do
7617# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7618 close (unit)
7619# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7620 end do
7621# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7622
7623# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7624 ! Calculate offsets
7625# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7626 domain_xstart = x_coords(1)
7627# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7628 x_step = x_cc(1) - x_cc(0)
7629# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7630 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
7631# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7632 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
7633# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7634 global_offset_x = nint(abs(delta_x)/x_step)
7635# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7636
7637# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7638 case (3) ! 3D case - determine grid structure
7639# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7640 ! Find yRows by counting rows with same x
7641# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7642 read (unit2, *, iostat=ios2) x0, y0, dummy_z
7643# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7644 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
7645# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7646
7647# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7648 yrows = 1
7649# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7650 do
7651# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7652 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7653# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7654 if (ios2 /= 0) exit
7655# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7656 if (dummy_x == x0 .and. dummy_y /= y0) then
7657# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7658 yrows = yrows + 1
7659# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7660 else
7661# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7662 exit
7663# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7664 end if
7665# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7666 end do
7667# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7668 close (unit2)
7669# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7670
7671# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7672 ! Count total rows
7673# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7674 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7675# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7676 nrows = 0
7677# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7678 do
7679# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7680 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7681# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7682 if (ios2 /= 0) exit
7683# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7684 nrows = nrows + 1
7685# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7686 end do
7687# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7688 close (unit2)
7689# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7690
7691# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7692 xrows = nrows/yrows
7693# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7694#ifdef MFC_DEBUG
7695# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7696 block
7697# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7698 use iso_fortran_env, only: output_unit
7699# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7700
7701# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7702 print *, 'm_icpp_patches.fpp:713: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
7703# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7704
7705# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7706 call flush (output_unit)
7707# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7708 end block
7709# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7710#endif
7711# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7712 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
7713# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7714
7715# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7716
7717# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7718
7719# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7720
7721# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7722#if defined(MFC_OpenACC)
7723# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7724!$acc enter data create(x_coords, y_coords, stored_values)
7725# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7726#elif defined(MFC_OpenMP)
7727# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7728!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
7729# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7730#endif
7731# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7732 index_x = i
7733# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7734 index_y = j
7735# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7736
7737# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7738 ! Read all files
7739# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7740 do f = 1, max_files
7741# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7742 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7743# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7744 if (ios /= 0) then
7745# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7746 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
7747# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7748 cycle
7749# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7750 end if
7751# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7752
7753# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7754 iter = 0
7755# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7756 do iix = 1, xrows
7757# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7758 do iiy = 1, yrows
7759# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7760 iter = iter + 1
7761# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7762 if (f == 1) then
7763# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7764 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
7765# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7766 else
7767# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7768 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
7769# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7770 end if
7771# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7772 if (ios /= 0) call s_mpi_abort("Error reading data")
7773# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7774 end do
7775# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7776 end do
7777# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7778 close (unit)
7779# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7780 end do
7781# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7782
7783# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7784 ! Calculate offsets
7785# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7786 x_step = x_cc(1) - x_cc(0)
7787# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7788 y_step = y_cc(1) - y_cc(0)
7789# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7790 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
7791# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7792 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
7793# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7794 global_offset_x = nint(abs(delta_x)/x_step)
7795# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7796 global_offset_y = nint(abs(delta_y)/y_step)
7797# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7798 end select
7799# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7800
7801# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7802 files_loaded = .true.
7803# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7804 end if
7805# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7806
7807# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7808 ! Data assignment
7809# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7810 select case (num_dims)
7811# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7812 case (1)
7813# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7814 idx = i + 1 + global_offset_x
7815# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7816 do f = 1, sys_size
7817# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7818 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
7819# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7820 end do
7821# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7822
7823# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7824 case (2)
7825# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7826 idx = i + 1 + global_offset_x - index_x
7827# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7828 do f = 1, sys_size - 1
7829# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7830 jump = merge(1, 0, f >= momxe)
7831# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7832 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
7833# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7834 end do
7835# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7836 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
7837# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7838
7839# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7840 case (3)
7841# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7842 idx = i + 1 + global_offset_x - index_x
7843# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7844 idy = j + 1 + global_offset_y - index_y
7845# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7846 do f = 1, sys_size - 1
7847# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7848 jump = merge(1, 0, f >= momxe)
7849# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7850 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
7851# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7852 end do
7853# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7854 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
7855# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7856 end select
7857# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7858
7859# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7860 case (380)
7861# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7862 ! This is patch is hard-coded for test suite optimization used in the
7863# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7864 ! 3D_TaylorGreenVortex case:
7865# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7866 ! This analytic patch used geometry 9
7867# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7868 mach = 0.1
7869# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7870 if (patch_id == 1) then
7871# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7872 q_prim_vf(e_idx)%sf(i, j, 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)
7873# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7874 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
7875# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7876 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
7877# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7878 end if
7879# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7880
7881# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7882 case default
7883# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7884 call s_int_to_str(patch_id, istr)
7885# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7886 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
7887# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7888 end select
7889# 713 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7890
7891 end if
7892
7893 ! Updating the patch identities bookkeeping variable
7894 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
7895 end if
7896 end do
7897 end do
7898 end do
7899 if (allocated(stored_values)) then
7900# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7901#ifdef MFC_DEBUG
7902# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7903 block
7904# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7905 use iso_fortran_env, only: output_unit
7906# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7907
7908# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7909 print *, 'm_icpp_patches.fpp:722: ', '@:DEALLOCATE(stored_values)'
7910# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7911
7912# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7913 call flush (output_unit)
7914# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7915 end block
7916# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7917#endif
7918# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7919
7920# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7921#if defined(MFC_OpenACC)
7922# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7923!$acc exit data delete(stored_values)
7924# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7925#elif defined(MFC_OpenMP)
7926# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7927!$omp target exit data map(release:stored_values)
7928# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7929#endif
7930# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7931 deallocate (stored_values)
7932# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7933#ifdef MFC_DEBUG
7934# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7935 block
7936# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7937 use iso_fortran_env, only: output_unit
7938# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7939
7940# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7941 print *, 'm_icpp_patches.fpp:722: ', '@:DEALLOCATE(x_coords)'
7942# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7943
7944# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7945 call flush (output_unit)
7946# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7947 end block
7948# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7949#endif
7950# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7951
7952# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7953#if defined(MFC_OpenACC)
7954# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7955!$acc exit data delete(x_coords)
7956# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7957#elif defined(MFC_OpenMP)
7958# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7959!$omp target exit data map(release:x_coords)
7960# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7961#endif
7962# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7963 deallocate (x_coords)
7964# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7965 end if
7966# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7967
7968# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7969 if (allocated(y_coords)) then
7970# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7971#ifdef MFC_DEBUG
7972# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7973 block
7974# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7975 use iso_fortran_env, only: output_unit
7976# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7977
7978# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7979 print *, 'm_icpp_patches.fpp:722: ', '@:DEALLOCATE(y_coords)'
7980# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7981
7982# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7983 call flush (output_unit)
7984# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7985 end block
7986# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7987#endif
7988# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7989
7990# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7991#if defined(MFC_OpenACC)
7992# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7993!$acc exit data delete(y_coords)
7994# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7995#elif defined(MFC_OpenMP)
7996# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7997!$omp target exit data map(release:y_coords)
7998# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7999#endif
8000# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8001 deallocate (y_coords)
8002# 722 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8003 end if
8004
8005 end subroutine s_icpp_ellipsoid
8006
8007 !> The rectangular patch is a 2D geometry that may be used,
8008 !! for example, in creating a solid boundary, or pre-/post-
8009 !! shock region, in alignment with the axes of the Cartesian
8010 !! coordinate system. The geometry of such a patch is well-
8011 !! defined when its centroid and lengths in the x- and y-
8012 !! coordinate directions are provided. Please note that the
8013 !! rectangular patch DOES NOT allow for the smoothing of its
8014 !! boundaries.
8015 !! @param patch_id is the patch identifier
8016 !! @param patch_id_fp Array to track patch ids
8017 !! @param q_prim_vf Array of primitive variables
8018 subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
8019
8020 integer, intent(in) :: patch_id
8021#ifdef MFC_MIXED_PRECISION
8022 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
8023#else
8024 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
8025#endif
8026 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
8027
8028 integer :: i, j, k !< generic loop iterators
8029 real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters
8030 integer :: xRows, yRows, nRows, iix, iiy, max_files
8031# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8032 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
8033# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8034 real(wp) :: x_len, x_step, y_len, y_step
8035# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8036 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
8037# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8038 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
8039# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8040 real(wp) :: delta_x, delta_y
8041# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8042 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
8043# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8044 character(len=200) :: errmsg
8045# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8046 real(wp), allocatable :: stored_values(:, :, :)
8047# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8048 real(wp), allocatable :: x_coords(:), y_coords(:)
8049# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8050 logical :: files_loaded = .false.
8051# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8052 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
8053# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8054 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
8055# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8056 character(len=20) :: file_num_str ! For storing the file number as a string
8057# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8058 character(len=20) :: zeros_part ! For the trailing zeros part
8059# 749 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8060 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
8061 ! Place any declaration of intermediate variables here
8062# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8063 real(wp) :: eps, eps_mhd, C_mhd
8064# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8065 real(wp) :: r, rmax, gam, umax, p0
8066# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8067 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
8068# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8069 real(wp) :: factor
8070# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8071 real(wp) :: r0, alpha, r2
8072# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8073 real(wp) :: sinA, cosA
8074# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8075
8076# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8077 real(wp) :: r_sq
8078# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8079
8080# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8081 ! # 207
8082# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8083 real(wp) :: sigma, gauss1, gauss2
8084# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8085 ! # 208
8086# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8087 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
8088# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8089
8090# 750 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8091 eps = 1.e-9_wp
8092
8093 pi_inf = pi_infs(1)
8094 gamma = gammas(1)
8095 lit_gamma = gs_min(1)
8096
8097 ! Transferring the rectangle's centroid and length information
8098 x_centroid = patch_icpp(patch_id)%x_centroid
8099 y_centroid = patch_icpp(patch_id)%y_centroid
8100 length_x = patch_icpp(patch_id)%length_x
8101 length_y = patch_icpp(patch_id)%length_y
8102
8103 ! Computing the beginning and the end x- and y-coordinates of the
8104 ! rectangle based on its centroid and lengths
8105 x_boundary%beg = x_centroid - 0.5_wp*length_x
8106 x_boundary%end = x_centroid + 0.5_wp*length_x
8107 y_boundary%beg = y_centroid - 0.5_wp*length_y
8108 y_boundary%end = y_centroid + 0.5_wp*length_y
8109
8110 ! Since the rectangular patch does not allow for its boundaries to
8111 ! be smoothed out, the pseudo volume fraction is set to 1 to ensure
8112 ! that only the current patch contributes to the fluid state in the
8113 ! cells that this patch covers.
8114 eta = 1._wp
8115
8116 ! Checking whether the rectangle covers a particular cell in the
8117 ! domain and verifying whether the current patch has the permission
8118 ! to write to that cell. If both queries check out, the primitive
8119 ! variables of the current patch are assigned to this cell.
8120 do j = 0, n
8121 do i = 0, m
8122 if (x_boundary%beg <= x_cc(i) .and. &
8123 x_boundary%end >= x_cc(i) .and. &
8124 y_boundary%beg <= y_cc(j) .and. &
8125 y_boundary%end >= y_cc(j)) then
8126 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
8127 then
8128
8129 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
8130 eta, q_prim_vf, patch_id_fp)
8131
8132
8133
8134 if (patch_icpp(patch_id)%hcid /= dflt_int) then
8135
8136# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8137 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
8138# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8139
8140# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8141 case (200)
8142# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8143 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
8144# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8145 ! Volume Fractions
8146# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8147 q_prim_vf(advxb)%sf(i, j, 0) = eps
8148# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8149 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
8150# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8151 ! Denssities
8152# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8153 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
8154# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8155 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
8156# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8157 ! Pressure
8158# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8159 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
8160# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8161 end if
8162# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8163 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
8164# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8165 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8166# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8167 rmax = 0.2_wp
8168# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8169
8170# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8171 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8172# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8173 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8174# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8175 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8176# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8177
8178# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8179 if (r < rmax) then
8180# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8181 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8182# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8183 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8184# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8185 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8186# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8187 else if (r < 2*rmax) then
8188# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8189 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8190# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8191 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8192# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8193 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
8194# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8195 else
8196# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8197 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
8198# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8199 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
8200# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8201 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
8202# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8203 end if
8204# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8205 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
8206# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8207 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8208# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8209 rmax = 0.2_wp
8210# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8211
8212# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8213 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8214# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8215 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8216# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8217 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8218# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8219
8220# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8221 if (r < rmax) then
8222# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8223 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8224# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8225 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8226# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8227 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8228# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8229 else if (r < 2*rmax) then
8230# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8231 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8232# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8233 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8234# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8235 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
8236# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8237 else
8238# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8239 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
8240# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8241 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
8242# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8243 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
8244# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8245 end if
8246# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8247
8248# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8249 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
8250# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8251 case (204) ! Rayleigh-Taylor instability
8252# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8253 rhoh = 3._wp
8254# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8255 rhol = 1._wp
8256# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8257 pref = 1.e5_wp
8258# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8259 pint = pref
8260# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8261 h = 0.7_wp
8262# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8263 lam = 0.2_wp
8264# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8265 wl = 2._wp*pi/lam
8266# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8267 amp = 0.05_wp/wl
8268# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8269
8270# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8271 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
8272# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8273
8274# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8275 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
8276# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8277
8278# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8279 if (alph < eps) alph = eps
8280# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8281 if (alph > 1._wp - eps) alph = 1._wp - eps
8282# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8283
8284# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8285 if (y_cc(j) > inth) then
8286# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8287 q_prim_vf(advxb)%sf(i, j, 0) = alph
8288# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8289 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
8290# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8291 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
8292# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8293 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
8294# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8295 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
8296# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8297 else
8298# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8299 q_prim_vf(advxb)%sf(i, j, 0) = alph
8300# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8301 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
8302# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8303 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
8304# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8305 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
8306# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8307 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
8308# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8309 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
8310# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8311 end if
8312# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8313
8314# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8315 case (205) ! 2D lung wave interaction problem
8316# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8317 h = 0.0_wp !non dim origin y
8318# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8319 lam = 1.0_wp !non dim lambda
8320# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8321 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
8322# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8323
8324# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8325 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
8326# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8327
8328# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8329 if (y_cc(j) > inth) then
8330# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8331 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8332# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8333 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8334# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8335 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
8336# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8337 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8338# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8339 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8340# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8341 end if
8342# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8343
8344# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8345 case (206) ! 2D lung wave interaction problem - horizontal domain
8346# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8347 h = 0.0_wp !non dim origin y
8348# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8349 lam = 1.0_wp !non dim lambda
8350# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8351 amp = patch_icpp(patch_id)%a(2)
8352# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8353
8354# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8355 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
8356# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8357
8358# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8359 if (x_cc(i) > intl) then !this is the liquid
8360# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8361 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8362# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8363 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8364# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8365 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
8366# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8367 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8368# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8369 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8370# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8371 end if
8372# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8373
8374# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8375 case (207) ! Kelvin Helmholtz Instability
8376# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8377 sigma = 0.05_wp/sqrt(2.0_wp)
8378# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8379 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
8380# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8381 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
8382# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8383 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
8384# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8385 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
8386# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8387
8388# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8389 case (208) ! Richtmeyer Meshkov Instability
8390# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8391 lam = 1.0_wp
8392# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8393 eps = 1.0e-6_wp
8394# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8395 ei = 5.0_wp
8396# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8397 ! Smoothening function to smooth out sharp discontinuity in the interface
8398# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8399 if (x_cc(i) <= 0.7_wp*lam) then
8400# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8401 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
8402# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8403 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
8404# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8405 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
8406# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8407 alpha_sf6 = 1.0_wp - alpha_air
8408# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8409 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
8410# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8411 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
8412# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8413 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
8414# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8415 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
8416# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8417 end if
8418# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8419
8420# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8421 case (250) ! MHD Orszag-Tang vortex
8422# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8423 ! gamma = 5/3
8424# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8425 ! rho = 25/(36*pi)
8426# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8427 ! p = 5/(12*pi)
8428# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8429 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
8430# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8431 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
8432# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8433
8434# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8435 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
8436# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8437 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
8438# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8439
8440# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8441 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
8442# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8443 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
8444# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8445
8446# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8447 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
8448# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8449 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
8450# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8451 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
8452# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8453 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
8454# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8455 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
8456# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8457 ! Linear interpolation between r=0.08 and r=1.0
8458# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8459 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
8460# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8461 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
8462# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8463 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
8464# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8465 else
8466# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8467 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
8468# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8469 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
8470# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8471 end if
8472# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8473
8474# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8475 ! case 252 is for the 2D MHD Rotor problem
8476# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8477 case (252) ! 2D MHD Rotor Problem
8478# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8479 ! Ambient conditions are set in the JSON file.
8480# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8481 ! This case imposes the dense, rotating cylinder.
8482# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8483 !
8484# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8485 ! gamma = 1.4
8486# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8487 ! Ambient medium (r > 0.1):
8488# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8489 ! rho = 1, p = 1, v = 0, B = (1,0,0)
8490# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8491 ! Rotor (r <= 0.1):
8492# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8493 ! rho = 10, p = 1
8494# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8495 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
8496# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8497
8498# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8499 ! Calculate distance squared from the center
8500# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8501 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
8502# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8503
8504# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8505 ! inner radius of 0.1
8506# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8507 if (r_sq <= 0.1**2) then
8508# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8509 ! -- Inside the rotor --
8510# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8511 ! Set density uniformly to 10
8512# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8513 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
8514# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8515
8516# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8517 ! Set vup constant rotation of rate v=2
8518# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8519 ! v_x = -omega * (y - y_c)
8520# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8521 ! v_y = omega * (x - x_c)
8522# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8523 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
8524# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8525 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
8526# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8527
8528# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8529 ! taper width of 0.015
8530# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8531 else if (r_sq <= 0.115**2) then
8532# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8533 ! linearly smooth the function between r = 0.1 and 0.115
8534# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8535 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8536# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8537
8538# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8539 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8540# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8541 q_prim_vf(momxb + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8542# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8543 end if
8544# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8545
8546# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8547 case (253) ! MHD Smooth Magnetic Vortex
8548# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8549 ! Section 5.2 of
8550# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8551 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
8552# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8553 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
8554# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8555
8556# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8557 ! velocity
8558# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8559 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
8560# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8561 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
8562# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8563
8564# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8565 ! magnetic field
8566# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8567 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
8568# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8569 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
8570# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8571
8572# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8573 ! pressure
8574# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8575 q_prim_vf(e_idx)%sf(i, j, 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)
8576# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8577
8578# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8579 case (260) ! Gaussian Divergence Pulse
8580# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8581 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
8582# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8583 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
8584# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8585 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
8586# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8587 ! ψ is initialized to zero everywhere.
8588# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8589
8590# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8591 eps_mhd = patch_icpp(patch_id)%a(2)
8592# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8593 sigma = patch_icpp(patch_id)%a(3)
8594# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8595 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
8596# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8597
8598# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8599 ! B-field
8600# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8601 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
8602# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8603
8604# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8605 case (261) ! Blob
8606# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8607 r0 = 1._wp/sqrt(8._wp)
8608# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8609 r2 = x_cc(i)**2 + y_cc(j)**2
8610# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8611 r = sqrt(r2)
8612# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8613 alpha = r/r0
8614# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8615 if (alpha < 1) then
8616# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8617 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
8618# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8619 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
8620# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8621 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
8622# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8623 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
8624# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8625 end if
8626# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8627
8628# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8629 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
8630# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8631 ! rotate by α = atan(2)
8632# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8633 alpha = atan(2._wp)
8634# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8635 cosa = cos(alpha)
8636# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8637 sina = sin(alpha)
8638# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8639 ! projection along shock normal
8640# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8641 r = x_cc(i)*cosa + y_cc(j)*sina
8642# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8643
8644# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8645 if (r <= 0.5_wp) then
8646# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8647 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
8648# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8649 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
8650# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8651 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
8652# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8653 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
8654# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8655 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
8656# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8657 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
8658# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8659 - (5._wp/sqrt(4._wp*pi))*sina
8660# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8661 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
8662# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8663 + (5._wp/sqrt(4._wp*pi))*cosa
8664# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8665 else
8666# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8667 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
8668# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8669 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
8670# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8671 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
8672# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8673 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
8674# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8675 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
8676# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8677 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
8678# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8679 - (5._wp/sqrt(4._wp*pi))*sina
8680# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8681 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
8682# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8683 + (5._wp/sqrt(4._wp*pi))*cosa
8684# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8685 end if
8686# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8687 ! v^z and B^z remain zero by default
8688# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8689
8690# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8691 case (270)
8692# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8693 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
8694# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8695
8696# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8697 if (.not. files_loaded) then
8698# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8699 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8700# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8701 do f = 1, max_files
8702# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8703 write (file_num_str, '(I0)') f
8704# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8705 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
8706# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8707 end do
8708# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8709
8710# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8711 ! Common file reading setup
8712# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8713 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8714# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8715 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
8716# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8717
8718# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8719 select case (num_dims)
8720# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8721 case (1, 2) ! 1D and 2D cases are similar
8722# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8723 ! Count lines
8724# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8725 line_count = 0
8726# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8727 do
8728# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8729 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8730# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8731 if (ios2 /= 0) exit
8732# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8733 line_count = line_count + 1
8734# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8735 end do
8736# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8737 close (unit2)
8738# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8739
8740# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8741 xrows = line_count
8742# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8743 yrows = 1
8744# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8745 index_x = 0
8746# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8747 if (num_dims == 2) index_x = i
8748# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8749#ifdef MFC_DEBUG
8750# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8751 block
8752# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8753 use iso_fortran_env, only: output_unit
8754# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8755
8756# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8757 print *, 'm_icpp_patches.fpp:794: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8758# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8759
8760# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8761 call flush (output_unit)
8762# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8763 end block
8764# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8765#endif
8766# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8767 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8768# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8769
8770# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8771
8772# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8773
8774# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8775#if defined(MFC_OpenACC)
8776# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8777!$acc enter data create(x_coords, stored_values)
8778# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8779#elif defined(MFC_OpenMP)
8780# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8781!$omp target enter data map(always,alloc:x_coords, stored_values)
8782# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8783#endif
8784# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8785
8786# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8787 ! Read data from all files
8788# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8789 do f = 1, max_files
8790# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8791 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8792# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8793 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
8794# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8795
8796# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8797 do iter = 1, xrows
8798# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8799 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8800# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8801 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
8802# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8803 end do
8804# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8805 close (unit)
8806# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8807 end do
8808# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8809
8810# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8811 ! Calculate offsets
8812# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8813 domain_xstart = x_coords(1)
8814# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8815 x_step = x_cc(1) - x_cc(0)
8816# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8817 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
8818# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8819 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
8820# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8821 global_offset_x = nint(abs(delta_x)/x_step)
8822# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8823
8824# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8825 case (3) ! 3D case - determine grid structure
8826# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8827 ! Find yRows by counting rows with same x
8828# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8829 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8830# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8831 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8832# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8833
8834# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8835 yrows = 1
8836# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8837 do
8838# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8839 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8840# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8841 if (ios2 /= 0) exit
8842# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8843 if (dummy_x == x0 .and. dummy_y /= y0) then
8844# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8845 yrows = yrows + 1
8846# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8847 else
8848# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8849 exit
8850# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8851 end if
8852# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8853 end do
8854# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8855 close (unit2)
8856# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8857
8858# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8859 ! Count total rows
8860# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8861 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8862# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8863 nrows = 0
8864# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8865 do
8866# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8867 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8868# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8869 if (ios2 /= 0) exit
8870# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8871 nrows = nrows + 1
8872# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8873 end do
8874# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8875 close (unit2)
8876# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8877
8878# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8879 xrows = nrows/yrows
8880# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8881#ifdef MFC_DEBUG
8882# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8883 block
8884# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8885 use iso_fortran_env, only: output_unit
8886# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8887
8888# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8889 print *, 'm_icpp_patches.fpp:794: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
8890# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8891
8892# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8893 call flush (output_unit)
8894# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8895 end block
8896# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8897#endif
8898# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8899 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
8900# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8901
8902# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8903
8904# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8905
8906# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8907
8908# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8909#if defined(MFC_OpenACC)
8910# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8911!$acc enter data create(x_coords, y_coords, stored_values)
8912# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8913#elif defined(MFC_OpenMP)
8914# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8915!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
8916# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8917#endif
8918# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8919 index_x = i
8920# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8921 index_y = j
8922# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8923
8924# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8925 ! Read all files
8926# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8927 do f = 1, max_files
8928# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8929 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8930# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8931 if (ios /= 0) then
8932# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8933 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
8934# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8935 cycle
8936# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8937 end if
8938# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8939
8940# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8941 iter = 0
8942# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8943 do iix = 1, xrows
8944# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8945 do iiy = 1, yrows
8946# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8947 iter = iter + 1
8948# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8949 if (f == 1) then
8950# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8951 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
8952# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8953 else
8954# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8955 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
8956# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8957 end if
8958# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8959 if (ios /= 0) call s_mpi_abort("Error reading data")
8960# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8961 end do
8962# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8963 end do
8964# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8965 close (unit)
8966# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8967 end do
8968# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8969
8970# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8971 ! Calculate offsets
8972# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8973 x_step = x_cc(1) - x_cc(0)
8974# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8975 y_step = y_cc(1) - y_cc(0)
8976# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8977 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
8978# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8979 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
8980# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8981 global_offset_x = nint(abs(delta_x)/x_step)
8982# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8983 global_offset_y = nint(abs(delta_y)/y_step)
8984# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8985 end select
8986# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8987
8988# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8989 files_loaded = .true.
8990# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8991 end if
8992# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8993
8994# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8995 ! Data assignment
8996# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8997 select case (num_dims)
8998# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8999 case (1)
9000# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9001 idx = i + 1 + global_offset_x
9002# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9003 do f = 1, sys_size
9004# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9005 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9006# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9007 end do
9008# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9009
9010# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9011 case (2)
9012# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9013 idx = i + 1 + global_offset_x - index_x
9014# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9015 do f = 1, sys_size - 1
9016# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9017 jump = merge(1, 0, f >= momxe)
9018# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9019 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9020# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9021 end do
9022# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9023 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
9024# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9025
9026# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9027 case (3)
9028# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9029 idx = i + 1 + global_offset_x - index_x
9030# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9031 idy = j + 1 + global_offset_y - index_y
9032# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9033 do f = 1, sys_size - 1
9034# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9035 jump = merge(1, 0, f >= momxe)
9036# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9037 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9038# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9039 end do
9040# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9041 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
9042# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9043 end select
9044# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9045
9046# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9047 case (280)
9048# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9049 ! This is patch is hard-coded for test suite optimization used in the
9050# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9051 ! 2D_isentropicvortex case:
9052# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9053 ! This analytic patch uses geometry 2
9054# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9055 if (patch_id == 1) then
9056# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9057 q_prim_vf(e_idx)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
9058# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9059 q_prim_vf(contxb + 0)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
9060# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9061 q_prim_vf(momxb + 0)%sf(i, j, 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9062# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9063 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
9064# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9065 end if
9066# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9067
9068# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9069 case (281)
9070# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9071 ! This is patch is hard-coded for test suite optimization used in the
9072# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9073 ! 2D_acoustic_pulse case:
9074# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9075 ! This analytic patch uses geometry 2
9076# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9077 if (patch_id == 2) then
9078# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9079 q_prim_vf(e_idx)%sf(i, j, 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))
9080# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9081 q_prim_vf(contxb + 0)%sf(i, j, 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))
9082# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9083 end if
9084# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9085
9086# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9087 case (282)
9088# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9089 ! This is patch is hard-coded for test suite optimization used in the
9090# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9091 ! 2D_zero_circ_vortex case:
9092# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9093 ! This analytic patch uses geometry 2
9094# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9095 if (patch_id == 2) then
9096# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9097 q_prim_vf(e_idx)%sf(i, j, 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))
9098# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9099 q_prim_vf(contxb + 0)%sf(i, j, 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))
9100# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9101 q_prim_vf(momxb + 0)%sf(i, j, 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9102# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9103 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
9104# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9105 end if
9106# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9107
9108# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9109 case default
9110# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9111 if (proc_rank == 0) then
9112# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9113 call s_int_to_str(patch_id, istr)
9114# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9115 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
9116# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9117 end if
9118# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9119
9120# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9121 end select
9122# 794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9123
9124 end if
9125
9126 if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then
9127 !zero density, reassign according to Tait EOS
9128 q_prim_vf(1)%sf(i, j, 0) = &
9129 (((q_prim_vf(e_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* &
9130 rhoref*(1._wp - q_prim_vf(alf_idx)%sf(i, j, 0))
9131 end if
9132
9133 ! Updating the patch identities bookkeeping variable
9134 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
9135 end if
9136 end if
9137 end do
9138 end do
9139 if (allocated(stored_values)) then
9140# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9141#ifdef MFC_DEBUG
9142# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9143 block
9144# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9145 use iso_fortran_env, only: output_unit
9146# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9147
9148# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9149 print *, 'm_icpp_patches.fpp:810: ', '@:DEALLOCATE(stored_values)'
9150# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9151
9152# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9153 call flush (output_unit)
9154# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9155 end block
9156# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9157#endif
9158# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9159
9160# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9161#if defined(MFC_OpenACC)
9162# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9163!$acc exit data delete(stored_values)
9164# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9165#elif defined(MFC_OpenMP)
9166# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9167!$omp target exit data map(release:stored_values)
9168# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9169#endif
9170# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9171 deallocate (stored_values)
9172# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9173#ifdef MFC_DEBUG
9174# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9175 block
9176# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9177 use iso_fortran_env, only: output_unit
9178# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9179
9180# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9181 print *, 'm_icpp_patches.fpp:810: ', '@:DEALLOCATE(x_coords)'
9182# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9183
9184# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9185 call flush (output_unit)
9186# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9187 end block
9188# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9189#endif
9190# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9191
9192# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9193#if defined(MFC_OpenACC)
9194# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9195!$acc exit data delete(x_coords)
9196# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9197#elif defined(MFC_OpenMP)
9198# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9199!$omp target exit data map(release:x_coords)
9200# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9201#endif
9202# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9203 deallocate (x_coords)
9204# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9205 end if
9206# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9207
9208# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9209 if (allocated(y_coords)) then
9210# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9211#ifdef MFC_DEBUG
9212# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9213 block
9214# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9215 use iso_fortran_env, only: output_unit
9216# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9217
9218# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9219 print *, 'm_icpp_patches.fpp:810: ', '@:DEALLOCATE(y_coords)'
9220# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9221
9222# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9223 call flush (output_unit)
9224# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9225 end block
9226# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9227#endif
9228# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9229
9230# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9231#if defined(MFC_OpenACC)
9232# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9233!$acc exit data delete(y_coords)
9234# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9235#elif defined(MFC_OpenMP)
9236# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9237!$omp target exit data map(release:y_coords)
9238# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9239#endif
9240# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9241 deallocate (y_coords)
9242# 810 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9243 end if
9244
9245 end subroutine s_icpp_rectangle
9246
9247 !> The swept line patch is a 2D geometry that may be used,
9248 !! for example, in creating a solid boundary, or pre-/post-
9249 !! shock region, at an angle with respect to the axes of the
9250 !! Cartesian coordinate system. The geometry of the patch is
9251 !! well-defined when its centroid and normal vector, aimed
9252 !! in the sweep direction, are provided. Note that the sweep
9253 !! line patch DOES allow the smoothing of its boundary.
9254 !! @param patch_id is the patch identifier
9255 !! @param patch_id_fp Array to track patch ids
9256 !! @param q_prim_vf Array of primitive variables
9257 subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
9258
9259 integer, intent(in) :: patch_id
9260#ifdef MFC_MIXED_PRECISION
9261 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
9262#else
9263 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
9264#endif
9265 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
9266
9267 integer :: i, j, k !< Generic loop operators
9268 real(wp) :: a, b, c
9269 integer :: xRows, yRows, nRows, iix, iiy, max_files
9270# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9271 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
9272# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9273 real(wp) :: x_len, x_step, y_len, y_step
9274# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9275 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
9276# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9277 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
9278# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9279 real(wp) :: delta_x, delta_y
9280# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9281 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
9282# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9283 character(len=200) :: errmsg
9284# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9285 real(wp), allocatable :: stored_values(:, :, :)
9286# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9287 real(wp), allocatable :: x_coords(:), y_coords(:)
9288# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9289 logical :: files_loaded = .false.
9290# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9291 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
9292# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9293 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
9294# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9295 character(len=20) :: file_num_str ! For storing the file number as a string
9296# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9297 character(len=20) :: zeros_part ! For the trailing zeros part
9298# 836 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9299 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
9300 ! Place any declaration of intermediate variables here
9301# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9302 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
9303# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9304 real(wp) :: eps
9305# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9306
9307# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9308 ! IGR Jets
9309# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9310 ! Arrays to stor position and radii of jets from input file
9311# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9312 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
9313# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9314 ! Variables to describe initial condition of jet
9315# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9316 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
9317# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9318 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
9319# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9320
9321# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9322 real(wp), dimension(0:n, 0:p) :: rcut_arr
9323# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9324 integer :: l, q, s ! Iterators for reading input files
9325# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9326 integer :: start, end ! Ints to keep track of position in file
9327# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9328 character(len=1000) :: line ! String to store line in ile
9329# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9330 character(len=25) :: value ! String to store value in line
9331# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9332 integer :: NJet ! Number of jets
9333# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9334
9335# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9336 eps = 1e-9_wp
9337# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9338
9339# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9340 if (patch_icpp(patch_id)%hcid == 303) then
9341# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9342 eps_smooth = 3._wp
9343# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9344 open (unit=10, file="njet.txt", status="old", action="read")
9345# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9346 read (10, *) njet
9347# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9348 close (10)
9349# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9350
9351# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9352 allocate (y_th_arr(0:njet - 1))
9353# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9354 allocate (z_th_arr(0:njet - 1))
9355# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9356 allocate (r_th_arr(0:njet - 1))
9357# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9358
9359# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9360 open (unit=10, file="jets.csv", status="old", action="read")
9361# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9362 do q = 0, njet - 1
9363# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9364 read (10, '(A)') line ! Read a full line as a string
9365# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9366 start = 1
9367# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9368
9369# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9370 do l = 0, 2
9371# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9372 end = index(line(start:), ',') ! Find the next comma
9373# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9374 if (end == 0) then
9375# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9376 value = trim(adjustl(line(start:))) ! Last value in the line
9377# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9378 else
9379# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9380 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
9381# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9382 start = start + end ! Move to next value
9383# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9384 end if
9385# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9386 if (l == 0) then
9387# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9388 read (value, *) y_th_arr(q) ! Convert string to numeric value
9389# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9390 elseif (l == 1) then
9391# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9392 read (value, *) z_th_arr(q)
9393# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9394 else
9395# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9396 read (value, *) r_th_arr(q)
9397# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9398 end if
9399# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9400 end do
9401# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9402 end do
9403# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9404 close (10)
9405# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9406
9407# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9408 do q = 0, p
9409# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9410 do l = 0, n
9411# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9412 rcut = 0._wp
9413# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9414 do s = 0, njet - 1
9415# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9416 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
9417# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9418 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
9419# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9420 end do
9421# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9422 rcut_arr(l, q) = rcut
9423# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9424 end do
9425# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9426 end do
9427# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9428 end if
9429# 837 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9430
9431
9432 ! Transferring the centroid information of the line to be swept
9433 x_centroid = patch_icpp(patch_id)%x_centroid
9434 y_centroid = patch_icpp(patch_id)%y_centroid
9435 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
9436 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
9437
9438 ! Obtaining coefficients of the equation describing the sweep line
9439 a = patch_icpp(patch_id)%normal(1)
9440 b = patch_icpp(patch_id)%normal(2)
9441 c = -a*x_centroid - b*y_centroid
9442
9443 ! Initializing the pseudo volume fraction value to 1. The value will
9444 ! be modified as the patch is laid out on the grid, but only in the
9445 ! case that smoothing of the sweep line patch's boundary is enabled.
9446 eta = 1._wp
9447
9448 ! Checking whether the region swept by the line covers a particular
9449 ! cell in the domain and verifying whether the current patch has the
9450 ! permission to write to that cell. If both queries check out, the
9451 ! primitive variables of the current patch are written to this cell.
9452 do j = 0, n
9453 do i = 0, m
9454
9455 if (patch_icpp(patch_id)%smoothen) then
9456 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy) &
9457 *(a*x_cc(i) + b*y_cc(j) + c) &
9458 /sqrt(a**2 + b**2))
9459 end if
9460
9461 if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp &
9462 .and. &
9463 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
9464 .or. &
9465 patch_id_fp(i, j, 0) == smooth_patch_id) &
9466 then
9467 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
9468 eta, q_prim_vf, patch_id_fp)
9469
9470
9471 if (patch_icpp(patch_id)%hcid /= dflt_int) then
9472
9473# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9474 select case (patch_icpp(patch_id)%hcid)
9475# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9476 case (300) ! Rayleigh-Taylor instability
9477# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9478 rhoh = 3._wp
9479# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9480 rhol = 1._wp
9481# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9482 pref = 1.e5_wp
9483# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9484 pint = pref
9485# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9486 h = 0.7_wp
9487# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9488 lam = 0.2_wp
9489# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9490 wl = 2._wp*pi/lam
9491# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9492 amp = 0.025_wp/wl
9493# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9494
9495# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9496 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
9497# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9498
9499# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9500 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
9501# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9502
9503# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9504 if (alph < eps) alph = eps
9505# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9506 if (alph > 1._wp - eps) alph = 1._wp - eps
9507# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9508
9509# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9510 if (y_cc(j) > inth) then
9511# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9512 q_prim_vf(advxb)%sf(i, j, k) = alph
9513# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9514 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
9515# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9516 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
9517# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9518 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
9519# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9520 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
9521# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9522 else
9523# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9524 q_prim_vf(advxb)%sf(i, j, k) = alph
9525# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9526 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
9527# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9528 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
9529# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9530 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
9531# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9532 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
9533# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9534 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
9535# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9536 end if
9537# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9538
9539# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9540 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
9541# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9542 h = 0.0_wp
9543# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9544 lam = 1.0_wp
9545# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9546 amp = patch_icpp(patch_id)%a(2)
9547# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9548 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
9549# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9550 if (x_cc(i) > inth) then
9551# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9552 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
9553# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9554 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
9555# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9556 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
9557# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9558 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
9559# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9560 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
9561# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9562 end if
9563# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9564
9565# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9566 case (302) ! 3D Jet with IGR
9567# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9568 ux_th = 10*sqrt(1.4*0.4)
9569# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9570 ux_am = 0.0*sqrt(1.4)
9571# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9572 p_th = 2.0_wp
9573# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9574 p_am = 1.0_wp
9575# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9576 rho_th = 1._wp
9577# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9578 rho_am = 1._wp
9579# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9580 y_th = 0.0_wp
9581# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9582 z_th = 0.0_wp
9583# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9584 r_th = 1._wp
9585# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9586 eps_smooth = 1._wp
9587# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9588 eps = 1e-6
9589# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9590
9591# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9592 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
9593# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9594 rcut = f_cut_on(r - r_th, eps_smooth)
9595# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9596 xcut = f_cut_on(x_cc(i), eps_smooth)
9597# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9598
9599# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9600 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9601# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9602 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
9603# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9604 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
9605# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9606
9607# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9608 if (num_fluids == 1) then
9609# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9610 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9611# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9612 else
9613# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9614 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9615# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9616 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
9617# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9618 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
9619# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9620 end if
9621# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9622
9623# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9624 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
9625# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9626
9627# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9628 case (303) ! 3D Multijet
9629# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9630
9631# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9632 eps_smooth = 3.0_wp
9633# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9634 ux_th = 10*sqrt(1.4*0.4)
9635# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9636 ux_am = 2.5*sqrt(1.4*0.4)
9637# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9638 p_th = 0.8_wp
9639# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9640 p_am = 0.4_wp
9641# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9642 rho_th = 1._wp
9643# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9644 rho_am = 1._wp
9645# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9646 eps = 1e-6
9647# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9648
9649# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9650 rcut = rcut_arr(j, k)
9651# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9652 xcut = f_cut_on(x_cc(i), eps_smooth)
9653# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9654
9655# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9656 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9657# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9658 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
9659# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9660 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
9661# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9662
9663# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9664 if (num_fluids == 1) then
9665# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9666 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9667# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9668 else
9669# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9670 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9671# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9672 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
9673# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9674 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
9675# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9676 end if
9677# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9678
9679# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9680 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
9681# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9682
9683# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9684 case (370)
9685# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9686 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
9687# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9688
9689# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9690 if (.not. files_loaded) then
9691# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9692 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
9693# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9694 do f = 1, max_files
9695# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9696 write (file_num_str, '(I0)') f
9697# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9698 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
9699# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9700 end do
9701# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9702
9703# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9704 ! Common file reading setup
9705# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9706 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9707# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9708 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
9709# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9710
9711# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9712 select case (num_dims)
9713# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9714 case (1, 2) ! 1D and 2D cases are similar
9715# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9716 ! Count lines
9717# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9718 line_count = 0
9719# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9720 do
9721# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9722 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9723# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9724 if (ios2 /= 0) exit
9725# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9726 line_count = line_count + 1
9727# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9728 end do
9729# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9730 close (unit2)
9731# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9732
9733# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9734 xrows = line_count
9735# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9736 yrows = 1
9737# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9738 index_x = 0
9739# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9740 if (num_dims == 2) index_x = i
9741# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9742#ifdef MFC_DEBUG
9743# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9744 block
9745# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9746 use iso_fortran_env, only: output_unit
9747# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9748
9749# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9750 print *, 'm_icpp_patches.fpp:879: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9751# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9752
9753# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9754 call flush (output_unit)
9755# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9756 end block
9757# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9758#endif
9759# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9760 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
9761# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9762
9763# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9764
9765# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9766
9767# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9768#if defined(MFC_OpenACC)
9769# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9770!$acc enter data create(x_coords, stored_values)
9771# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9772#elif defined(MFC_OpenMP)
9773# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9774!$omp target enter data map(always,alloc:x_coords, stored_values)
9775# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9776#endif
9777# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9778
9779# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9780 ! Read data from all files
9781# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9782 do f = 1, max_files
9783# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9784 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9785# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9786 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
9787# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9788
9789# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9790 do iter = 1, xrows
9791# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9792 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
9793# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9794 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
9795# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9796 end do
9797# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9798 close (unit)
9799# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9800 end do
9801# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9802
9803# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9804 ! Calculate offsets
9805# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9806 domain_xstart = x_coords(1)
9807# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9808 x_step = x_cc(1) - x_cc(0)
9809# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9810 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
9811# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9812 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
9813# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9814 global_offset_x = nint(abs(delta_x)/x_step)
9815# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9816
9817# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9818 case (3) ! 3D case - determine grid structure
9819# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9820 ! Find yRows by counting rows with same x
9821# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9822 read (unit2, *, iostat=ios2) x0, y0, dummy_z
9823# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9824 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
9825# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9826
9827# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9828 yrows = 1
9829# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9830 do
9831# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9832 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9833# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9834 if (ios2 /= 0) exit
9835# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9836 if (dummy_x == x0 .and. dummy_y /= y0) then
9837# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9838 yrows = yrows + 1
9839# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9840 else
9841# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9842 exit
9843# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9844 end if
9845# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9846 end do
9847# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9848 close (unit2)
9849# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9850
9851# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9852 ! Count total rows
9853# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9854 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9855# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9856 nrows = 0
9857# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9858 do
9859# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9860 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9861# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9862 if (ios2 /= 0) exit
9863# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9864 nrows = nrows + 1
9865# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9866 end do
9867# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9868 close (unit2)
9869# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9870
9871# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9872 xrows = nrows/yrows
9873# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9874#ifdef MFC_DEBUG
9875# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9876 block
9877# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9878 use iso_fortran_env, only: output_unit
9879# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9880
9881# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9882 print *, 'm_icpp_patches.fpp:879: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9883# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9884
9885# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9886 call flush (output_unit)
9887# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9888 end block
9889# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9890#endif
9891# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9892 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9893# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9894
9895# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9896
9897# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9898
9899# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9900
9901# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9902#if defined(MFC_OpenACC)
9903# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9904!$acc enter data create(x_coords, y_coords, stored_values)
9905# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9906#elif defined(MFC_OpenMP)
9907# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9908!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9909# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9910#endif
9911# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9912 index_x = i
9913# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9914 index_y = j
9915# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9916
9917# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9918 ! Read all files
9919# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9920 do f = 1, max_files
9921# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9922 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9923# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9924 if (ios /= 0) then
9925# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9926 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
9927# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9928 cycle
9929# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9930 end if
9931# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9932
9933# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9934 iter = 0
9935# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9936 do iix = 1, xrows
9937# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9938 do iiy = 1, yrows
9939# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9940 iter = iter + 1
9941# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9942 if (f == 1) then
9943# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9944 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9945# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9946 else
9947# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9948 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9949# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9950 end if
9951# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9952 if (ios /= 0) call s_mpi_abort("Error reading data")
9953# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9954 end do
9955# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9956 end do
9957# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9958 close (unit)
9959# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9960 end do
9961# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9962
9963# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9964 ! Calculate offsets
9965# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9966 x_step = x_cc(1) - x_cc(0)
9967# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9968 y_step = y_cc(1) - y_cc(0)
9969# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9970 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
9971# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9972 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
9973# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9974 global_offset_x = nint(abs(delta_x)/x_step)
9975# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9976 global_offset_y = nint(abs(delta_y)/y_step)
9977# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9978 end select
9979# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9980
9981# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9982 files_loaded = .true.
9983# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9984 end if
9985# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9986
9987# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9988 ! Data assignment
9989# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9990 select case (num_dims)
9991# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9992 case (1)
9993# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9994 idx = i + 1 + global_offset_x
9995# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9996 do f = 1, sys_size
9997# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9998 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9999# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10000 end do
10001# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10002
10003# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10004 case (2)
10005# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10006 idx = i + 1 + global_offset_x - index_x
10007# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10008 do f = 1, sys_size - 1
10009# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10010 jump = merge(1, 0, f >= momxe)
10011# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10012 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
10013# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10014 end do
10015# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10016 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
10017# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10018
10019# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10020 case (3)
10021# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10022 idx = i + 1 + global_offset_x - index_x
10023# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10024 idy = j + 1 + global_offset_y - index_y
10025# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10026 do f = 1, sys_size - 1
10027# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10028 jump = merge(1, 0, f >= momxe)
10029# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10030 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
10031# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10032 end do
10033# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10034 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
10035# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10036 end select
10037# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10038
10039# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10040 case (380)
10041# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10042 ! This is patch is hard-coded for test suite optimization used in the
10043# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10044 ! 3D_TaylorGreenVortex case:
10045# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10046 ! This analytic patch used geometry 9
10047# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10048 mach = 0.1
10049# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10050 if (patch_id == 1) then
10051# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10052 q_prim_vf(e_idx)%sf(i, j, 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)
10053# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10054 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
10055# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10056 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
10057# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10058 end if
10059# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10060
10061# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10062 case default
10063# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10064 call s_int_to_str(patch_id, istr)
10065# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10066 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
10067# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10068 end select
10069# 879 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10070
10071 end if
10072
10073 ! Updating the patch identities bookkeeping variable
10074 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
10075 end if
10076
10077 end do
10078 end do
10079 if (allocated(stored_values)) then
10080# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10081#ifdef MFC_DEBUG
10082# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10083 block
10084# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10085 use iso_fortran_env, only: output_unit
10086# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10087
10088# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10089 print *, 'm_icpp_patches.fpp:888: ', '@:DEALLOCATE(stored_values)'
10090# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10091
10092# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10093 call flush (output_unit)
10094# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10095 end block
10096# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10097#endif
10098# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10099
10100# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10101#if defined(MFC_OpenACC)
10102# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10103!$acc exit data delete(stored_values)
10104# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10105#elif defined(MFC_OpenMP)
10106# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10107!$omp target exit data map(release:stored_values)
10108# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10109#endif
10110# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10111 deallocate (stored_values)
10112# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10113#ifdef MFC_DEBUG
10114# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10115 block
10116# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10117 use iso_fortran_env, only: output_unit
10118# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10119
10120# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10121 print *, 'm_icpp_patches.fpp:888: ', '@:DEALLOCATE(x_coords)'
10122# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10123
10124# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10125 call flush (output_unit)
10126# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10127 end block
10128# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10129#endif
10130# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10131
10132# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10133#if defined(MFC_OpenACC)
10134# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10135!$acc exit data delete(x_coords)
10136# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10137#elif defined(MFC_OpenMP)
10138# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10139!$omp target exit data map(release:x_coords)
10140# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10141#endif
10142# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10143 deallocate (x_coords)
10144# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10145 end if
10146# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10147
10148# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10149 if (allocated(y_coords)) then
10150# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10151#ifdef MFC_DEBUG
10152# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10153 block
10154# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10155 use iso_fortran_env, only: output_unit
10156# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10157
10158# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10159 print *, 'm_icpp_patches.fpp:888: ', '@:DEALLOCATE(y_coords)'
10160# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10161
10162# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10163 call flush (output_unit)
10164# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10165 end block
10166# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10167#endif
10168# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10169
10170# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10171#if defined(MFC_OpenACC)
10172# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10173!$acc exit data delete(y_coords)
10174# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10175#elif defined(MFC_OpenMP)
10176# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10177!$omp target exit data map(release:y_coords)
10178# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10179#endif
10180# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10181 deallocate (y_coords)
10182# 888 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10183 end if
10184
10185 end subroutine s_icpp_sweep_line
10186
10187 !> The Taylor Green vortex is 2D decaying vortex that may be used,
10188 !! for example, to verify the effects of viscous attenuation.
10189 !! Geometry of the patch is well-defined when its centroid
10190 !! are provided.
10191 !! @param patch_id is the patch identifier
10192 !! @param patch_id_fp Array to track patch ids
10193 !! @param q_prim_vf Array of primitive variables
10194 subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
10195
10196 integer, intent(in) :: patch_id
10197#ifdef MFC_MIXED_PRECISION
10198 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
10199#else
10200 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
10201#endif
10202 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
10203
10204 integer :: i, j, k !< generic loop iterators
10205 real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters
10206 real(wp) :: L0, U0 !< Taylor Green Vortex parameters
10207 integer :: xRows, yRows, nRows, iix, iiy, max_files
10208# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10209 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
10210# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10211 real(wp) :: x_len, x_step, y_len, y_step
10212# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10213 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
10214# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10215 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
10216# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10217 real(wp) :: delta_x, delta_y
10218# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10219 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
10220# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10221 character(len=200) :: errmsg
10222# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10223 real(wp), allocatable :: stored_values(:, :, :)
10224# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10225 real(wp), allocatable :: x_coords(:), y_coords(:)
10226# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10227 logical :: files_loaded = .false.
10228# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10229 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
10230# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10231 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
10232# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10233 character(len=20) :: file_num_str ! For storing the file number as a string
10234# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10235 character(len=20) :: zeros_part ! For the trailing zeros part
10236# 912 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10237 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
10238 ! Place any declaration of intermediate variables here
10239# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10240 real(wp) :: eps, eps_mhd, C_mhd
10241# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10242 real(wp) :: r, rmax, gam, umax, p0
10243# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10244 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
10245# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10246 real(wp) :: factor
10247# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10248 real(wp) :: r0, alpha, r2
10249# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10250 real(wp) :: sinA, cosA
10251# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10252
10253# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10254 real(wp) :: r_sq
10255# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10256
10257# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10258 ! # 207
10259# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10260 real(wp) :: sigma, gauss1, gauss2
10261# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10262 ! # 208
10263# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10264 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
10265# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10266
10267# 913 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10268 eps = 1.e-9_wp
10269
10270 pi_inf = pi_infs(1)
10271 gamma = gammas(1)
10272 lit_gamma = gs_min(1)
10273
10274 ! Transferring the patch's centroid and length information
10275 x_centroid = patch_icpp(patch_id)%x_centroid
10276 y_centroid = patch_icpp(patch_id)%y_centroid
10277 length_x = patch_icpp(patch_id)%length_x
10278 length_y = patch_icpp(patch_id)%length_y
10279
10280 ! Computing the beginning and the end x- and y-coordinates
10281 ! of the patch based on its centroid and lengths
10282 x_boundary%beg = x_centroid - 0.5_wp*length_x
10283 x_boundary%end = x_centroid + 0.5_wp*length_x
10284 y_boundary%beg = y_centroid - 0.5_wp*length_y
10285 y_boundary%end = y_centroid + 0.5_wp*length_y
10286
10287 ! Since the patch doesn't allow for its boundaries to be
10288 ! smoothed out, the pseudo volume fraction is set to 1 to
10289 ! ensure that only the current patch contributes to the fluid
10290 ! state in the cells that this patch covers.
10291 eta = 1._wp
10292 ! U0 is the characteristic velocity of the vortex
10293 u0 = patch_icpp(patch_id)%vel(1)
10294 ! L0 is the characteristic length of the vortex
10295 l0 = patch_icpp(patch_id)%vel(2)
10296 ! Checking whether the patch covers a particular cell in the
10297 ! domain and verifying whether the current patch has the
10298 ! permission to write to that cell. If both queries check out,
10299 ! the primitive variables of the current patch are assigned
10300 ! to this cell.
10301 do j = 0, n
10302 do i = 0, m
10303 if (x_boundary%beg <= x_cc(i) .and. &
10304 x_boundary%end >= x_cc(i) .and. &
10305 y_boundary%beg <= y_cc(j) .and. &
10306 y_boundary%end >= y_cc(j) .and. &
10307 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
10308
10309 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
10310 eta, q_prim_vf, patch_id_fp)
10311
10312
10313 if (patch_icpp(patch_id)%hcid /= dflt_int) then
10314
10315# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10316 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
10317# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10318
10319# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10320 case (200)
10321# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10322 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
10323# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10324 ! Volume Fractions
10325# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10326 q_prim_vf(advxb)%sf(i, j, 0) = eps
10327# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10328 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
10329# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10330 ! Denssities
10331# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10332 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
10333# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10334 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
10335# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10336 ! Pressure
10337# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10338 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
10339# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10340 end if
10341# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10342 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
10343# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10344 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10345# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10346 rmax = 0.2_wp
10347# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10348
10349# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10350 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10351# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10352 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10353# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10354 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10355# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10356
10357# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10358 if (r < rmax) then
10359# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10360 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10361# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10362 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10363# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10364 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10365# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10366 else if (r < 2*rmax) then
10367# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10368 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10369# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10370 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10371# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10372 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
10373# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10374 else
10375# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10376 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
10377# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10378 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
10379# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10380 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
10381# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10382 end if
10383# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10384 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
10385# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10386 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10387# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10388 rmax = 0.2_wp
10389# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10390
10391# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10392 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10393# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10394 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10395# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10396 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10397# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10398
10399# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10400 if (r < rmax) then
10401# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10402 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10403# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10404 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10405# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10406 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10407# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10408 else if (r < 2*rmax) then
10409# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10410 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10411# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10412 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10413# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10414 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4._wp*(1._wp - (r/rmax) + log(r/rmax)))
10415# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10416 else
10417# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10418 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
10419# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10420 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
10421# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10422 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
10423# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10424 end if
10425# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10426
10427# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10428 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
10429# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10430 case (204) ! Rayleigh-Taylor instability
10431# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10432 rhoh = 3._wp
10433# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10434 rhol = 1._wp
10435# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10436 pref = 1.e5_wp
10437# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10438 pint = pref
10439# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10440 h = 0.7_wp
10441# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10442 lam = 0.2_wp
10443# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10444 wl = 2._wp*pi/lam
10445# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10446 amp = 0.05_wp/wl
10447# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10448
10449# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10450 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
10451# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10452
10453# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10454 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
10455# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10456
10457# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10458 if (alph < eps) alph = eps
10459# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10460 if (alph > 1._wp - eps) alph = 1._wp - eps
10461# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10462
10463# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10464 if (y_cc(j) > inth) then
10465# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10466 q_prim_vf(advxb)%sf(i, j, 0) = alph
10467# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10468 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
10469# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10470 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
10471# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10472 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
10473# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10474 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
10475# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10476 else
10477# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10478 q_prim_vf(advxb)%sf(i, j, 0) = alph
10479# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10480 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
10481# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10482 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
10483# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10484 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
10485# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10486 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
10487# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10488 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
10489# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10490 end if
10491# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10492
10493# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10494 case (205) ! 2D lung wave interaction problem
10495# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10496 h = 0.0_wp !non dim origin y
10497# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10498 lam = 1.0_wp !non dim lambda
10499# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10500 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
10501# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10502
10503# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10504 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
10505# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10506
10507# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10508 if (y_cc(j) > inth) then
10509# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10510 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10511# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10512 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10513# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10514 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
10515# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10516 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10517# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10518 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10519# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10520 end if
10521# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10522
10523# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10524 case (206) ! 2D lung wave interaction problem - horizontal domain
10525# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10526 h = 0.0_wp !non dim origin y
10527# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10528 lam = 1.0_wp !non dim lambda
10529# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10530 amp = patch_icpp(patch_id)%a(2)
10531# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10532
10533# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10534 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
10535# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10536
10537# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10538 if (x_cc(i) > intl) then !this is the liquid
10539# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10540 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10541# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10542 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10543# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10544 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
10545# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10546 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10547# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10548 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10549# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10550 end if
10551# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10552
10553# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10554 case (207) ! Kelvin Helmholtz Instability
10555# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10556 sigma = 0.05_wp/sqrt(2.0_wp)
10557# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10558 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
10559# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10560 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
10561# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10562 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
10563# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10564 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
10565# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10566
10567# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10568 case (208) ! Richtmeyer Meshkov Instability
10569# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10570 lam = 1.0_wp
10571# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10572 eps = 1.0e-6_wp
10573# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10574 ei = 5.0_wp
10575# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10576 ! Smoothening function to smooth out sharp discontinuity in the interface
10577# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10578 if (x_cc(i) <= 0.7_wp*lam) then
10579# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10580 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
10581# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10582 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
10583# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10584 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
10585# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10586 alpha_sf6 = 1.0_wp - alpha_air
10587# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10588 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
10589# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10590 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
10591# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10592 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
10593# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10594 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
10595# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10596 end if
10597# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10598
10599# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10600 case (250) ! MHD Orszag-Tang vortex
10601# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10602 ! gamma = 5/3
10603# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10604 ! rho = 25/(36*pi)
10605# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10606 ! p = 5/(12*pi)
10607# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10608 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
10609# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10610 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
10611# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10612
10613# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10614 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
10615# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10616 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
10617# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10618
10619# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10620 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
10621# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10622 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
10623# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10624
10625# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10626 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
10627# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10628 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
10629# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10630 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
10631# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10632 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
10633# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10634 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
10635# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10636 ! Linear interpolation between r=0.08 and r=1.0
10637# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10638 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
10639# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10640 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
10641# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10642 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
10643# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10644 else
10645# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10646 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
10647# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10648 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
10649# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10650 end if
10651# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10652
10653# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10654 ! case 252 is for the 2D MHD Rotor problem
10655# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10656 case (252) ! 2D MHD Rotor Problem
10657# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10658 ! Ambient conditions are set in the JSON file.
10659# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10660 ! This case imposes the dense, rotating cylinder.
10661# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10662 !
10663# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10664 ! gamma = 1.4
10665# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10666 ! Ambient medium (r > 0.1):
10667# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10668 ! rho = 1, p = 1, v = 0, B = (1,0,0)
10669# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10670 ! Rotor (r <= 0.1):
10671# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10672 ! rho = 10, p = 1
10673# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10674 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
10675# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10676
10677# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10678 ! Calculate distance squared from the center
10679# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10680 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
10681# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10682
10683# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10684 ! inner radius of 0.1
10685# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10686 if (r_sq <= 0.1**2) then
10687# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10688 ! -- Inside the rotor --
10689# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10690 ! Set density uniformly to 10
10691# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10692 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
10693# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10694
10695# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10696 ! Set vup constant rotation of rate v=2
10697# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10698 ! v_x = -omega * (y - y_c)
10699# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10700 ! v_y = omega * (x - x_c)
10701# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10702 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
10703# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10704 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
10705# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10706
10707# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10708 ! taper width of 0.015
10709# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10710 else if (r_sq <= 0.115**2) then
10711# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10712 ! linearly smooth the function between r = 0.1 and 0.115
10713# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10714 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10715# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10716
10717# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10718 q_prim_vf(momxb)%sf(i, j, 0) = -(2._wp/sqrt(r_sq))*(y_cc(j) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10719# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10720 q_prim_vf(momxb + 1)%sf(i, j, 0) = (2._wp/sqrt(r_sq))*(x_cc(i) - 0.5_wp)*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10721# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10722 end if
10723# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10724
10725# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10726 case (253) ! MHD Smooth Magnetic Vortex
10727# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10728 ! Section 5.2 of
10729# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10730 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
10731# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10732 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
10733# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10734
10735# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10736 ! velocity
10737# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10738 q_prim_vf(momxb)%sf(i, j, 0) = 1._wp - (y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
10739# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10740 q_prim_vf(momxb + 1)%sf(i, j, 0) = 1._wp + (x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi))
10741# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10742
10743# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10744 ! magnetic field
10745# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10746 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -y_cc(j)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
10747# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10748 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = x_cc(i)*exp(1 - (x_cc(i)**2 + y_cc(j)**2))/(2.*pi)
10749# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10750
10751# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10752 ! pressure
10753# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10754 q_prim_vf(e_idx)%sf(i, j, 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)
10755# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10756
10757# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10758 case (260) ! Gaussian Divergence Pulse
10759# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10760 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
10761# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10762 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
10763# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10764 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
10765# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10766 ! ψ is initialized to zero everywhere.
10767# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10768
10769# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10770 eps_mhd = patch_icpp(patch_id)%a(2)
10771# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10772 sigma = patch_icpp(patch_id)%a(3)
10773# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10774 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
10775# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10776
10777# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10778 ! B-field
10779# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10780 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
10781# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10782
10783# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10784 case (261) ! Blob
10785# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10786 r0 = 1._wp/sqrt(8._wp)
10787# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10788 r2 = x_cc(i)**2 + y_cc(j)**2
10789# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10790 r = sqrt(r2)
10791# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10792 alpha = r/r0
10793# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10794 if (alpha < 1) then
10795# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10796 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
10797# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10798 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/sqrt(4000._wp*pi) * (4096._wp*r2**4 - 128._wp*r2**2 + 1._wp)
10799# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10800 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
10801# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10802 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
10803# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10804 end if
10805# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10806
10807# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10808 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
10809# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10810 ! rotate by α = atan(2)
10811# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10812 alpha = atan(2._wp)
10813# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10814 cosa = cos(alpha)
10815# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10816 sina = sin(alpha)
10817# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10818 ! projection along shock normal
10819# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10820 r = x_cc(i)*cosa + y_cc(j)*sina
10821# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10822
10823# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10824 if (r <= 0.5_wp) then
10825# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10826 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
10827# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10828 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
10829# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10830 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
10831# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10832 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
10833# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10834 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
10835# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10836 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
10837# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10838 - (5._wp/sqrt(4._wp*pi))*sina
10839# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10840 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
10841# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10842 + (5._wp/sqrt(4._wp*pi))*cosa
10843# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10844 else
10845# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10846 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
10847# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10848 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
10849# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10850 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
10851# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10852 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
10853# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10854 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
10855# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10856 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
10857# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10858 - (5._wp/sqrt(4._wp*pi))*sina
10859# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10860 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
10861# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10862 + (5._wp/sqrt(4._wp*pi))*cosa
10863# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10864 end if
10865# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10866 ! v^z and B^z remain zero by default
10867# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10868
10869# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10870 case (270)
10871# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10872 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
10873# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10874
10875# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10876 if (.not. files_loaded) then
10877# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10878 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
10879# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10880 do f = 1, max_files
10881# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10882 write (file_num_str, '(I0)') f
10883# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10884 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
10885# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10886 end do
10887# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10888
10889# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10890 ! Common file reading setup
10891# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10892 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10893# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10894 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
10895# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10896
10897# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10898 select case (num_dims)
10899# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10900 case (1, 2) ! 1D and 2D cases are similar
10901# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10902 ! Count lines
10903# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10904 line_count = 0
10905# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10906 do
10907# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10908 read (unit2, *, iostat=ios2) dummy_x, dummy_y
10909# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10910 if (ios2 /= 0) exit
10911# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10912 line_count = line_count + 1
10913# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10914 end do
10915# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10916 close (unit2)
10917# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10918
10919# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10920 xrows = line_count
10921# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10922 yrows = 1
10923# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10924 index_x = 0
10925# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10926 if (num_dims == 2) index_x = i
10927# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10928#ifdef MFC_DEBUG
10929# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10930 block
10931# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10932 use iso_fortran_env, only: output_unit
10933# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10934
10935# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10936 print *, 'm_icpp_patches.fpp:959: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
10937# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10938
10939# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10940 call flush (output_unit)
10941# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10942 end block
10943# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10944#endif
10945# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10946 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
10947# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10948
10949# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10950
10951# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10952
10953# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10954#if defined(MFC_OpenACC)
10955# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10956!$acc enter data create(x_coords, stored_values)
10957# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10958#elif defined(MFC_OpenMP)
10959# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10960!$omp target enter data map(always,alloc:x_coords, stored_values)
10961# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10962#endif
10963# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10964
10965# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10966 ! Read data from all files
10967# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10968 do f = 1, max_files
10969# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10970 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10971# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10972 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
10973# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10974
10975# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10976 do iter = 1, xrows
10977# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10978 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
10979# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10980 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
10981# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10982 end do
10983# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10984 close (unit)
10985# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10986 end do
10987# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10988
10989# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10990 ! Calculate offsets
10991# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10992 domain_xstart = x_coords(1)
10993# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10994 x_step = x_cc(1) - x_cc(0)
10995# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10996 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
10997# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10998 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
10999# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11000 global_offset_x = nint(abs(delta_x)/x_step)
11001# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11002
11003# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11004 case (3) ! 3D case - determine grid structure
11005# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11006 ! Find yRows by counting rows with same x
11007# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11008 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11009# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11010 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11011# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11012
11013# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11014 yrows = 1
11015# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11016 do
11017# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11018 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11019# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11020 if (ios2 /= 0) exit
11021# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11022 if (dummy_x == x0 .and. dummy_y /= y0) then
11023# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11024 yrows = yrows + 1
11025# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11026 else
11027# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11028 exit
11029# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11030 end if
11031# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11032 end do
11033# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11034 close (unit2)
11035# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11036
11037# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11038 ! Count total rows
11039# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11040 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11041# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11042 nrows = 0
11043# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11044 do
11045# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11046 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11047# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11048 if (ios2 /= 0) exit
11049# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11050 nrows = nrows + 1
11051# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11052 end do
11053# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11054 close (unit2)
11055# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11056
11057# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11058 xrows = nrows/yrows
11059# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11060#ifdef MFC_DEBUG
11061# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11062 block
11063# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11064 use iso_fortran_env, only: output_unit
11065# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11066
11067# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11068 print *, 'm_icpp_patches.fpp:959: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11069# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11070
11071# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11072 call flush (output_unit)
11073# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11074 end block
11075# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11076#endif
11077# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11078 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11079# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11080
11081# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11082
11083# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11084
11085# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11086
11087# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11088#if defined(MFC_OpenACC)
11089# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11090!$acc enter data create(x_coords, y_coords, stored_values)
11091# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11092#elif defined(MFC_OpenMP)
11093# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11094!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11095# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11096#endif
11097# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11098 index_x = i
11099# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11100 index_y = j
11101# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11102
11103# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11104 ! Read all files
11105# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11106 do f = 1, max_files
11107# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11108 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11109# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11110 if (ios /= 0) then
11111# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11112 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
11113# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11114 cycle
11115# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11116 end if
11117# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11118
11119# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11120 iter = 0
11121# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11122 do iix = 1, xrows
11123# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11124 do iiy = 1, yrows
11125# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11126 iter = iter + 1
11127# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11128 if (f == 1) then
11129# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11130 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11131# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11132 else
11133# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11134 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11135# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11136 end if
11137# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11138 if (ios /= 0) call s_mpi_abort("Error reading data")
11139# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11140 end do
11141# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11142 end do
11143# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11144 close (unit)
11145# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11146 end do
11147# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11148
11149# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11150 ! Calculate offsets
11151# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11152 x_step = x_cc(1) - x_cc(0)
11153# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11154 y_step = y_cc(1) - y_cc(0)
11155# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11156 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
11157# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11158 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
11159# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11160 global_offset_x = nint(abs(delta_x)/x_step)
11161# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11162 global_offset_y = nint(abs(delta_y)/y_step)
11163# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11164 end select
11165# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11166
11167# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11168 files_loaded = .true.
11169# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11170 end if
11171# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11172
11173# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11174 ! Data assignment
11175# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11176 select case (num_dims)
11177# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11178 case (1)
11179# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11180 idx = i + 1 + global_offset_x
11181# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11182 do f = 1, sys_size
11183# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11184 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11185# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11186 end do
11187# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11188
11189# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11190 case (2)
11191# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11192 idx = i + 1 + global_offset_x - index_x
11193# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11194 do f = 1, sys_size - 1
11195# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11196 jump = merge(1, 0, f >= momxe)
11197# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11198 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11199# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11200 end do
11201# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11202 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
11203# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11204
11205# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11206 case (3)
11207# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11208 idx = i + 1 + global_offset_x - index_x
11209# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11210 idy = j + 1 + global_offset_y - index_y
11211# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11212 do f = 1, sys_size - 1
11213# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11214 jump = merge(1, 0, f >= momxe)
11215# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11216 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11217# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11218 end do
11219# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11220 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
11221# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11222 end select
11223# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11224
11225# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11226 case (280)
11227# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11228 ! This is patch is hard-coded for test suite optimization used in the
11229# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11230 ! 2D_isentropicvortex case:
11231# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11232 ! This analytic patch uses geometry 2
11233# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11234 if (patch_id == 1) then
11235# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11236 q_prim_vf(e_idx)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**(1.4 + 1.0)
11237# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11238 q_prim_vf(contxb + 0)%sf(i, j, 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) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0)))**1.4
11239# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11240 q_prim_vf(momxb + 0)%sf(i, j, 0) = 0.0 + (y_cc(j) - patch_icpp(1)%y_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
11241# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11242 q_prim_vf(momxb + 1)%sf(i, j, 0) = 0.0 - (x_cc(i) - patch_icpp(1)%x_centroid)*(5.0/(2.0*pi))*exp(1.0*(1.0 - (x_cc(i) - patch_icpp(1)%x_centroid)**2.0 - (y_cc(j) - patch_icpp(1)%y_centroid)**2.0))
11243# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11244 end if
11245# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11246
11247# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11248 case (281)
11249# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11250 ! This is patch is hard-coded for test suite optimization used in the
11251# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11252 ! 2D_acoustic_pulse case:
11253# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11254 ! This analytic patch uses geometry 2
11255# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11256 if (patch_id == 2) then
11257# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11258 q_prim_vf(e_idx)%sf(i, j, 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))
11259# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11260 q_prim_vf(contxb + 0)%sf(i, j, 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))
11261# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11262 end if
11263# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11264
11265# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11266 case (282)
11267# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11268 ! This is patch is hard-coded for test suite optimization used in the
11269# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11270 ! 2D_zero_circ_vortex case:
11271# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11272 ! This analytic patch uses geometry 2
11273# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11274 if (patch_id == 2) then
11275# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11276 q_prim_vf(e_idx)%sf(i, j, 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))
11277# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11278 q_prim_vf(contxb + 0)%sf(i, j, 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))
11279# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11280 q_prim_vf(momxb + 0)%sf(i, j, 0) = 112.99092883944267*(1 - (0.1/0.3))*y_cc(j)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
11281# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11282 q_prim_vf(momxb + 1)%sf(i, j, 0) = 112.99092883944267*((0.1/0.3))*x_cc(i)*exp(0.5*(1 - sqrt(x_cc(i)**2 + y_cc(j)**2)))
11283# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11284 end if
11285# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11286
11287# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11288 case default
11289# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11290 if (proc_rank == 0) then
11291# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11292 call s_int_to_str(patch_id, istr)
11293# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11294 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
11295# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11296 end if
11297# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11298
11299# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11300 end select
11301# 959 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11302
11303 end if
11304
11305 ! Updating the patch identities bookkeeping variable
11306 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
11307
11308 ! Assign Parameters
11309 q_prim_vf(mom_idx%beg)%sf(i, j, 0) = u0*sin(x_cc(i)/l0)*cos(y_cc(j)/l0)
11310 q_prim_vf(mom_idx%end)%sf(i, j, 0) = -u0*cos(x_cc(i)/l0)*sin(y_cc(j)/l0)
11311 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(patch_id)%pres + (cos(2*x_cc(i))/l0 + &
11312 cos(2*y_cc(j))/l0)* &
11313 (q_prim_vf(1)%sf(i, j, 0)*u0*u0)/16
11314 end if
11315 end do
11316 end do
11317 if (allocated(stored_values)) then
11318# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11319#ifdef MFC_DEBUG
11320# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11321 block
11322# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11323 use iso_fortran_env, only: output_unit
11324# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11325
11326# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11327 print *, 'm_icpp_patches.fpp:974: ', '@:DEALLOCATE(stored_values)'
11328# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11329
11330# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11331 call flush (output_unit)
11332# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11333 end block
11334# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11335#endif
11336# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11337
11338# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11339#if defined(MFC_OpenACC)
11340# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11341!$acc exit data delete(stored_values)
11342# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11343#elif defined(MFC_OpenMP)
11344# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11345!$omp target exit data map(release:stored_values)
11346# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11347#endif
11348# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11349 deallocate (stored_values)
11350# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11351#ifdef MFC_DEBUG
11352# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11353 block
11354# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11355 use iso_fortran_env, only: output_unit
11356# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11357
11358# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11359 print *, 'm_icpp_patches.fpp:974: ', '@:DEALLOCATE(x_coords)'
11360# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11361
11362# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11363 call flush (output_unit)
11364# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11365 end block
11366# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11367#endif
11368# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11369
11370# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11371#if defined(MFC_OpenACC)
11372# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11373!$acc exit data delete(x_coords)
11374# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11375#elif defined(MFC_OpenMP)
11376# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11377!$omp target exit data map(release:x_coords)
11378# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11379#endif
11380# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11381 deallocate (x_coords)
11382# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11383 end if
11384# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11385
11386# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11387 if (allocated(y_coords)) then
11388# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11389#ifdef MFC_DEBUG
11390# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11391 block
11392# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11393 use iso_fortran_env, only: output_unit
11394# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11395
11396# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11397 print *, 'm_icpp_patches.fpp:974: ', '@:DEALLOCATE(y_coords)'
11398# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11399
11400# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11401 call flush (output_unit)
11402# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11403 end block
11404# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11405#endif
11406# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11407
11408# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11409#if defined(MFC_OpenACC)
11410# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11411!$acc exit data delete(y_coords)
11412# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11413#elif defined(MFC_OpenMP)
11414# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11415!$omp target exit data map(release:y_coords)
11416# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11417#endif
11418# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11419 deallocate (y_coords)
11420# 974 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11421 end if
11422
11423 end subroutine s_icpp_2d_taylorgreen_vortex
11424
11425 !> @brief Initializes a 1D bubble-pulse patch with analytical primitive variable profiles.
11426 !! @param patch_id is the patch identifier
11427 !! @param patch_id_fp Array to track patch ids
11428 !! @param q_prim_vf Array of primitive variables
11429 subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
11430 ! Description: This patch assigns the primitive variables as analytical
11431 ! functions such that the code can be verified.
11432
11433 ! Patch identifier
11434 integer, intent(in) :: patch_id
11435#ifdef MFC_MIXED_PRECISION
11436 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
11437#else
11438 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
11439#endif
11440 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11441
11442 ! Generic loop iterators
11443 integer :: i, j, k
11444 ! Placeholders for the cell boundary values
11445 real(wp) :: pi_inf, gamma, lit_gamma
11446 integer :: xRows, yRows, nRows, iix, iiy, max_files
11447# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11448 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
11449# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11450 real(wp) :: x_len, x_step, y_len, y_step
11451# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11452 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
11453# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11454 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
11455# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11456 real(wp) :: delta_x, delta_y
11457# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11458 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
11459# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11460 character(len=200) :: errmsg
11461# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11462 real(wp), allocatable :: stored_values(:, :, :)
11463# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11464 real(wp), allocatable :: x_coords(:), y_coords(:)
11465# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11466 logical :: files_loaded = .false.
11467# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11468 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
11469# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11470 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
11471# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11472 character(len=20) :: file_num_str ! For storing the file number as a string
11473# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11474 character(len=20) :: zeros_part ! For the trailing zeros part
11475# 999 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11476 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
11477 ! Place any declaration of intermediate variables here
11478# 1000 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11479 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
11480
11481 pi_inf = pi_infs(1)
11482 gamma = gammas(1)
11483 lit_gamma = gs_min(1)
11484
11485 ! Transferring the patch's centroid and length information
11486 x_centroid = patch_icpp(patch_id)%x_centroid
11487 length_x = patch_icpp(patch_id)%length_x
11488
11489 ! Computing the beginning and the end x- and y-coordinates
11490 ! of the patch based on its centroid and lengths
11491 x_boundary%beg = x_centroid - 0.5_wp*length_x
11492 x_boundary%end = x_centroid + 0.5_wp*length_x
11493
11494 ! Since the patch doesn't allow for its boundaries to be
11495 ! smoothed out, the pseudo volume fraction is set to 1 to
11496 ! ensure that only the current patch contributes to the fluid
11497 ! state in the cells that this patch covers.
11498 eta = 1._wp
11499
11500 ! Checking whether the line segment covers a particular cell in the
11501 ! domain and verifying whether the current patch has the permission
11502 ! to write to that cell. If both queries check out, the primitive
11503 ! variables of the current patch are assigned to this cell.
11504 do i = 0, m
11505 if (x_boundary%beg <= x_cc(i) .and. &
11506 x_boundary%end >= x_cc(i) .and. &
11507 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, 0, 0))) then
11508
11509 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, &
11510 eta, q_prim_vf, patch_id_fp)
11511
11512
11513 if (patch_icpp(patch_id)%hcid /= dflt_int) then
11514 select case (patch_icpp(patch_id)%hcid)
11515# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11516 case (150) ! 1D Smooth Alfven Case for MHD
11517# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11518 ! velocity
11519# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11520 q_prim_vf(momxb + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11521# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11522 q_prim_vf(momxb + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11523# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11524
11525# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11526 ! magnetic field
11527# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11528 q_prim_vf(b_idx%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11529# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11530 q_prim_vf(b_idx%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11531# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11532
11533# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11534 case (170)
11535# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11536 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera, SDtoolbox)
11537# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11538
11539# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11540 if (.not. files_loaded) then
11541# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11542 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11543# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11544 do f = 1, max_files
11545# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11546 write (file_num_str, '(I0)') f
11547# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11548 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
11549# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11550 end do
11551# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11552
11553# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11554 ! Common file reading setup
11555# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11556 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11557# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11558 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
11559# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11560
11561# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11562 select case (num_dims)
11563# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11564 case (1, 2) ! 1D and 2D cases are similar
11565# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11566 ! Count lines
11567# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11568 line_count = 0
11569# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11570 do
11571# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11572 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11573# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11574 if (ios2 /= 0) exit
11575# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11576 line_count = line_count + 1
11577# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11578 end do
11579# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11580 close (unit2)
11581# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11582
11583# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11584 xrows = line_count
11585# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11586 yrows = 1
11587# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11588 index_x = 0
11589# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11590 if (num_dims == 2) index_x = i
11591# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11592#ifdef MFC_DEBUG
11593# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11594 block
11595# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11596 use iso_fortran_env, only: output_unit
11597# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11598
11599# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11600 print *, 'm_icpp_patches.fpp:1035: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11601# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11602
11603# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11604 call flush (output_unit)
11605# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11606 end block
11607# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11608#endif
11609# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11610 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11611# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11612
11613# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11614
11615# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11616
11617# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11618#if defined(MFC_OpenACC)
11619# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11620!$acc enter data create(x_coords, stored_values)
11621# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11622#elif defined(MFC_OpenMP)
11623# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11624!$omp target enter data map(always,alloc:x_coords, stored_values)
11625# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11626#endif
11627# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11628
11629# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11630 ! Read data from all files
11631# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11632 do f = 1, max_files
11633# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11634 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11635# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11636 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
11637# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11638
11639# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11640 do iter = 1, xrows
11641# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11642 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11643# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11644 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
11645# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11646 end do
11647# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11648 close (unit)
11649# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11650 end do
11651# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11652
11653# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11654 ! Calculate offsets
11655# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11656 domain_xstart = x_coords(1)
11657# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11658 x_step = x_cc(1) - x_cc(0)
11659# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11660 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
11661# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11662 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
11663# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11664 global_offset_x = nint(abs(delta_x)/x_step)
11665# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11666
11667# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11668 case (3) ! 3D case - determine grid structure
11669# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11670 ! Find yRows by counting rows with same x
11671# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11672 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11673# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11674 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11675# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11676
11677# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11678 yrows = 1
11679# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11680 do
11681# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11682 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11683# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11684 if (ios2 /= 0) exit
11685# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11686 if (dummy_x == x0 .and. dummy_y /= y0) then
11687# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11688 yrows = yrows + 1
11689# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11690 else
11691# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11692 exit
11693# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11694 end if
11695# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11696 end do
11697# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11698 close (unit2)
11699# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11700
11701# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11702 ! Count total rows
11703# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11704 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11705# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11706 nrows = 0
11707# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11708 do
11709# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11710 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11711# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11712 if (ios2 /= 0) exit
11713# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11714 nrows = nrows + 1
11715# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11716 end do
11717# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11718 close (unit2)
11719# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11720
11721# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11722 xrows = nrows/yrows
11723# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11724#ifdef MFC_DEBUG
11725# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11726 block
11727# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11728 use iso_fortran_env, only: output_unit
11729# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11730
11731# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11732 print *, 'm_icpp_patches.fpp:1035: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11733# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11734
11735# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11736 call flush (output_unit)
11737# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11738 end block
11739# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11740#endif
11741# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11742 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11743# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11744
11745# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11746
11747# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11748
11749# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11750
11751# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11752#if defined(MFC_OpenACC)
11753# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11754!$acc enter data create(x_coords, y_coords, stored_values)
11755# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11756#elif defined(MFC_OpenMP)
11757# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11758!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11759# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11760#endif
11761# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11762 index_x = i
11763# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11764 index_y = j
11765# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11766
11767# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11768 ! Read all files
11769# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11770 do f = 1, max_files
11771# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11772 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11773# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11774 if (ios /= 0) then
11775# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11776 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
11777# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11778 cycle
11779# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11780 end if
11781# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11782
11783# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11784 iter = 0
11785# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11786 do iix = 1, xrows
11787# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11788 do iiy = 1, yrows
11789# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11790 iter = iter + 1
11791# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11792 if (f == 1) then
11793# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11794 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11795# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11796 else
11797# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11798 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11799# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11800 end if
11801# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11802 if (ios /= 0) call s_mpi_abort("Error reading data")
11803# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11804 end do
11805# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11806 end do
11807# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11808 close (unit)
11809# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11810 end do
11811# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11812
11813# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11814 ! Calculate offsets
11815# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11816 x_step = x_cc(1) - x_cc(0)
11817# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11818 y_step = y_cc(1) - y_cc(0)
11819# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11820 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
11821# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11822 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
11823# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11824 global_offset_x = nint(abs(delta_x)/x_step)
11825# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11826 global_offset_y = nint(abs(delta_y)/y_step)
11827# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11828 end select
11829# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11830
11831# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11832 files_loaded = .true.
11833# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11834 end if
11835# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11836
11837# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11838 ! Data assignment
11839# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11840 select case (num_dims)
11841# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11842 case (1)
11843# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11844 idx = i + 1 + global_offset_x
11845# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11846 do f = 1, sys_size
11847# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11848 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11849# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11850 end do
11851# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11852
11853# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11854 case (2)
11855# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11856 idx = i + 1 + global_offset_x - index_x
11857# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11858 do f = 1, sys_size - 1
11859# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11860 jump = merge(1, 0, f >= momxe)
11861# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11862 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11863# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11864 end do
11865# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11866 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
11867# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11868
11869# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11870 case (3)
11871# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11872 idx = i + 1 + global_offset_x - index_x
11873# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11874 idy = j + 1 + global_offset_y - index_y
11875# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11876 do f = 1, sys_size - 1
11877# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11878 jump = merge(1, 0, f >= momxe)
11879# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11880 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11881# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11882 end do
11883# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11884 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
11885# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11886 end select
11887# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11888
11889# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11890 case (180)
11891# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11892 ! This is patch is hard-coded for test suite optimization used in the
11893# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11894 ! 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 + 0.2*sin(5*x)"
11895# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11896 if (patch_id == 2) then
11897# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11898 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
11899# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11900 end if
11901# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11902
11903# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11904 case (181)
11905# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11906 ! This is patch is hard-coded for test suite optimization used in the
11907# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11908 ! 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)": "1 + 0.1*sin(20*x*pi)"
11909# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11910 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
11911# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11912
11913# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11914 case (182)
11915# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11916 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
11917# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11918 x_mid_diffu = 0.05_wp/2.0_wp
11919# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11920 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
11921# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11922 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
11923# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11924 q_prim_vf(momxb)%sf(i, 0, 0) = 0.0_wp
11925# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11926 q_prim_vf(e_idx)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
11927# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11928 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp
11929# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11930
11931# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11932 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
11933# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11934 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
11935# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11936 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
11937# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11938 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
11939# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11940
11941# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11942 q_prim_vf(chemxb)%sf(i, 0, 0) = y1
11943# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11944 q_prim_vf(chemxb + 1)%sf(i, 0, 0) = y2
11945# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11946 q_prim_vf(chemxb + 2)%sf(i, 0, 0) = y3
11947# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11948 q_prim_vf(chemxb + 3)%sf(i, 0, 0) = y4
11949# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11950
11951# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11952 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
11953# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11954
11955# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11956 molar_mass_inv = y1/31.998_wp + &
11957# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11958 y2/18.01508_wp + &
11959# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11960 y3/16.04256_wp + &
11961# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11962 y4/28.0134_wp
11963# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11964
11965# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11966 q_prim_vf(contxb)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5/(temp*8.3144626_wp*1000.0_wp*molar_mass_inv)
11967# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11968
11969# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11970 case default
11971# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11972 call s_int_to_str(patch_id, istr)
11973# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11974 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
11975# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11976 end select
11977# 1035 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11978
11979 end if
11980
11981 end if
11982 end do
11983 if (allocated(stored_values)) then
11984# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11985#ifdef MFC_DEBUG
11986# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11987 block
11988# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11989 use iso_fortran_env, only: output_unit
11990# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11991
11992# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11993 print *, 'm_icpp_patches.fpp:1040: ', '@:DEALLOCATE(stored_values)'
11994# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11995
11996# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11997 call flush (output_unit)
11998# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11999 end block
12000# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12001#endif
12002# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12003
12004# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12005#if defined(MFC_OpenACC)
12006# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12007!$acc exit data delete(stored_values)
12008# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12009#elif defined(MFC_OpenMP)
12010# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12011!$omp target exit data map(release:stored_values)
12012# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12013#endif
12014# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12015 deallocate (stored_values)
12016# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12017#ifdef MFC_DEBUG
12018# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12019 block
12020# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12021 use iso_fortran_env, only: output_unit
12022# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12023
12024# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12025 print *, 'm_icpp_patches.fpp:1040: ', '@:DEALLOCATE(x_coords)'
12026# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12027
12028# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12029 call flush (output_unit)
12030# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12031 end block
12032# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12033#endif
12034# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12035
12036# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12037#if defined(MFC_OpenACC)
12038# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12039!$acc exit data delete(x_coords)
12040# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12041#elif defined(MFC_OpenMP)
12042# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12043!$omp target exit data map(release:x_coords)
12044# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12045#endif
12046# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12047 deallocate (x_coords)
12048# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12049 end if
12050# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12051
12052# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12053 if (allocated(y_coords)) then
12054# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12055#ifdef MFC_DEBUG
12056# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12057 block
12058# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12059 use iso_fortran_env, only: output_unit
12060# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12061
12062# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12063 print *, 'm_icpp_patches.fpp:1040: ', '@:DEALLOCATE(y_coords)'
12064# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12065
12066# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12067 call flush (output_unit)
12068# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12069 end block
12070# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12071#endif
12072# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12073
12074# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12075#if defined(MFC_OpenACC)
12076# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12077!$acc exit data delete(y_coords)
12078# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12079#elif defined(MFC_OpenMP)
12080# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12081!$omp target exit data map(release:y_coords)
12082# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12083#endif
12084# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12085 deallocate (y_coords)
12086# 1040 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12087 end if
12088
12089 end subroutine s_icpp_1d_bubble_pulse
12090
12091 !> This patch generates the shape of the spherical harmonics
12092 !! as a perturbation to a perfect sphere
12093 !! @param patch_id is the patch identifier
12094 !! @param patch_id_fp Array to track patch ids
12095 !! @param q_prim_vf Array of primitive variables
12096 subroutine s_icpp_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
12097
12098 integer, intent(IN) :: patch_id
12099#ifdef MFC_MIXED_PRECISION
12100 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12101#else
12102 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12103#endif
12104 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12105
12106 real(wp) :: r, x_p, eps, phi
12107 real(wp), dimension(2:9) :: as, Ps
12108 real(wp) :: radius, x_centroid_local, y_centroid_local, z_centroid_local, eta_local, smooth_coeff_local
12109 logical :: non_axis_sym_in
12110
12111 integer :: i, j, k !< generic loop iterators
12112
12113 ! Transferring the patch's centroid and radius information
12114 x_centroid_local = patch_icpp(patch_id)%x_centroid
12115 y_centroid_local = patch_icpp(patch_id)%y_centroid
12116 z_centroid_local = patch_icpp(patch_id)%z_centroid
12117 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12118 smooth_coeff_local = patch_icpp(patch_id)%smooth_coeff
12119 radius = patch_icpp(patch_id)%radius
12120 as(2) = patch_icpp(patch_id)%a(2)
12121 as(3) = patch_icpp(patch_id)%a(3)
12122 as(4) = patch_icpp(patch_id)%a(4)
12123 as(5) = patch_icpp(patch_id)%a(5)
12124 as(6) = patch_icpp(patch_id)%a(6)
12125 as(7) = patch_icpp(patch_id)%a(7)
12126 as(8) = patch_icpp(patch_id)%a(8)
12127 as(9) = patch_icpp(patch_id)%a(9)
12128 non_axis_sym_in = patch_icpp(patch_id)%non_axis_sym
12129
12130 ! Since the analytical patch does not allow for its boundaries to get
12131 ! smoothed out, the pseudo volume fraction is set to 1 to make sure
12132 ! that only the current patch contributes to the fluid state in the
12133 ! cells that this patch covers.
12134 eta_local = 1._wp
12135 eps = 1.e-32_wp
12136
12137 ! Checking whether the patch covers a particular cell in the domain
12138 ! and verifying whether the current patch has permission to write to
12139 ! to that cell. If both queries check out, the primitive variables
12140 ! of the current patch are assigned to this cell.
12141 if (p > 0 .and. .not. non_axis_sym_in) then
12142 do k = 0, p
12143 do j = 0, n
12144 do i = 0, m
12145 if (grid_geometry == 3) then
12146 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12147 else
12148 cart_y = y_cc(j)
12149 cart_z = z_cc(k)
12150 end if
12151
12152 r = sqrt((x_cc(i) - x_centroid_local)**2 + (cart_y - y_centroid_local)**2 + (cart_z - z_centroid_local)**2) + eps
12153 if (x_cc(i) - x_centroid_local <= 0) then
12154 x_p = -1._wp*abs(x_cc(i) - x_centroid_local + eps)/r
12155 else
12156 x_p = abs(x_cc(i) - x_centroid_local + eps)/r
12157 end if
12158
12159 ps(2) = unassociated_legendre(x_p, 2)
12160 ps(3) = unassociated_legendre(x_p, 3)
12161 ps(4) = unassociated_legendre(x_p, 4)
12162 ps(5) = unassociated_legendre(x_p, 5)
12163 ps(6) = unassociated_legendre(x_p, 6)
12164 ps(7) = unassociated_legendre(x_p, 7)
12165 if ((x_cc(i) - x_centroid_local >= 0 &
12166 .and. &
12167 r - as(2)*ps(2) - as(3)*ps(3) - as(4)*ps(4) - as(5)*ps(5) - as(6)*ps(6) - as(7)*ps(7) <= radius &
12168 .and. &
12169 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. &
12170 (patch_id_fp(i, j, k) == smooth_patch_id)) &
12171 then
12172 if (patch_icpp(patch_id)%smoothen) then
12173 eta_local = tanh(smooth_coeff_local/min(dx, dy, dz)* &
12174 ((r - as(2)*ps(2) - as(3)*ps(3) - as(4)*ps(4) - as(5)*ps(5) - as(6)*ps(6) - as(7)*ps(7)) &
12175 - radius))*(-0.5_wp) + 0.5_wp
12176 end if
12177
12178 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
12179 eta_local, q_prim_vf, patch_id_fp)
12180 end if
12181
12182 end do
12183 end do
12184 end do
12185
12186 else if (p == 0) then
12187 do j = 0, n
12188 do i = 0, m
12189
12190 if (non_axis_sym_in) then
12191 phi = atan(((y_cc(j) - y_centroid_local) + eps)/((x_cc(i) - x_centroid_local) + eps))
12192 r = sqrt((x_cc(i) - x_centroid_local)**2._wp + (y_cc(j) - y_centroid_local)**2._wp) + eps
12193 x_p = (eps)/r
12194 ps(2) = spherical_harmonic_func(x_p, phi, 2, 2)
12195 ps(3) = spherical_harmonic_func(x_p, phi, 3, 3)
12196 ps(4) = spherical_harmonic_func(x_p, phi, 4, 4)
12197 ps(5) = spherical_harmonic_func(x_p, phi, 5, 5)
12198 ps(6) = spherical_harmonic_func(x_p, phi, 6, 6)
12199 ps(7) = spherical_harmonic_func(x_p, phi, 7, 7)
12200 ps(8) = spherical_harmonic_func(x_p, phi, 8, 8)
12201 ps(9) = spherical_harmonic_func(x_p, phi, 9, 9)
12202 else
12203 r = sqrt((x_cc(i) - x_centroid_local)**2._wp + (y_cc(j) - y_centroid_local)**2._wp) + eps
12204 x_p = abs(x_cc(i) - x_centroid_local + eps)/r
12205 ps(2) = unassociated_legendre(x_p, 2)
12206 ps(3) = unassociated_legendre(x_p, 3)
12207 ps(4) = unassociated_legendre(x_p, 4)
12208 ps(5) = unassociated_legendre(x_p, 5)
12209 ps(6) = unassociated_legendre(x_p, 6)
12210 ps(7) = unassociated_legendre(x_p, 7)
12211 ps(8) = unassociated_legendre(x_p, 8)
12212 ps(9) = unassociated_legendre(x_p, 9)
12213 end if
12214
12215 if (x_cc(i) - x_centroid_local >= 0 &
12216 .and. &
12217 r - as(2)*ps(2) - as(3)*ps(3) - as(4)*ps(4) - as(5)*ps(5) - as(6)*ps(6) - as(7)*ps(7) - as(8)*ps(8) - as(9)*ps(9) <= radius .and. &
12218 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
12219 then
12220 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
12221 eta_local, q_prim_vf, patch_id_fp)
12222
12223 elseif (x_cc(i) - x_centroid_local < 0 &
12224 .and. &
12225 r - as(2)*ps(2) + as(3)*ps(3) - as(4)*ps(4) + as(5)*ps(5) - as(6)*ps(6) + as(7)*ps(7) - as(8)*ps(8) + as(9)*ps(9) <= radius &
12226 .and. &
12227 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
12228 then
12229 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
12230 eta_local, q_prim_vf, patch_id_fp)
12231
12232 end if
12233 end do
12234 end do
12235 end if
12236
12237 end subroutine s_icpp_spherical_harmonic
12238
12239 !> The spherical patch is a 3D geometry that may be used,
12240 !! for example, in creating a bubble or a droplet. The patch
12241 !! geometry is well-defined when its centroid and radius are
12242 !! provided. Please note that the spherical patch DOES allow
12243 !! for the smoothing of its boundary.
12244 !! @param patch_id is the patch identifier
12245 !! @param patch_id_fp Array to track patch ids
12246 !! @param q_prim_vf Array of primitive variables
12247 subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
12248
12249 integer, intent(in) :: patch_id
12250#ifdef MFC_MIXED_PRECISION
12251 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12252#else
12253 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12254#endif
12255 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12256
12257 ! Generic loop iterators
12258 integer :: i, j, k
12259 real(wp) :: radius
12260 integer :: xRows, yRows, nRows, iix, iiy, max_files
12261# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12262 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
12263# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12264 real(wp) :: x_len, x_step, y_len, y_step
12265# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12266 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
12267# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12268 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
12269# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12270 real(wp) :: delta_x, delta_y
12271# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12272 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
12273# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12274 character(len=200) :: errmsg
12275# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12276 real(wp), allocatable :: stored_values(:, :, :)
12277# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12278 real(wp), allocatable :: x_coords(:), y_coords(:)
12279# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12280 logical :: files_loaded = .false.
12281# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12282 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
12283# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12284 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
12285# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12286 character(len=20) :: file_num_str ! For storing the file number as a string
12287# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12288 character(len=20) :: zeros_part ! For the trailing zeros part
12289# 1213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12290 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
12291 ! Place any declaration of intermediate variables here
12292# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12293 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
12294# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12295 real(wp) :: eps
12296# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12297
12298# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12299 ! IGR Jets
12300# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12301 ! Arrays to stor position and radii of jets from input file
12302# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12303 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
12304# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12305 ! Variables to describe initial condition of jet
12306# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12307 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
12308# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12309 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
12310# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12311
12312# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12313 real(wp), dimension(0:n, 0:p) :: rcut_arr
12314# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12315 integer :: l, q, s ! Iterators for reading input files
12316# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12317 integer :: start, end ! Ints to keep track of position in file
12318# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12319 character(len=1000) :: line ! String to store line in ile
12320# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12321 character(len=25) :: value ! String to store value in line
12322# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12323 integer :: NJet ! Number of jets
12324# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12325
12326# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12327 eps = 1e-9_wp
12328# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12329
12330# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12331 if (patch_icpp(patch_id)%hcid == 303) then
12332# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12333 eps_smooth = 3._wp
12334# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12335 open (unit=10, file="njet.txt", status="old", action="read")
12336# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12337 read (10, *) njet
12338# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12339 close (10)
12340# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12341
12342# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12343 allocate (y_th_arr(0:njet - 1))
12344# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12345 allocate (z_th_arr(0:njet - 1))
12346# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12347 allocate (r_th_arr(0:njet - 1))
12348# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12349
12350# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12351 open (unit=10, file="jets.csv", status="old", action="read")
12352# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12353 do q = 0, njet - 1
12354# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12355 read (10, '(A)') line ! Read a full line as a string
12356# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12357 start = 1
12358# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12359
12360# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12361 do l = 0, 2
12362# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12363 end = index(line(start:), ',') ! Find the next comma
12364# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12365 if (end == 0) then
12366# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12367 value = trim(adjustl(line(start:))) ! Last value in the line
12368# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12369 else
12370# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12371 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
12372# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12373 start = start + end ! Move to next value
12374# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12375 end if
12376# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12377 if (l == 0) then
12378# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12379 read (value, *) y_th_arr(q) ! Convert string to numeric value
12380# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12381 elseif (l == 1) then
12382# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12383 read (value, *) z_th_arr(q)
12384# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12385 else
12386# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12387 read (value, *) r_th_arr(q)
12388# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12389 end if
12390# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12391 end do
12392# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12393 end do
12394# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12395 close (10)
12396# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12397
12398# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12399 do q = 0, p
12400# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12401 do l = 0, n
12402# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12403 rcut = 0._wp
12404# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12405 do s = 0, njet - 1
12406# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12407 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
12408# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12409 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
12410# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12411 end do
12412# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12413 rcut_arr(l, q) = rcut
12414# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12415 end do
12416# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12417 end do
12418# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12419 end if
12420# 1214 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12421
12422
12423 !! Variables to initialize the pressure field that corresponds to the
12424 !! bubble-collapse test case found in Tiwari et al. (2013)
12425
12426 ! Transferring spherical patch's radius, centroid, smoothing patch
12427 ! identity and smoothing coefficient information
12428 x_centroid = patch_icpp(patch_id)%x_centroid
12429 y_centroid = patch_icpp(patch_id)%y_centroid
12430 z_centroid = patch_icpp(patch_id)%z_centroid
12431 radius = patch_icpp(patch_id)%radius
12432 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12433 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12434
12435 ! Initializing the pseudo volume fraction value to 1. The value will
12436 ! be modified as the patch is laid out on the grid, but only in the
12437 ! case that smoothing of the spherical patch's boundary is enabled.
12438 eta = 1._wp
12439
12440 ! Checking whether the sphere covers a particular cell in the domain
12441 ! and verifying whether the current patch has permission to write to
12442 ! that cell. If both queries check out, the primitive variables of
12443 ! the current patch are assigned to this cell.
12444 do k = 0, p
12445 do j = 0, n
12446 do i = 0, m
12447
12448 if (grid_geometry == 3) then
12450 else
12451 cart_y = y_cc(j)
12452 cart_z = z_cc(k)
12453 end if
12454
12455 if (patch_icpp(patch_id)%smoothen) then
12456 eta = tanh(smooth_coeff/min(dx, dy, dz)* &
12457 (sqrt((x_cc(i) - x_centroid)**2 &
12458 + (cart_y - y_centroid)**2 &
12459 + (cart_z - z_centroid)**2) &
12460 - radius))*(-0.5_wp) + 0.5_wp
12461 end if
12462
12463 if ((((x_cc(i) - x_centroid)**2 &
12464 + (cart_y - y_centroid)**2 &
12465 + (cart_z - z_centroid)**2 <= radius**2) .and. &
12466 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. &
12467 patch_id_fp(i, j, k) == smooth_patch_id) then
12468
12469 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
12470 eta, q_prim_vf, patch_id_fp)
12471
12472
12473 if (patch_icpp(patch_id)%hcid /= dflt_int) then
12474
12475# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12476 select case (patch_icpp(patch_id)%hcid)
12477# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12478 case (300) ! Rayleigh-Taylor instability
12479# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12480 rhoh = 3._wp
12481# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12482 rhol = 1._wp
12483# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12484 pref = 1.e5_wp
12485# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12486 pint = pref
12487# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12488 h = 0.7_wp
12489# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12490 lam = 0.2_wp
12491# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12492 wl = 2._wp*pi/lam
12493# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12494 amp = 0.025_wp/wl
12495# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12496
12497# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12498 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
12499# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12500
12501# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12502 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
12503# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12504
12505# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12506 if (alph < eps) alph = eps
12507# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12508 if (alph > 1._wp - eps) alph = 1._wp - eps
12509# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12510
12511# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12512 if (y_cc(j) > inth) then
12513# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12514 q_prim_vf(advxb)%sf(i, j, k) = alph
12515# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12516 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
12517# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12518 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
12519# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12520 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
12521# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12522 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
12523# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12524 else
12525# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12526 q_prim_vf(advxb)%sf(i, j, k) = alph
12527# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12528 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
12529# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12530 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
12531# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12532 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
12533# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12534 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
12535# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12536 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
12537# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12538 end if
12539# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12540
12541# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12542 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
12543# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12544 h = 0.0_wp
12545# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12546 lam = 1.0_wp
12547# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12548 amp = patch_icpp(patch_id)%a(2)
12549# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12550 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
12551# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12552 if (x_cc(i) > inth) then
12553# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12554 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
12555# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12556 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
12557# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12558 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
12559# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12560 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
12561# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12562 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
12563# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12564 end if
12565# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12566
12567# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12568 case (302) ! 3D Jet with IGR
12569# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12570 ux_th = 10*sqrt(1.4*0.4)
12571# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12572 ux_am = 0.0*sqrt(1.4)
12573# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12574 p_th = 2.0_wp
12575# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12576 p_am = 1.0_wp
12577# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12578 rho_th = 1._wp
12579# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12580 rho_am = 1._wp
12581# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12582 y_th = 0.0_wp
12583# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12584 z_th = 0.0_wp
12585# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12586 r_th = 1._wp
12587# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12588 eps_smooth = 1._wp
12589# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12590 eps = 1e-6
12591# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12592
12593# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12594 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
12595# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12596 rcut = f_cut_on(r - r_th, eps_smooth)
12597# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12598 xcut = f_cut_on(x_cc(i), eps_smooth)
12599# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12600
12601# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12602 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12603# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12604 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
12605# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12606 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
12607# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12608
12609# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12610 if (num_fluids == 1) then
12611# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12612 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12613# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12614 else
12615# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12616 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12617# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12618 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
12619# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12620 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
12621# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12622 end if
12623# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12624
12625# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12626 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
12627# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12628
12629# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12630 case (303) ! 3D Multijet
12631# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12632
12633# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12634 eps_smooth = 3.0_wp
12635# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12636 ux_th = 10*sqrt(1.4*0.4)
12637# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12638 ux_am = 2.5*sqrt(1.4*0.4)
12639# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12640 p_th = 0.8_wp
12641# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12642 p_am = 0.4_wp
12643# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12644 rho_th = 1._wp
12645# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12646 rho_am = 1._wp
12647# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12648 eps = 1e-6
12649# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12650
12651# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12652 rcut = rcut_arr(j, k)
12653# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12654 xcut = f_cut_on(x_cc(i), eps_smooth)
12655# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12656
12657# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12658 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12659# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12660 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
12661# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12662 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
12663# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12664
12665# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12666 if (num_fluids == 1) then
12667# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12668 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12669# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12670 else
12671# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12672 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12673# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12674 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
12675# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12676 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
12677# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12678 end if
12679# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12680
12681# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12682 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
12683# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12684
12685# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12686 case (370)
12687# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12688 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
12689# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12690
12691# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12692 if (.not. files_loaded) then
12693# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12694 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12695# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12696 do f = 1, max_files
12697# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12698 write (file_num_str, '(I0)') f
12699# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12700 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
12701# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12702 end do
12703# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12704
12705# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12706 ! Common file reading setup
12707# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12708 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12709# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12710 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
12711# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12712
12713# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12714 select case (num_dims)
12715# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12716 case (1, 2) ! 1D and 2D cases are similar
12717# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12718 ! Count lines
12719# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12720 line_count = 0
12721# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12722 do
12723# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12724 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12725# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12726 if (ios2 /= 0) exit
12727# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12728 line_count = line_count + 1
12729# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12730 end do
12731# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12732 close (unit2)
12733# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12734
12735# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12736 xrows = line_count
12737# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12738 yrows = 1
12739# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12740 index_x = 0
12741# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12742 if (num_dims == 2) index_x = i
12743# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12744#ifdef MFC_DEBUG
12745# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12746 block
12747# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12748 use iso_fortran_env, only: output_unit
12749# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12750
12751# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12752 print *, 'm_icpp_patches.fpp:1267: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12753# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12754
12755# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12756 call flush (output_unit)
12757# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12758 end block
12759# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12760#endif
12761# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12762 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12763# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12764
12765# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12766
12767# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12768
12769# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12770#if defined(MFC_OpenACC)
12771# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12772!$acc enter data create(x_coords, stored_values)
12773# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12774#elif defined(MFC_OpenMP)
12775# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12776!$omp target enter data map(always,alloc:x_coords, stored_values)
12777# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12778#endif
12779# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12780
12781# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12782 ! Read data from all files
12783# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12784 do f = 1, max_files
12785# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12786 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12787# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12788 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
12789# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12790
12791# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12792 do iter = 1, xrows
12793# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12794 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
12795# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12796 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
12797# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12798 end do
12799# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12800 close (unit)
12801# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12802 end do
12803# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12804
12805# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12806 ! Calculate offsets
12807# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12808 domain_xstart = x_coords(1)
12809# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12810 x_step = x_cc(1) - x_cc(0)
12811# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12812 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
12813# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12814 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
12815# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12816 global_offset_x = nint(abs(delta_x)/x_step)
12817# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12818
12819# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12820 case (3) ! 3D case - determine grid structure
12821# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12822 ! Find yRows by counting rows with same x
12823# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12824 read (unit2, *, iostat=ios2) x0, y0, dummy_z
12825# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12826 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
12827# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12828
12829# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12830 yrows = 1
12831# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12832 do
12833# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12834 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12835# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12836 if (ios2 /= 0) exit
12837# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12838 if (dummy_x == x0 .and. dummy_y /= y0) then
12839# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12840 yrows = yrows + 1
12841# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12842 else
12843# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12844 exit
12845# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12846 end if
12847# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12848 end do
12849# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12850 close (unit2)
12851# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12852
12853# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12854 ! Count total rows
12855# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12856 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12857# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12858 nrows = 0
12859# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12860 do
12861# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12862 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12863# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12864 if (ios2 /= 0) exit
12865# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12866 nrows = nrows + 1
12867# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12868 end do
12869# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12870 close (unit2)
12871# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12872
12873# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12874 xrows = nrows/yrows
12875# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12876#ifdef MFC_DEBUG
12877# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12878 block
12879# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12880 use iso_fortran_env, only: output_unit
12881# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12882
12883# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12884 print *, 'm_icpp_patches.fpp:1267: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12885# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12886
12887# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12888 call flush (output_unit)
12889# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12890 end block
12891# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12892#endif
12893# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12894 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12895# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12896
12897# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12898
12899# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12900
12901# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12902
12903# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12904#if defined(MFC_OpenACC)
12905# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12906!$acc enter data create(x_coords, y_coords, stored_values)
12907# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12908#elif defined(MFC_OpenMP)
12909# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12910!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12911# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12912#endif
12913# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12914 index_x = i
12915# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12916 index_y = j
12917# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12918
12919# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12920 ! Read all files
12921# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12922 do f = 1, max_files
12923# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12924 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12925# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12926 if (ios /= 0) then
12927# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12928 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
12929# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12930 cycle
12931# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12932 end if
12933# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12934
12935# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12936 iter = 0
12937# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12938 do iix = 1, xrows
12939# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12940 do iiy = 1, yrows
12941# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12942 iter = iter + 1
12943# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12944 if (f == 1) then
12945# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12946 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12947# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12948 else
12949# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12950 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12951# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12952 end if
12953# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12954 if (ios /= 0) call s_mpi_abort("Error reading data")
12955# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12956 end do
12957# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12958 end do
12959# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12960 close (unit)
12961# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12962 end do
12963# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12964
12965# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12966 ! Calculate offsets
12967# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12968 x_step = x_cc(1) - x_cc(0)
12969# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12970 y_step = y_cc(1) - y_cc(0)
12971# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12972 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
12973# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12974 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
12975# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12976 global_offset_x = nint(abs(delta_x)/x_step)
12977# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12978 global_offset_y = nint(abs(delta_y)/y_step)
12979# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12980 end select
12981# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12982
12983# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12984 files_loaded = .true.
12985# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12986 end if
12987# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12988
12989# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12990 ! Data assignment
12991# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12992 select case (num_dims)
12993# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12994 case (1)
12995# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12996 idx = i + 1 + global_offset_x
12997# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12998 do f = 1, sys_size
12999# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13000 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13001# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13002 end do
13003# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13004
13005# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13006 case (2)
13007# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13008 idx = i + 1 + global_offset_x - index_x
13009# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13010 do f = 1, sys_size - 1
13011# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13012 jump = merge(1, 0, f >= momxe)
13013# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13014 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13015# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13016 end do
13017# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13018 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
13019# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13020
13021# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13022 case (3)
13023# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13024 idx = i + 1 + global_offset_x - index_x
13025# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13026 idy = j + 1 + global_offset_y - index_y
13027# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13028 do f = 1, sys_size - 1
13029# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13030 jump = merge(1, 0, f >= momxe)
13031# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13032 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13033# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13034 end do
13035# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13036 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
13037# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13038 end select
13039# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13040
13041# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13042 case (380)
13043# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13044 ! This is patch is hard-coded for test suite optimization used in the
13045# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13046 ! 3D_TaylorGreenVortex case:
13047# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13048 ! This analytic patch used geometry 9
13049# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13050 mach = 0.1
13051# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13052 if (patch_id == 1) then
13053# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13054 q_prim_vf(e_idx)%sf(i, j, 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)
13055# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13056 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
13057# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13058 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
13059# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13060 end if
13061# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13062
13063# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13064 case default
13065# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13066 call s_int_to_str(patch_id, istr)
13067# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13068 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
13069# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13070 end select
13071# 1267 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13072
13073 end if
13074
13075 end if
13076 end do
13077 end do
13078 end do
13079 if (allocated(stored_values)) then
13080# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13081#ifdef MFC_DEBUG
13082# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13083 block
13084# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13085 use iso_fortran_env, only: output_unit
13086# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13087
13088# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13089 print *, 'm_icpp_patches.fpp:1274: ', '@:DEALLOCATE(stored_values)'
13090# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13091
13092# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13093 call flush (output_unit)
13094# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13095 end block
13096# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13097#endif
13098# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13099
13100# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13101#if defined(MFC_OpenACC)
13102# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13103!$acc exit data delete(stored_values)
13104# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13105#elif defined(MFC_OpenMP)
13106# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13107!$omp target exit data map(release:stored_values)
13108# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13109#endif
13110# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13111 deallocate (stored_values)
13112# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13113#ifdef MFC_DEBUG
13114# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13115 block
13116# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13117 use iso_fortran_env, only: output_unit
13118# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13119
13120# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13121 print *, 'm_icpp_patches.fpp:1274: ', '@:DEALLOCATE(x_coords)'
13122# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13123
13124# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13125 call flush (output_unit)
13126# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13127 end block
13128# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13129#endif
13130# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13131
13132# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13133#if defined(MFC_OpenACC)
13134# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13135!$acc exit data delete(x_coords)
13136# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13137#elif defined(MFC_OpenMP)
13138# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13139!$omp target exit data map(release:x_coords)
13140# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13141#endif
13142# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13143 deallocate (x_coords)
13144# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13145 end if
13146# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13147
13148# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13149 if (allocated(y_coords)) then
13150# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13151#ifdef MFC_DEBUG
13152# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13153 block
13154# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13155 use iso_fortran_env, only: output_unit
13156# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13157
13158# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13159 print *, 'm_icpp_patches.fpp:1274: ', '@:DEALLOCATE(y_coords)'
13160# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13161
13162# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13163 call flush (output_unit)
13164# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13165 end block
13166# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13167#endif
13168# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13169
13170# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13171#if defined(MFC_OpenACC)
13172# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13173!$acc exit data delete(y_coords)
13174# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13175#elif defined(MFC_OpenMP)
13176# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13177!$omp target exit data map(release:y_coords)
13178# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13179#endif
13180# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13181 deallocate (y_coords)
13182# 1274 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13183 end if
13184
13185 end subroutine s_icpp_sphere
13186
13187 !> The cuboidal patch is a 3D geometry that may be used, for
13188 !! example, in creating a solid boundary, or pre-/post-shock
13189 !! region, which is aligned with the axes of the Cartesian
13190 !! coordinate system. The geometry of such a patch is well-
13191 !! defined when its centroid and lengths in the x-, y- and
13192 !! z-coordinate directions are provided. Please notice that
13193 !! the cuboidal patch DOES NOT allow for the smearing of its
13194 !! boundaries.
13195 !! @param patch_id is the patch identifier
13196 !! @param patch_id_fp Array to track patch ids
13197 !! @param q_prim_vf Array of primitive variables
13198 subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
13199
13200 integer, intent(in) :: patch_id
13201#ifdef MFC_MIXED_PRECISION
13202 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
13203#else
13204 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
13205#endif
13206 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
13207
13208 integer :: i, j, k !< Generic loop iterators
13209 integer :: xRows, yRows, nRows, iix, iiy, max_files
13210# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13211 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
13212# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13213 real(wp) :: x_len, x_step, y_len, y_step
13214# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13215 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
13216# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13217 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
13218# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13219 real(wp) :: delta_x, delta_y
13220# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13221 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
13222# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13223 character(len=200) :: errmsg
13224# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13225 real(wp), allocatable :: stored_values(:, :, :)
13226# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13227 real(wp), allocatable :: x_coords(:), y_coords(:)
13228# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13229 logical :: files_loaded = .false.
13230# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13231 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
13232# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13233 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
13234# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13235 character(len=20) :: file_num_str ! For storing the file number as a string
13236# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13237 character(len=20) :: zeros_part ! For the trailing zeros part
13238# 1300 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13239 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
13240 ! Place any declaration of intermediate variables here
13241# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13242 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
13243# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13244 real(wp) :: eps
13245# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13246
13247# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13248 ! IGR Jets
13249# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13250 ! Arrays to stor position and radii of jets from input file
13251# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13252 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
13253# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13254 ! Variables to describe initial condition of jet
13255# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13256 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
13257# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13258 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
13259# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13260
13261# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13262 real(wp), dimension(0:n, 0:p) :: rcut_arr
13263# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13264 integer :: l, q, s ! Iterators for reading input files
13265# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13266 integer :: start, end ! Ints to keep track of position in file
13267# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13268 character(len=1000) :: line ! String to store line in ile
13269# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13270 character(len=25) :: value ! String to store value in line
13271# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13272 integer :: NJet ! Number of jets
13273# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13274
13275# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13276 eps = 1e-9_wp
13277# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13278
13279# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13280 if (patch_icpp(patch_id)%hcid == 303) then
13281# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13282 eps_smooth = 3._wp
13283# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13284 open (unit=10, file="njet.txt", status="old", action="read")
13285# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13286 read (10, *) njet
13287# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13288 close (10)
13289# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13290
13291# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13292 allocate (y_th_arr(0:njet - 1))
13293# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13294 allocate (z_th_arr(0:njet - 1))
13295# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13296 allocate (r_th_arr(0:njet - 1))
13297# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13298
13299# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13300 open (unit=10, file="jets.csv", status="old", action="read")
13301# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13302 do q = 0, njet - 1
13303# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13304 read (10, '(A)') line ! Read a full line as a string
13305# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13306 start = 1
13307# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13308
13309# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13310 do l = 0, 2
13311# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13312 end = index(line(start:), ',') ! Find the next comma
13313# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13314 if (end == 0) then
13315# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13316 value = trim(adjustl(line(start:))) ! Last value in the line
13317# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13318 else
13319# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13320 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
13321# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13322 start = start + end ! Move to next value
13323# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13324 end if
13325# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13326 if (l == 0) then
13327# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13328 read (value, *) y_th_arr(q) ! Convert string to numeric value
13329# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13330 elseif (l == 1) then
13331# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13332 read (value, *) z_th_arr(q)
13333# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13334 else
13335# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13336 read (value, *) r_th_arr(q)
13337# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13338 end if
13339# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13340 end do
13341# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13342 end do
13343# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13344 close (10)
13345# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13346
13347# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13348 do q = 0, p
13349# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13350 do l = 0, n
13351# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13352 rcut = 0._wp
13353# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13354 do s = 0, njet - 1
13355# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13356 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
13357# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13358 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
13359# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13360 end do
13361# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13362 rcut_arr(l, q) = rcut
13363# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13364 end do
13365# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13366 end do
13367# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13368 end if
13369# 1301 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13370
13371
13372 ! Transferring the cuboid's centroid and length information
13373 x_centroid = patch_icpp(patch_id)%x_centroid
13374 y_centroid = patch_icpp(patch_id)%y_centroid
13375 z_centroid = patch_icpp(patch_id)%z_centroid
13376 length_x = patch_icpp(patch_id)%length_x
13377 length_y = patch_icpp(patch_id)%length_y
13378 length_z = patch_icpp(patch_id)%length_z
13379
13380 ! Computing the beginning and the end x-, y- and z-coordinates of
13381 ! the cuboid based on its centroid and lengths
13382 x_boundary%beg = x_centroid - 0.5_wp*length_x
13383 x_boundary%end = x_centroid + 0.5_wp*length_x
13384 y_boundary%beg = y_centroid - 0.5_wp*length_y
13385 y_boundary%end = y_centroid + 0.5_wp*length_y
13386 z_boundary%beg = z_centroid - 0.5_wp*length_z
13387 z_boundary%end = z_centroid + 0.5_wp*length_z
13388
13389 ! Since the cuboidal patch does not allow for its boundaries to get
13390 ! smoothed out, the pseudo volume fraction is set to 1 to make sure
13391 ! that only the current patch contributes to the fluid state in the
13392 ! cells that this patch covers.
13393 eta = 1._wp
13394
13395 ! Checking whether the cuboid covers a particular cell in the domain
13396 ! and verifying whether the current patch has permission to write to
13397 ! to that cell. If both queries check out, the primitive variables
13398 ! of the current patch are assigned to this cell.
13399 do k = 0, p
13400 do j = 0, n
13401 do i = 0, m
13402
13403 if (grid_geometry == 3) then
13405 else
13406 cart_y = y_cc(j)
13407 cart_z = z_cc(k)
13408 end if
13409
13410 if (x_boundary%beg <= x_cc(i) .and. &
13411 x_boundary%end >= x_cc(i) .and. &
13412 y_boundary%beg <= cart_y .and. &
13413 y_boundary%end >= cart_y .and. &
13414 z_boundary%beg <= cart_z .and. &
13415 z_boundary%end >= cart_z) then
13416
13417 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
13418
13419 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
13420 eta, q_prim_vf, patch_id_fp)
13421
13422
13423 if (patch_icpp(patch_id)%hcid /= dflt_int) then
13424
13425# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13426 select case (patch_icpp(patch_id)%hcid)
13427# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13428 case (300) ! Rayleigh-Taylor instability
13429# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13430 rhoh = 3._wp
13431# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13432 rhol = 1._wp
13433# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13434 pref = 1.e5_wp
13435# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13436 pint = pref
13437# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13438 h = 0.7_wp
13439# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13440 lam = 0.2_wp
13441# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13442 wl = 2._wp*pi/lam
13443# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13444 amp = 0.025_wp/wl
13445# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13446
13447# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13448 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
13449# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13450
13451# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13452 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
13453# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13454
13455# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13456 if (alph < eps) alph = eps
13457# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13458 if (alph > 1._wp - eps) alph = 1._wp - eps
13459# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13460
13461# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13462 if (y_cc(j) > inth) then
13463# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13464 q_prim_vf(advxb)%sf(i, j, k) = alph
13465# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13466 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
13467# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13468 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
13469# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13470 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
13471# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13472 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
13473# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13474 else
13475# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13476 q_prim_vf(advxb)%sf(i, j, k) = alph
13477# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13478 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
13479# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13480 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
13481# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13482 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
13483# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13484 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
13485# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13486 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
13487# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13488 end if
13489# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13490
13491# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13492 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
13493# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13494 h = 0.0_wp
13495# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13496 lam = 1.0_wp
13497# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13498 amp = patch_icpp(patch_id)%a(2)
13499# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13500 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
13501# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13502 if (x_cc(i) > inth) then
13503# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13504 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
13505# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13506 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
13507# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13508 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
13509# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13510 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
13511# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13512 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
13513# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13514 end if
13515# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13516
13517# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13518 case (302) ! 3D Jet with IGR
13519# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13520 ux_th = 10*sqrt(1.4*0.4)
13521# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13522 ux_am = 0.0*sqrt(1.4)
13523# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13524 p_th = 2.0_wp
13525# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13526 p_am = 1.0_wp
13527# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13528 rho_th = 1._wp
13529# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13530 rho_am = 1._wp
13531# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13532 y_th = 0.0_wp
13533# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13534 z_th = 0.0_wp
13535# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13536 r_th = 1._wp
13537# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13538 eps_smooth = 1._wp
13539# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13540 eps = 1e-6
13541# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13542
13543# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13544 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
13545# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13546 rcut = f_cut_on(r - r_th, eps_smooth)
13547# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13548 xcut = f_cut_on(x_cc(i), eps_smooth)
13549# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13550
13551# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13552 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13553# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13554 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
13555# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13556 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
13557# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13558
13559# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13560 if (num_fluids == 1) then
13561# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13562 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13563# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13564 else
13565# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13566 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13567# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13568 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
13569# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13570 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
13571# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13572 end if
13573# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13574
13575# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13576 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
13577# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13578
13579# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13580 case (303) ! 3D Multijet
13581# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13582
13583# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13584 eps_smooth = 3.0_wp
13585# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13586 ux_th = 10*sqrt(1.4*0.4)
13587# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13588 ux_am = 2.5*sqrt(1.4*0.4)
13589# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13590 p_th = 0.8_wp
13591# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13592 p_am = 0.4_wp
13593# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13594 rho_th = 1._wp
13595# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13596 rho_am = 1._wp
13597# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13598 eps = 1e-6
13599# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13600
13601# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13602 rcut = rcut_arr(j, k)
13603# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13604 xcut = f_cut_on(x_cc(i), eps_smooth)
13605# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13606
13607# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13608 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13609# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13610 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
13611# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13612 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
13613# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13614
13615# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13616 if (num_fluids == 1) then
13617# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13618 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13619# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13620 else
13621# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13622 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13623# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13624 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
13625# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13626 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
13627# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13628 end if
13629# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13630
13631# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13632 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
13633# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13634
13635# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13636 case (370)
13637# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13638 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
13639# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13640
13641# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13642 if (.not. files_loaded) then
13643# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13644 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13645# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13646 do f = 1, max_files
13647# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13648 write (file_num_str, '(I0)') f
13649# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13650 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
13651# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13652 end do
13653# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13654
13655# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13656 ! Common file reading setup
13657# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13658 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13659# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13660 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
13661# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13662
13663# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13664 select case (num_dims)
13665# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13666 case (1, 2) ! 1D and 2D cases are similar
13667# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13668 ! Count lines
13669# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13670 line_count = 0
13671# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13672 do
13673# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13674 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13675# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13676 if (ios2 /= 0) exit
13677# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13678 line_count = line_count + 1
13679# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13680 end do
13681# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13682 close (unit2)
13683# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13684
13685# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13686 xrows = line_count
13687# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13688 yrows = 1
13689# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13690 index_x = 0
13691# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13692 if (num_dims == 2) index_x = i
13693# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13694#ifdef MFC_DEBUG
13695# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13696 block
13697# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13698 use iso_fortran_env, only: output_unit
13699# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13700
13701# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13702 print *, 'm_icpp_patches.fpp:1355: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13703# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13704
13705# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13706 call flush (output_unit)
13707# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13708 end block
13709# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13710#endif
13711# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13712 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13713# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13714
13715# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13716
13717# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13718
13719# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13720#if defined(MFC_OpenACC)
13721# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13722!$acc enter data create(x_coords, stored_values)
13723# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13724#elif defined(MFC_OpenMP)
13725# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13726!$omp target enter data map(always,alloc:x_coords, stored_values)
13727# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13728#endif
13729# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13730
13731# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13732 ! Read data from all files
13733# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13734 do f = 1, max_files
13735# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13736 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13737# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13738 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
13739# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13740
13741# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13742 do iter = 1, xrows
13743# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13744 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13745# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13746 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
13747# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13748 end do
13749# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13750 close (unit)
13751# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13752 end do
13753# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13754
13755# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13756 ! Calculate offsets
13757# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13758 domain_xstart = x_coords(1)
13759# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13760 x_step = x_cc(1) - x_cc(0)
13761# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13762 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
13763# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13764 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
13765# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13766 global_offset_x = nint(abs(delta_x)/x_step)
13767# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13768
13769# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13770 case (3) ! 3D case - determine grid structure
13771# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13772 ! Find yRows by counting rows with same x
13773# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13774 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13775# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13776 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13777# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13778
13779# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13780 yrows = 1
13781# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13782 do
13783# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13784 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13785# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13786 if (ios2 /= 0) exit
13787# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13788 if (dummy_x == x0 .and. dummy_y /= y0) then
13789# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13790 yrows = yrows + 1
13791# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13792 else
13793# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13794 exit
13795# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13796 end if
13797# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13798 end do
13799# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13800 close (unit2)
13801# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13802
13803# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13804 ! Count total rows
13805# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13806 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13807# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13808 nrows = 0
13809# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13810 do
13811# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13812 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13813# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13814 if (ios2 /= 0) exit
13815# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13816 nrows = nrows + 1
13817# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13818 end do
13819# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13820 close (unit2)
13821# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13822
13823# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13824 xrows = nrows/yrows
13825# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13826#ifdef MFC_DEBUG
13827# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13828 block
13829# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13830 use iso_fortran_env, only: output_unit
13831# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13832
13833# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13834 print *, 'm_icpp_patches.fpp:1355: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13835# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13836
13837# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13838 call flush (output_unit)
13839# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13840 end block
13841# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13842#endif
13843# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13844 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13845# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13846
13847# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13848
13849# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13850
13851# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13852
13853# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13854#if defined(MFC_OpenACC)
13855# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13856!$acc enter data create(x_coords, y_coords, stored_values)
13857# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13858#elif defined(MFC_OpenMP)
13859# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13860!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13861# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13862#endif
13863# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13864 index_x = i
13865# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13866 index_y = j
13867# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13868
13869# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13870 ! Read all files
13871# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13872 do f = 1, max_files
13873# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13874 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13875# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13876 if (ios /= 0) then
13877# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13878 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
13879# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13880 cycle
13881# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13882 end if
13883# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13884
13885# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13886 iter = 0
13887# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13888 do iix = 1, xrows
13889# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13890 do iiy = 1, yrows
13891# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13892 iter = iter + 1
13893# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13894 if (f == 1) then
13895# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13896 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13897# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13898 else
13899# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13900 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13901# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13902 end if
13903# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13904 if (ios /= 0) call s_mpi_abort("Error reading data")
13905# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13906 end do
13907# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13908 end do
13909# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13910 close (unit)
13911# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13912 end do
13913# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13914
13915# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13916 ! Calculate offsets
13917# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13918 x_step = x_cc(1) - x_cc(0)
13919# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13920 y_step = y_cc(1) - y_cc(0)
13921# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13922 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
13923# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13924 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
13925# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13926 global_offset_x = nint(abs(delta_x)/x_step)
13927# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13928 global_offset_y = nint(abs(delta_y)/y_step)
13929# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13930 end select
13931# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13932
13933# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13934 files_loaded = .true.
13935# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13936 end if
13937# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13938
13939# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13940 ! Data assignment
13941# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13942 select case (num_dims)
13943# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13944 case (1)
13945# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13946 idx = i + 1 + global_offset_x
13947# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13948 do f = 1, sys_size
13949# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13950 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13951# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13952 end do
13953# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13954
13955# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13956 case (2)
13957# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13958 idx = i + 1 + global_offset_x - index_x
13959# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13960 do f = 1, sys_size - 1
13961# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13962 jump = merge(1, 0, f >= momxe)
13963# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13964 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13965# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13966 end do
13967# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13968 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
13969# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13970
13971# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13972 case (3)
13973# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13974 idx = i + 1 + global_offset_x - index_x
13975# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13976 idy = j + 1 + global_offset_y - index_y
13977# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13978 do f = 1, sys_size - 1
13979# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13980 jump = merge(1, 0, f >= momxe)
13981# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13982 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13983# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13984 end do
13985# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13986 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
13987# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13988 end select
13989# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13990
13991# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13992 case (380)
13993# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13994 ! This is patch is hard-coded for test suite optimization used in the
13995# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13996 ! 3D_TaylorGreenVortex case:
13997# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13998 ! This analytic patch used geometry 9
13999# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14000 mach = 0.1
14001# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14002 if (patch_id == 1) then
14003# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14004 q_prim_vf(e_idx)%sf(i, j, 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)
14005# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14006 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
14007# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14008 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
14009# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14010 end if
14011# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14012
14013# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14014 case default
14015# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14016 call s_int_to_str(patch_id, istr)
14017# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14018 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
14019# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14020 end select
14021# 1355 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14022
14023 end if
14024
14025 ! Updating the patch identities bookkeeping variable
14026 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
14027
14028 end if
14029 end if
14030 end do
14031 end do
14032 end do
14033 if (allocated(stored_values)) then
14034# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14035#ifdef MFC_DEBUG
14036# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14037 block
14038# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14039 use iso_fortran_env, only: output_unit
14040# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14041
14042# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14043 print *, 'm_icpp_patches.fpp:1366: ', '@:DEALLOCATE(stored_values)'
14044# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14045
14046# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14047 call flush (output_unit)
14048# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14049 end block
14050# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14051#endif
14052# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14053
14054# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14055#if defined(MFC_OpenACC)
14056# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14057!$acc exit data delete(stored_values)
14058# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14059#elif defined(MFC_OpenMP)
14060# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14061!$omp target exit data map(release:stored_values)
14062# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14063#endif
14064# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14065 deallocate (stored_values)
14066# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14067#ifdef MFC_DEBUG
14068# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14069 block
14070# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14071 use iso_fortran_env, only: output_unit
14072# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14073
14074# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14075 print *, 'm_icpp_patches.fpp:1366: ', '@:DEALLOCATE(x_coords)'
14076# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14077
14078# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14079 call flush (output_unit)
14080# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14081 end block
14082# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14083#endif
14084# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14085
14086# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14087#if defined(MFC_OpenACC)
14088# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14089!$acc exit data delete(x_coords)
14090# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14091#elif defined(MFC_OpenMP)
14092# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14093!$omp target exit data map(release:x_coords)
14094# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14095#endif
14096# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14097 deallocate (x_coords)
14098# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14099 end if
14100# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14101
14102# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14103 if (allocated(y_coords)) then
14104# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14105#ifdef MFC_DEBUG
14106# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14107 block
14108# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14109 use iso_fortran_env, only: output_unit
14110# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14111
14112# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14113 print *, 'm_icpp_patches.fpp:1366: ', '@:DEALLOCATE(y_coords)'
14114# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14115
14116# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14117 call flush (output_unit)
14118# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14119 end block
14120# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14121#endif
14122# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14123
14124# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14125#if defined(MFC_OpenACC)
14126# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14127!$acc exit data delete(y_coords)
14128# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14129#elif defined(MFC_OpenMP)
14130# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14131!$omp target exit data map(release:y_coords)
14132# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14133#endif
14134# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14135 deallocate (y_coords)
14136# 1366 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14137 end if
14138
14139 end subroutine s_icpp_cuboid
14140
14141 !> The cylindrical patch is a 3D geometry that may be used,
14142 !! for example, in setting up a cylindrical solid boundary
14143 !! confinement, like a blood vessel. The geometry of this
14144 !! patch is well-defined when the centroid, the radius and
14145 !! the length along the cylinder's axis, parallel to the x-,
14146 !! y- or z-coordinate direction, are provided. Please note
14147 !! that the cylindrical patch DOES allow for the smoothing
14148 !! of its lateral boundary.
14149 !! @param patch_id is the patch identifier
14150 !! @param patch_id_fp Array to track patch ids
14151 !! @param q_prim_vf Array of primitive variables
14152 subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
14153
14154 integer, intent(in) :: patch_id
14155#ifdef MFC_MIXED_PRECISION
14156 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
14157#else
14158 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
14159#endif
14160 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
14161
14162 integer :: i, j, k !< Generic loop iterators
14163 real(wp) :: radius
14164 integer :: xRows, yRows, nRows, iix, iiy, max_files
14165# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14166 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
14167# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14168 real(wp) :: x_len, x_step, y_len, y_step
14169# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14170 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
14171# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14172 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
14173# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14174 real(wp) :: delta_x, delta_y
14175# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14176 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
14177# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14178 character(len=200) :: errmsg
14179# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14180 real(wp), allocatable :: stored_values(:, :, :)
14181# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14182 real(wp), allocatable :: x_coords(:), y_coords(:)
14183# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14184 logical :: files_loaded = .false.
14185# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14186 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
14187# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14188 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
14189# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14190 character(len=20) :: file_num_str ! For storing the file number as a string
14191# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14192 character(len=20) :: zeros_part ! For the trailing zeros part
14193# 1393 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14194 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
14195 ! Place any declaration of intermediate variables here
14196# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14197 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
14198# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14199 real(wp) :: eps
14200# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14201
14202# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14203 ! IGR Jets
14204# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14205 ! Arrays to stor position and radii of jets from input file
14206# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14207 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
14208# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14209 ! Variables to describe initial condition of jet
14210# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14211 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
14212# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14213 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
14214# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14215
14216# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14217 real(wp), dimension(0:n, 0:p) :: rcut_arr
14218# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14219 integer :: l, q, s ! Iterators for reading input files
14220# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14221 integer :: start, end ! Ints to keep track of position in file
14222# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14223 character(len=1000) :: line ! String to store line in ile
14224# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14225 character(len=25) :: value ! String to store value in line
14226# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14227 integer :: NJet ! Number of jets
14228# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14229
14230# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14231 eps = 1e-9_wp
14232# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14233
14234# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14235 if (patch_icpp(patch_id)%hcid == 303) then
14236# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14237 eps_smooth = 3._wp
14238# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14239 open (unit=10, file="njet.txt", status="old", action="read")
14240# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14241 read (10, *) njet
14242# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14243 close (10)
14244# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14245
14246# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14247 allocate (y_th_arr(0:njet - 1))
14248# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14249 allocate (z_th_arr(0:njet - 1))
14250# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14251 allocate (r_th_arr(0:njet - 1))
14252# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14253
14254# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14255 open (unit=10, file="jets.csv", status="old", action="read")
14256# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14257 do q = 0, njet - 1
14258# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14259 read (10, '(A)') line ! Read a full line as a string
14260# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14261 start = 1
14262# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14263
14264# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14265 do l = 0, 2
14266# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14267 end = index(line(start:), ',') ! Find the next comma
14268# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14269 if (end == 0) then
14270# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14271 value = trim(adjustl(line(start:))) ! Last value in the line
14272# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14273 else
14274# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14275 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
14276# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14277 start = start + end ! Move to next value
14278# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14279 end if
14280# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14281 if (l == 0) then
14282# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14283 read (value, *) y_th_arr(q) ! Convert string to numeric value
14284# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14285 elseif (l == 1) then
14286# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14287 read (value, *) z_th_arr(q)
14288# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14289 else
14290# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14291 read (value, *) r_th_arr(q)
14292# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14293 end if
14294# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14295 end do
14296# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14297 end do
14298# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14299 close (10)
14300# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14301
14302# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14303 do q = 0, p
14304# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14305 do l = 0, n
14306# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14307 rcut = 0._wp
14308# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14309 do s = 0, njet - 1
14310# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14311 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
14312# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14313 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
14314# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14315 end do
14316# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14317 rcut_arr(l, q) = rcut
14318# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14319 end do
14320# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14321 end do
14322# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14323 end if
14324# 1394 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14325
14326
14327 ! Transferring the cylindrical patch's centroid, length, radius,
14328 ! smoothing patch identity and smoothing coefficient information
14329 x_centroid = patch_icpp(patch_id)%x_centroid
14330 y_centroid = patch_icpp(patch_id)%y_centroid
14331 z_centroid = patch_icpp(patch_id)%z_centroid
14332 length_x = patch_icpp(patch_id)%length_x
14333 length_y = patch_icpp(patch_id)%length_y
14334 length_z = patch_icpp(patch_id)%length_z
14335 radius = patch_icpp(patch_id)%radius
14336 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
14337 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
14338
14339 ! Computing the beginning and the end x-, y- and z-coordinates of
14340 ! the cylinder based on its centroid and lengths
14341 x_boundary%beg = x_centroid - 0.5_wp*length_x
14342 x_boundary%end = x_centroid + 0.5_wp*length_x
14343 y_boundary%beg = y_centroid - 0.5_wp*length_y
14344 y_boundary%end = y_centroid + 0.5_wp*length_y
14345 z_boundary%beg = z_centroid - 0.5_wp*length_z
14346 z_boundary%end = z_centroid + 0.5_wp*length_z
14347
14348 ! Initializing the pseudo volume fraction value to 1. The value will
14349 ! be modified as the patch is laid out on the grid, but only in the
14350 ! case that smearing of the cylindrical patch's boundary is enabled.
14351 eta = 1._wp
14352
14353 ! Checking whether the cylinder covers a particular cell in the
14354 ! domain and verifying whether the current patch has the permission
14355 ! to write to that cell. If both queries check out, the primitive
14356 ! variables of the current patch are assigned to this cell.
14357 do k = 0, p
14358 do j = 0, n
14359 do i = 0, m
14360
14361 if (grid_geometry == 3) then
14363 else
14364 cart_y = y_cc(j)
14365 cart_z = z_cc(k)
14366 end if
14367
14368 if (patch_icpp(patch_id)%smoothen) then
14369 if (.not. f_is_default(length_x)) then
14370 eta = tanh(smooth_coeff/min(dy, dz)* &
14371 (sqrt((cart_y - y_centroid)**2 &
14372 + (cart_z - z_centroid)**2) &
14373 - radius))*(-0.5_wp) + 0.5_wp
14374 elseif (.not. f_is_default(length_y)) then
14375 eta = tanh(smooth_coeff/min(dx, dz)* &
14376 (sqrt((x_cc(i) - x_centroid)**2 &
14377 + (cart_z - z_centroid)**2) &
14378 - radius))*(-0.5_wp) + 0.5_wp
14379 else
14380 eta = tanh(smooth_coeff/min(dx, dy)* &
14381 (sqrt((x_cc(i) - x_centroid)**2 &
14382 + (cart_y - y_centroid)**2) &
14383 - radius))*(-0.5_wp) + 0.5_wp
14384 end if
14385 end if
14386
14387 if (((.not. f_is_default(length_x) .and. &
14388 (cart_y - y_centroid)**2 &
14389 + (cart_z - z_centroid)**2 <= radius**2 .and. &
14390 x_boundary%beg <= x_cc(i) .and. &
14391 x_boundary%end >= x_cc(i)) &
14392 .or. &
14393 (.not. f_is_default(length_y) .and. &
14394 (x_cc(i) - x_centroid)**2 &
14395 + (cart_z - z_centroid)**2 <= radius**2 .and. &
14396 y_boundary%beg <= cart_y .and. &
14397 y_boundary%end >= cart_y) &
14398 .or. &
14399 (.not. f_is_default(length_z) .and. &
14400 (x_cc(i) - x_centroid)**2 &
14401 + (cart_y - y_centroid)**2 <= radius**2 .and. &
14402 z_boundary%beg <= cart_z .and. &
14403 z_boundary%end >= cart_z) .and. &
14404 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. &
14405 patch_id_fp(i, j, k) == smooth_patch_id) then
14406
14407 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
14408 eta, q_prim_vf, patch_id_fp)
14409
14410
14411 if (patch_icpp(patch_id)%hcid /= dflt_int) then
14412
14413# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14414 select case (patch_icpp(patch_id)%hcid)
14415# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14416 case (300) ! Rayleigh-Taylor instability
14417# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14418 rhoh = 3._wp
14419# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14420 rhol = 1._wp
14421# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14422 pref = 1.e5_wp
14423# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14424 pint = pref
14425# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14426 h = 0.7_wp
14427# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14428 lam = 0.2_wp
14429# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14430 wl = 2._wp*pi/lam
14431# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14432 amp = 0.025_wp/wl
14433# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14434
14435# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14436 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
14437# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14438
14439# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14440 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
14441# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14442
14443# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14444 if (alph < eps) alph = eps
14445# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14446 if (alph > 1._wp - eps) alph = 1._wp - eps
14447# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14448
14449# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14450 if (y_cc(j) > inth) then
14451# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14452 q_prim_vf(advxb)%sf(i, j, k) = alph
14453# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14454 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
14455# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14456 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
14457# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14458 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
14459# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14460 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
14461# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14462 else
14463# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14464 q_prim_vf(advxb)%sf(i, j, k) = alph
14465# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14466 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
14467# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14468 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
14469# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14470 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
14471# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14472 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
14473# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14474 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
14475# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14476 end if
14477# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14478
14479# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14480 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
14481# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14482 h = 0.0_wp
14483# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14484 lam = 1.0_wp
14485# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14486 amp = patch_icpp(patch_id)%a(2)
14487# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14488 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
14489# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14490 if (x_cc(i) > inth) then
14491# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14492 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
14493# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14494 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
14495# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14496 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
14497# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14498 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
14499# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14500 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
14501# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14502 end if
14503# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14504
14505# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14506 case (302) ! 3D Jet with IGR
14507# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14508 ux_th = 10*sqrt(1.4*0.4)
14509# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14510 ux_am = 0.0*sqrt(1.4)
14511# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14512 p_th = 2.0_wp
14513# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14514 p_am = 1.0_wp
14515# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14516 rho_th = 1._wp
14517# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14518 rho_am = 1._wp
14519# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14520 y_th = 0.0_wp
14521# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14522 z_th = 0.0_wp
14523# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14524 r_th = 1._wp
14525# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14526 eps_smooth = 1._wp
14527# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14528 eps = 1e-6
14529# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14530
14531# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14532 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
14533# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14534 rcut = f_cut_on(r - r_th, eps_smooth)
14535# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14536 xcut = f_cut_on(x_cc(i), eps_smooth)
14537# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14538
14539# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14540 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14541# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14542 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
14543# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14544 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
14545# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14546
14547# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14548 if (num_fluids == 1) then
14549# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14550 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14551# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14552 else
14553# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14554 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14555# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14556 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
14557# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14558 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
14559# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14560 end if
14561# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14562
14563# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14564 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
14565# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14566
14567# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14568 case (303) ! 3D Multijet
14569# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14570
14571# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14572 eps_smooth = 3.0_wp
14573# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14574 ux_th = 10*sqrt(1.4*0.4)
14575# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14576 ux_am = 2.5*sqrt(1.4*0.4)
14577# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14578 p_th = 0.8_wp
14579# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14580 p_am = 0.4_wp
14581# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14582 rho_th = 1._wp
14583# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14584 rho_am = 1._wp
14585# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14586 eps = 1e-6
14587# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14588
14589# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14590 rcut = rcut_arr(j, k)
14591# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14592 xcut = f_cut_on(x_cc(i), eps_smooth)
14593# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14594
14595# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14596 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14597# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14598 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
14599# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14600 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
14601# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14602
14603# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14604 if (num_fluids == 1) then
14605# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14606 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14607# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14608 else
14609# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14610 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14611# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14612 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
14613# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14614 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
14615# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14616 end if
14617# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14618
14619# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14620 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
14621# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14622
14623# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14624 case (370)
14625# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14626 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
14627# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14628
14629# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14630 if (.not. files_loaded) then
14631# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14632 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
14633# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14634 do f = 1, max_files
14635# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14636 write (file_num_str, '(I0)') f
14637# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14638 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
14639# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14640 end do
14641# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14642
14643# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14644 ! Common file reading setup
14645# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14646 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14647# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14648 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
14649# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14650
14651# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14652 select case (num_dims)
14653# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14654 case (1, 2) ! 1D and 2D cases are similar
14655# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14656 ! Count lines
14657# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14658 line_count = 0
14659# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14660 do
14661# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14662 read (unit2, *, iostat=ios2) dummy_x, dummy_y
14663# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14664 if (ios2 /= 0) exit
14665# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14666 line_count = line_count + 1
14667# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14668 end do
14669# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14670 close (unit2)
14671# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14672
14673# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14674 xrows = line_count
14675# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14676 yrows = 1
14677# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14678 index_x = 0
14679# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14680 if (num_dims == 2) index_x = i
14681# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14682#ifdef MFC_DEBUG
14683# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14684 block
14685# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14686 use iso_fortran_env, only: output_unit
14687# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14688
14689# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14690 print *, 'm_icpp_patches.fpp:1481: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
14691# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14692
14693# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14694 call flush (output_unit)
14695# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14696 end block
14697# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14698#endif
14699# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14700 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
14701# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14702
14703# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14704
14705# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14706
14707# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14708#if defined(MFC_OpenACC)
14709# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14710!$acc enter data create(x_coords, stored_values)
14711# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14712#elif defined(MFC_OpenMP)
14713# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14714!$omp target enter data map(always,alloc:x_coords, stored_values)
14715# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14716#endif
14717# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14718
14719# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14720 ! Read data from all files
14721# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14722 do f = 1, max_files
14723# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14724 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14725# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14726 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
14727# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14728
14729# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14730 do iter = 1, xrows
14731# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14732 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
14733# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14734 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
14735# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14736 end do
14737# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14738 close (unit)
14739# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14740 end do
14741# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14742
14743# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14744 ! Calculate offsets
14745# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14746 domain_xstart = x_coords(1)
14747# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14748 x_step = x_cc(1) - x_cc(0)
14749# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14750 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
14751# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14752 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
14753# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14754 global_offset_x = nint(abs(delta_x)/x_step)
14755# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14756
14757# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14758 case (3) ! 3D case - determine grid structure
14759# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14760 ! Find yRows by counting rows with same x
14761# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14762 read (unit2, *, iostat=ios2) x0, y0, dummy_z
14763# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14764 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
14765# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14766
14767# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14768 yrows = 1
14769# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14770 do
14771# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14772 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14773# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14774 if (ios2 /= 0) exit
14775# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14776 if (dummy_x == x0 .and. dummy_y /= y0) then
14777# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14778 yrows = yrows + 1
14779# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14780 else
14781# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14782 exit
14783# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14784 end if
14785# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14786 end do
14787# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14788 close (unit2)
14789# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14790
14791# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14792 ! Count total rows
14793# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14794 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14795# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14796 nrows = 0
14797# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14798 do
14799# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14800 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14801# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14802 if (ios2 /= 0) exit
14803# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14804 nrows = nrows + 1
14805# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14806 end do
14807# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14808 close (unit2)
14809# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14810
14811# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14812 xrows = nrows/yrows
14813# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14814#ifdef MFC_DEBUG
14815# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14816 block
14817# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14818 use iso_fortran_env, only: output_unit
14819# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14820
14821# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14822 print *, 'm_icpp_patches.fpp:1481: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14823# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14824
14825# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14826 call flush (output_unit)
14827# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14828 end block
14829# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14830#endif
14831# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14832 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14833# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14834
14835# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14836
14837# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14838
14839# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14840
14841# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14842#if defined(MFC_OpenACC)
14843# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14844!$acc enter data create(x_coords, y_coords, stored_values)
14845# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14846#elif defined(MFC_OpenMP)
14847# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14848!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14849# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14850#endif
14851# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14852 index_x = i
14853# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14854 index_y = j
14855# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14856
14857# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14858 ! Read all files
14859# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14860 do f = 1, max_files
14861# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14862 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14863# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14864 if (ios /= 0) then
14865# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14866 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
14867# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14868 cycle
14869# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14870 end if
14871# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14872
14873# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14874 iter = 0
14875# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14876 do iix = 1, xrows
14877# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14878 do iiy = 1, yrows
14879# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14880 iter = iter + 1
14881# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14882 if (f == 1) then
14883# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14884 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14885# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14886 else
14887# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14888 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14889# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14890 end if
14891# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14892 if (ios /= 0) call s_mpi_abort("Error reading data")
14893# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14894 end do
14895# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14896 end do
14897# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14898 close (unit)
14899# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14900 end do
14901# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14902
14903# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14904 ! Calculate offsets
14905# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14906 x_step = x_cc(1) - x_cc(0)
14907# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14908 y_step = y_cc(1) - y_cc(0)
14909# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14910 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
14911# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14912 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
14913# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14914 global_offset_x = nint(abs(delta_x)/x_step)
14915# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14916 global_offset_y = nint(abs(delta_y)/y_step)
14917# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14918 end select
14919# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14920
14921# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14922 files_loaded = .true.
14923# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14924 end if
14925# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14926
14927# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14928 ! Data assignment
14929# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14930 select case (num_dims)
14931# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14932 case (1)
14933# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14934 idx = i + 1 + global_offset_x
14935# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14936 do f = 1, sys_size
14937# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14938 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14939# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14940 end do
14941# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14942
14943# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14944 case (2)
14945# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14946 idx = i + 1 + global_offset_x - index_x
14947# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14948 do f = 1, sys_size - 1
14949# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14950 jump = merge(1, 0, f >= momxe)
14951# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14952 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14953# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14954 end do
14955# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14956 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
14957# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14958
14959# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14960 case (3)
14961# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14962 idx = i + 1 + global_offset_x - index_x
14963# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14964 idy = j + 1 + global_offset_y - index_y
14965# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14966 do f = 1, sys_size - 1
14967# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14968 jump = merge(1, 0, f >= momxe)
14969# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14970 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14971# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14972 end do
14973# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14974 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
14975# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14976 end select
14977# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14978
14979# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14980 case (380)
14981# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14982 ! This is patch is hard-coded for test suite optimization used in the
14983# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14984 ! 3D_TaylorGreenVortex case:
14985# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14986 ! This analytic patch used geometry 9
14987# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14988 mach = 0.1
14989# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14990 if (patch_id == 1) then
14991# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14992 q_prim_vf(e_idx)%sf(i, j, 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)
14993# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14994 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
14995# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14996 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
14997# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14998 end if
14999# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15000
15001# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15002 case default
15003# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15004 call s_int_to_str(patch_id, istr)
15005# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15006 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
15007# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15008 end select
15009# 1481 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15010
15011 end if
15012
15013 ! Updating the patch identities bookkeeping variable
15014 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
15015 end if
15016 end do
15017 end do
15018 end do
15019 if (allocated(stored_values)) then
15020# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15021#ifdef MFC_DEBUG
15022# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15023 block
15024# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15025 use iso_fortran_env, only: output_unit
15026# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15027
15028# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15029 print *, 'm_icpp_patches.fpp:1490: ', '@:DEALLOCATE(stored_values)'
15030# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15031
15032# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15033 call flush (output_unit)
15034# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15035 end block
15036# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15037#endif
15038# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15039
15040# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15041#if defined(MFC_OpenACC)
15042# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15043!$acc exit data delete(stored_values)
15044# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15045#elif defined(MFC_OpenMP)
15046# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15047!$omp target exit data map(release:stored_values)
15048# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15049#endif
15050# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15051 deallocate (stored_values)
15052# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15053#ifdef MFC_DEBUG
15054# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15055 block
15056# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15057 use iso_fortran_env, only: output_unit
15058# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15059
15060# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15061 print *, 'm_icpp_patches.fpp:1490: ', '@:DEALLOCATE(x_coords)'
15062# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15063
15064# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15065 call flush (output_unit)
15066# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15067 end block
15068# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15069#endif
15070# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15071
15072# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15073#if defined(MFC_OpenACC)
15074# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15075!$acc exit data delete(x_coords)
15076# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15077#elif defined(MFC_OpenMP)
15078# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15079!$omp target exit data map(release:x_coords)
15080# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15081#endif
15082# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15083 deallocate (x_coords)
15084# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15085 end if
15086# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15087
15088# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15089 if (allocated(y_coords)) then
15090# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15091#ifdef MFC_DEBUG
15092# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15093 block
15094# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15095 use iso_fortran_env, only: output_unit
15096# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15097
15098# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15099 print *, 'm_icpp_patches.fpp:1490: ', '@:DEALLOCATE(y_coords)'
15100# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15101
15102# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15103 call flush (output_unit)
15104# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15105 end block
15106# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15107#endif
15108# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15109
15110# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15111#if defined(MFC_OpenACC)
15112# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15113!$acc exit data delete(y_coords)
15114# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15115#elif defined(MFC_OpenMP)
15116# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15117!$omp target exit data map(release:y_coords)
15118# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15119#endif
15120# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15121 deallocate (y_coords)
15122# 1490 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15123 end if
15124
15125 end subroutine s_icpp_cylinder
15126
15127 !> The swept plane patch is a 3D geometry that may be used,
15128 !! for example, in creating a solid boundary, or pre-/post-
15129 !! shock region, at an angle with respect to the axes of the
15130 !! Cartesian coordinate system. The geometry of the patch is
15131 !! well-defined when its centroid and normal vector, aimed
15132 !! in the sweep direction, are provided. Note that the sweep
15133 !! plane patch DOES allow the smoothing of its boundary.
15134 !! @param patch_id is the patch identifier
15135 !! @param patch_id_fp Array to track patch ids
15136 !! @param q_prim_vf Primitive variables
15137 subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
15138
15139 integer, intent(in) :: patch_id
15140#ifdef MFC_MIXED_PRECISION
15141 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
15142#else
15143 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
15144#endif
15145 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
15146
15147 integer :: i, j, k !< Generic loop iterators
15148 real(wp) :: a, b, c, d
15149 integer :: xRows, yRows, nRows, iix, iiy, max_files
15150# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15151 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
15152# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15153 real(wp) :: x_len, x_step, y_len, y_step
15154# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15155 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
15156# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15157 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
15158# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15159 real(wp) :: delta_x, delta_y
15160# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15161 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
15162# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15163 character(len=200) :: errmsg
15164# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15165 real(wp), allocatable :: stored_values(:, :, :)
15166# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15167 real(wp), allocatable :: x_coords(:), y_coords(:)
15168# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15169 logical :: files_loaded = .false.
15170# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15171 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
15172# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15173 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
15174# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15175 character(len=20) :: file_num_str ! For storing the file number as a string
15176# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15177 character(len=20) :: zeros_part ! For the trailing zeros part
15178# 1516 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15179 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
15180 ! Place any declaration of intermediate variables here
15181# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15182 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
15183# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15184 real(wp) :: eps
15185# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15186
15187# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15188 ! IGR Jets
15189# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15190 ! Arrays to stor position and radii of jets from input file
15191# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15192 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
15193# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15194 ! Variables to describe initial condition of jet
15195# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15196 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
15197# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15198 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
15199# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15200
15201# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15202 real(wp), dimension(0:n, 0:p) :: rcut_arr
15203# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15204 integer :: l, q, s ! Iterators for reading input files
15205# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15206 integer :: start, end ! Ints to keep track of position in file
15207# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15208 character(len=1000) :: line ! String to store line in ile
15209# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15210 character(len=25) :: value ! String to store value in line
15211# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15212 integer :: NJet ! Number of jets
15213# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15214
15215# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15216 eps = 1e-9_wp
15217# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15218
15219# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15220 if (patch_icpp(patch_id)%hcid == 303) then
15221# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15222 eps_smooth = 3._wp
15223# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15224 open (unit=10, file="njet.txt", status="old", action="read")
15225# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15226 read (10, *) njet
15227# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15228 close (10)
15229# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15230
15231# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15232 allocate (y_th_arr(0:njet - 1))
15233# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15234 allocate (z_th_arr(0:njet - 1))
15235# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15236 allocate (r_th_arr(0:njet - 1))
15237# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15238
15239# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15240 open (unit=10, file="jets.csv", status="old", action="read")
15241# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15242 do q = 0, njet - 1
15243# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15244 read (10, '(A)') line ! Read a full line as a string
15245# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15246 start = 1
15247# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15248
15249# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15250 do l = 0, 2
15251# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15252 end = index(line(start:), ',') ! Find the next comma
15253# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15254 if (end == 0) then
15255# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15256 value = trim(adjustl(line(start:))) ! Last value in the line
15257# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15258 else
15259# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15260 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
15261# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15262 start = start + end ! Move to next value
15263# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15264 end if
15265# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15266 if (l == 0) then
15267# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15268 read (value, *) y_th_arr(q) ! Convert string to numeric value
15269# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15270 elseif (l == 1) then
15271# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15272 read (value, *) z_th_arr(q)
15273# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15274 else
15275# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15276 read (value, *) r_th_arr(q)
15277# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15278 end if
15279# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15280 end do
15281# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15282 end do
15283# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15284 close (10)
15285# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15286
15287# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15288 do q = 0, p
15289# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15290 do l = 0, n
15291# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15292 rcut = 0._wp
15293# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15294 do s = 0, njet - 1
15295# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15296 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
15297# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15298 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
15299# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15300 end do
15301# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15302 rcut_arr(l, q) = rcut
15303# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15304 end do
15305# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15306 end do
15307# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15308 end if
15309# 1517 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15310
15311
15312 ! Transferring the centroid information of the plane to be swept
15313 x_centroid = patch_icpp(patch_id)%x_centroid
15314 y_centroid = patch_icpp(patch_id)%y_centroid
15315 z_centroid = patch_icpp(patch_id)%z_centroid
15316 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
15317 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
15318
15319 ! Obtaining coefficients of the equation describing the sweep plane
15320 a = patch_icpp(patch_id)%normal(1)
15321 b = patch_icpp(patch_id)%normal(2)
15322 c = patch_icpp(patch_id)%normal(3)
15323 d = -a*x_centroid - b*y_centroid - c*z_centroid
15324
15325 ! Initializing the pseudo volume fraction value to 1. The value will
15326 ! be modified as the patch is laid out on the grid, but only in the
15327 ! case that smearing of the sweep plane patch's boundary is enabled.
15328 eta = 1._wp
15329
15330 ! Checking whether the region swept by the plane covers a particular
15331 ! cell in the domain and verifying whether the current patch has the
15332 ! permission to write to that cell. If both queries check out, the
15333 ! primitive variables of the current patch are written to this cell.
15334 do k = 0, p
15335 do j = 0, n
15336 do i = 0, m
15337
15338 if (grid_geometry == 3) then
15340 else
15341 cart_y = y_cc(j)
15342 cart_z = z_cc(k)
15343 end if
15344
15345 if (patch_icpp(patch_id)%smoothen) then
15346 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, dz) &
15347 *(a*x_cc(i) + &
15348 b*cart_y + &
15349 c*cart_z + d) &
15350 /sqrt(a**2 + b**2 + c**2))
15351 end if
15352
15353 if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0._wp &
15354 .and. &
15355 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) &
15356 .or. &
15357 patch_id_fp(i, j, k) == smooth_patch_id) &
15358 then
15359
15360 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
15361 eta, q_prim_vf, patch_id_fp)
15362
15363
15364 if (patch_icpp(patch_id)%hcid /= dflt_int) then
15365
15366# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15367 select case (patch_icpp(patch_id)%hcid)
15368# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15369 case (300) ! Rayleigh-Taylor instability
15370# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15371 rhoh = 3._wp
15372# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15373 rhol = 1._wp
15374# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15375 pref = 1.e5_wp
15376# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15377 pint = pref
15378# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15379 h = 0.7_wp
15380# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15381 lam = 0.2_wp
15382# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15383 wl = 2._wp*pi/lam
15384# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15385 amp = 0.025_wp/wl
15386# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15387
15388# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15389 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
15390# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15391
15392# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15393 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
15394# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15395
15396# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15397 if (alph < eps) alph = eps
15398# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15399 if (alph > 1._wp - eps) alph = 1._wp - eps
15400# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15401
15402# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15403 if (y_cc(j) > inth) then
15404# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15405 q_prim_vf(advxb)%sf(i, j, k) = alph
15406# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15407 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
15408# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15409 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
15410# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15411 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
15412# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15413 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
15414# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15415 else
15416# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15417 q_prim_vf(advxb)%sf(i, j, k) = alph
15418# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15419 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
15420# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15421 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
15422# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15423 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
15424# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15425 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
15426# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15427 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
15428# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15429 end if
15430# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15431
15432# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15433 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
15434# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15435 h = 0.0_wp
15436# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15437 lam = 1.0_wp
15438# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15439 amp = patch_icpp(patch_id)%a(2)
15440# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15441 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
15442# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15443 if (x_cc(i) > inth) then
15444# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15445 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
15446# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15447 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
15448# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15449 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
15450# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15451 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
15452# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15453 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
15454# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15455 end if
15456# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15457
15458# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15459 case (302) ! 3D Jet with IGR
15460# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15461 ux_th = 10*sqrt(1.4*0.4)
15462# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15463 ux_am = 0.0*sqrt(1.4)
15464# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15465 p_th = 2.0_wp
15466# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15467 p_am = 1.0_wp
15468# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15469 rho_th = 1._wp
15470# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15471 rho_am = 1._wp
15472# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15473 y_th = 0.0_wp
15474# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15475 z_th = 0.0_wp
15476# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15477 r_th = 1._wp
15478# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15479 eps_smooth = 1._wp
15480# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15481 eps = 1e-6
15482# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15483
15484# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15485 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
15486# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15487 rcut = f_cut_on(r - r_th, eps_smooth)
15488# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15489 xcut = f_cut_on(x_cc(i), eps_smooth)
15490# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15491
15492# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15493 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15494# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15495 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
15496# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15497 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
15498# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15499
15500# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15501 if (num_fluids == 1) then
15502# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15503 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15504# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15505 else
15506# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15507 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15508# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15509 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
15510# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15511 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
15512# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15513 end if
15514# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15515
15516# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15517 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
15518# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15519
15520# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15521 case (303) ! 3D Multijet
15522# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15523
15524# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15525 eps_smooth = 3.0_wp
15526# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15527 ux_th = 10*sqrt(1.4*0.4)
15528# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15529 ux_am = 2.5*sqrt(1.4*0.4)
15530# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15531 p_th = 0.8_wp
15532# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15533 p_am = 0.4_wp
15534# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15535 rho_th = 1._wp
15536# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15537 rho_am = 1._wp
15538# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15539 eps = 1e-6
15540# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15541
15542# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15543 rcut = rcut_arr(j, k)
15544# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15545 xcut = f_cut_on(x_cc(i), eps_smooth)
15546# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15547
15548# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15549 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15550# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15551 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
15552# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15553 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
15554# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15555
15556# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15557 if (num_fluids == 1) then
15558# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15559 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15560# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15561 else
15562# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15563 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15564# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15565 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
15566# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15567 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
15568# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15569 end if
15570# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15571
15572# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15573 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
15574# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15575
15576# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15577 case (370)
15578# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15579 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
15580# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15581
15582# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15583 if (.not. files_loaded) then
15584# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15585 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
15586# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15587 do f = 1, max_files
15588# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15589 write (file_num_str, '(I0)') f
15590# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15591 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
15592# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15593 end do
15594# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15595
15596# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15597 ! Common file reading setup
15598# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15599 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15600# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15601 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
15602# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15603
15604# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15605 select case (num_dims)
15606# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15607 case (1, 2) ! 1D and 2D cases are similar
15608# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15609 ! Count lines
15610# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15611 line_count = 0
15612# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15613 do
15614# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15615 read (unit2, *, iostat=ios2) dummy_x, dummy_y
15616# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15617 if (ios2 /= 0) exit
15618# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15619 line_count = line_count + 1
15620# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15621 end do
15622# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15623 close (unit2)
15624# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15625
15626# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15627 xrows = line_count
15628# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15629 yrows = 1
15630# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15631 index_x = 0
15632# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15633 if (num_dims == 2) index_x = i
15634# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15635#ifdef MFC_DEBUG
15636# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15637 block
15638# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15639 use iso_fortran_env, only: output_unit
15640# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15641
15642# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15643 print *, 'm_icpp_patches.fpp:1572: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
15644# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15645
15646# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15647 call flush (output_unit)
15648# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15649 end block
15650# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15651#endif
15652# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15653 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
15654# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15655
15656# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15657
15658# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15659
15660# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15661#if defined(MFC_OpenACC)
15662# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15663!$acc enter data create(x_coords, stored_values)
15664# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15665#elif defined(MFC_OpenMP)
15666# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15667!$omp target enter data map(always,alloc:x_coords, stored_values)
15668# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15669#endif
15670# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15671
15672# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15673 ! Read data from all files
15674# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15675 do f = 1, max_files
15676# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15677 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15678# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15679 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
15680# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15681
15682# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15683 do iter = 1, xrows
15684# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15685 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
15686# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15687 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
15688# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15689 end do
15690# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15691 close (unit)
15692# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15693 end do
15694# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15695
15696# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15697 ! Calculate offsets
15698# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15699 domain_xstart = x_coords(1)
15700# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15701 x_step = x_cc(1) - x_cc(0)
15702# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15703 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
15704# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15705 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
15706# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15707 global_offset_x = nint(abs(delta_x)/x_step)
15708# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15709
15710# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15711 case (3) ! 3D case - determine grid structure
15712# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15713 ! Find yRows by counting rows with same x
15714# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15715 read (unit2, *, iostat=ios2) x0, y0, dummy_z
15716# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15717 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
15718# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15719
15720# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15721 yrows = 1
15722# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15723 do
15724# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15725 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15726# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15727 if (ios2 /= 0) exit
15728# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15729 if (dummy_x == x0 .and. dummy_y /= y0) then
15730# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15731 yrows = yrows + 1
15732# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15733 else
15734# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15735 exit
15736# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15737 end if
15738# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15739 end do
15740# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15741 close (unit2)
15742# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15743
15744# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15745 ! Count total rows
15746# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15747 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15748# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15749 nrows = 0
15750# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15751 do
15752# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15753 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15754# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15755 if (ios2 /= 0) exit
15756# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15757 nrows = nrows + 1
15758# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15759 end do
15760# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15761 close (unit2)
15762# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15763
15764# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15765 xrows = nrows/yrows
15766# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15767#ifdef MFC_DEBUG
15768# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15769 block
15770# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15771 use iso_fortran_env, only: output_unit
15772# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15773
15774# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15775 print *, 'm_icpp_patches.fpp:1572: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
15776# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15777
15778# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15779 call flush (output_unit)
15780# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15781 end block
15782# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15783#endif
15784# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15785 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
15786# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15787
15788# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15789
15790# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15791
15792# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15793
15794# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15795#if defined(MFC_OpenACC)
15796# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15797!$acc enter data create(x_coords, y_coords, stored_values)
15798# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15799#elif defined(MFC_OpenMP)
15800# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15801!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
15802# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15803#endif
15804# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15805 index_x = i
15806# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15807 index_y = j
15808# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15809
15810# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15811 ! Read all files
15812# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15813 do f = 1, max_files
15814# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15815 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15816# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15817 if (ios /= 0) then
15818# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15819 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
15820# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15821 cycle
15822# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15823 end if
15824# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15825
15826# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15827 iter = 0
15828# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15829 do iix = 1, xrows
15830# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15831 do iiy = 1, yrows
15832# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15833 iter = iter + 1
15834# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15835 if (f == 1) then
15836# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15837 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
15838# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15839 else
15840# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15841 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
15842# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15843 end if
15844# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15845 if (ios /= 0) call s_mpi_abort("Error reading data")
15846# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15847 end do
15848# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15849 end do
15850# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15851 close (unit)
15852# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15853 end do
15854# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15855
15856# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15857 ! Calculate offsets
15858# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15859 x_step = x_cc(1) - x_cc(0)
15860# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15861 y_step = y_cc(1) - y_cc(0)
15862# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15863 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
15864# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15865 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
15866# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15867 global_offset_x = nint(abs(delta_x)/x_step)
15868# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15869 global_offset_y = nint(abs(delta_y)/y_step)
15870# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15871 end select
15872# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15873
15874# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15875 files_loaded = .true.
15876# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15877 end if
15878# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15879
15880# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15881 ! Data assignment
15882# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15883 select case (num_dims)
15884# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15885 case (1)
15886# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15887 idx = i + 1 + global_offset_x
15888# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15889 do f = 1, sys_size
15890# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15891 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15892# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15893 end do
15894# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15895
15896# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15897 case (2)
15898# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15899 idx = i + 1 + global_offset_x - index_x
15900# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15901 do f = 1, sys_size - 1
15902# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15903 jump = merge(1, 0, f >= momxe)
15904# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15905 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15906# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15907 end do
15908# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15909 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
15910# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15911
15912# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15913 case (3)
15914# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15915 idx = i + 1 + global_offset_x - index_x
15916# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15917 idy = j + 1 + global_offset_y - index_y
15918# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15919 do f = 1, sys_size - 1
15920# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15921 jump = merge(1, 0, f >= momxe)
15922# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15923 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15924# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15925 end do
15926# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15927 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
15928# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15929 end select
15930# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15931
15932# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15933 case (380)
15934# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15935 ! This is patch is hard-coded for test suite optimization used in the
15936# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15937 ! 3D_TaylorGreenVortex case:
15938# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15939 ! This analytic patch used geometry 9
15940# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15941 mach = 0.1
15942# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15943 if (patch_id == 1) then
15944# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15945 q_prim_vf(e_idx)%sf(i, j, 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)
15946# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15947 q_prim_vf(momxb + 0)%sf(i, j, k) = mach*376.636429464809*sin(x_cc(i)/1)*cos(y_cc(j)/1)*sin(z_cc(k)/1)
15948# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15949 q_prim_vf(momxb + 1)%sf(i, j, k) = -mach*376.636429464809*cos(x_cc(i)/1)*sin(y_cc(j)/1)*sin(z_cc(k)/1)
15950# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15951 end if
15952# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15953
15954# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15955 case default
15956# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15957 call s_int_to_str(patch_id, istr)
15958# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15959 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
15960# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15961 end select
15962# 1572 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15963
15964 end if
15965
15966 ! Updating the patch identities bookkeeping variable
15967 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
15968 end if
15969
15970 end do
15971 end do
15972 end do
15973 if (allocated(stored_values)) then
15974# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15975#ifdef MFC_DEBUG
15976# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15977 block
15978# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15979 use iso_fortran_env, only: output_unit
15980# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15981
15982# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15983 print *, 'm_icpp_patches.fpp:1582: ', '@:DEALLOCATE(stored_values)'
15984# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15985
15986# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15987 call flush (output_unit)
15988# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15989 end block
15990# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15991#endif
15992# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15993
15994# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15995#if defined(MFC_OpenACC)
15996# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15997!$acc exit data delete(stored_values)
15998# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15999#elif defined(MFC_OpenMP)
16000# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16001!$omp target exit data map(release:stored_values)
16002# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16003#endif
16004# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16005 deallocate (stored_values)
16006# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16007#ifdef MFC_DEBUG
16008# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16009 block
16010# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16011 use iso_fortran_env, only: output_unit
16012# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16013
16014# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16015 print *, 'm_icpp_patches.fpp:1582: ', '@:DEALLOCATE(x_coords)'
16016# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16017
16018# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16019 call flush (output_unit)
16020# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16021 end block
16022# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16023#endif
16024# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16025
16026# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16027#if defined(MFC_OpenACC)
16028# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16029!$acc exit data delete(x_coords)
16030# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16031#elif defined(MFC_OpenMP)
16032# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16033!$omp target exit data map(release:x_coords)
16034# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16035#endif
16036# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16037 deallocate (x_coords)
16038# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16039 end if
16040# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16041
16042# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16043 if (allocated(y_coords)) then
16044# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16045#ifdef MFC_DEBUG
16046# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16047 block
16048# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16049 use iso_fortran_env, only: output_unit
16050# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16051
16052# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16053 print *, 'm_icpp_patches.fpp:1582: ', '@:DEALLOCATE(y_coords)'
16054# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16055
16056# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16057 call flush (output_unit)
16058# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16059 end block
16060# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16061#endif
16062# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16063
16064# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16065#if defined(MFC_OpenACC)
16066# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16067!$acc exit data delete(y_coords)
16068# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16069#elif defined(MFC_OpenMP)
16070# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16071!$omp target exit data map(release:y_coords)
16072# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16073#endif
16074# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16075 deallocate (y_coords)
16076# 1582 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16077 end if
16078
16079 end subroutine s_icpp_sweep_plane
16080
16081 !> The STL patch is a 2/3D geometry that is imported from an STL file.
16082 !! @param patch_id is the patch identifier
16083 !! @param patch_id_fp Array to track patch ids
16084 !! @param q_prim_vf Primitive variables
16085 subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
16086
16087 integer, intent(in) :: patch_id
16088#ifdef MFC_MIXED_PRECISION
16089 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
16090#else
16091 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
16092#endif
16093 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
16094
16095 ! Variables for IBM+STL
16096 real(wp) :: normals(1:3) !< Boundary normal buffer
16097 integer :: boundary_vertex_count, boundary_edge_count, total_vertices !< Boundary vertex
16098 real(wp), allocatable, dimension(:, :, :) :: boundary_v !< Boundary vertex buffer
16099 real(wp), allocatable, dimension(:, :) :: interpolated_boundary_v !< Interpolated vertex buffer
16100 real(wp) :: distance !< Levelset distance buffer
16101 logical :: interpolate !< Logical variable to determine whether or not the model should be interpolated
16102
16103 integer :: i, j, k !< Generic loop iterators
16104
16105 type(t_bbox) :: bbox, bbox_old
16106 type(t_model) :: model
16107 type(ic_model_parameters) :: params
16108
16109 real(wp), dimension(1:3) :: point, model_center
16110
16111 real(wp) :: grid_mm(1:3, 1:2)
16112
16113 integer :: cell_num
16114 integer :: ncells
16115
16116 real(wp), dimension(1:4, 1:4) :: transform, transform_n
16117
16118 if (proc_rank == 0) then
16119 print *, " * Reading model: "//trim(patch_icpp(patch_id)%model_filepath)
16120 end if
16121
16122 model = f_model_read(patch_icpp(patch_id)%model_filepath)
16123 params%scale(:) = patch_icpp(patch_id)%model_scale(:)
16124 params%translate(:) = patch_icpp(patch_id)%model_translate(:)
16125 params%rotate(:) = patch_icpp(patch_id)%model_rotate(:)
16126 params%spc = patch_icpp(patch_id)%model_spc
16127 params%threshold = patch_icpp(patch_id)%model_threshold
16128
16129 if (proc_rank == 0) then
16130 print *, " * Transforming model."
16131 end if
16132
16133 ! Get the model center before transforming the model
16134 bbox_old = f_create_bbox(model)
16135 model_center(1:3) = (bbox_old%min(1:3) + bbox_old%max(1:3))/2._wp
16136
16137 ! Compute the transform matrices for vertices and normals
16138 transform = f_create_transform_matrix(params, model_center)
16139 transform_n = f_create_transform_matrix(params)
16140
16141 call s_transform_model(model, transform, transform_n)
16142
16143 ! Recreate the bounding box after transformation
16144 bbox = f_create_bbox(model)
16145
16146 ! Show the number of vertices in the original STL model
16147 if (proc_rank == 0) then
16148 print *, ' * Number of input model vertices:', 3*model%ntrs
16149 end if
16150
16151 call f_check_boundary(model, boundary_v, boundary_vertex_count, boundary_edge_count)
16152
16153 ! Check if the model needs interpolation
16154 if (p > 0) then
16155 call f_check_interpolation_3d(model, (/dx, dy, dz/), interpolate)
16156 else
16157 call f_check_interpolation_2d(boundary_v, boundary_edge_count, (/dx, dy, dz/), interpolate)
16158 end if
16159
16160 ! Show the number of edges and boundary edges in 2D STL models
16161 if (proc_rank == 0 .and. p == 0) then
16162 print *, ' * Number of 2D model boundary edges:', boundary_edge_count
16163 end if
16164
16165 ! Interpolate the STL model along the edges (2D) and on triangle facets (3D)
16166 if (interpolate) then
16167 if (proc_rank == 0) then
16168 print *, ' * Interpolating STL vertices.'
16169 end if
16170
16171 if (p > 0) then
16172 call f_interpolate_3d(model, (/dx, dy, dz/), interpolated_boundary_v, total_vertices)
16173 else
16174 call f_interpolate_2d(boundary_v, boundary_edge_count, (/dx, dy, dz/), interpolated_boundary_v, total_vertices)
16175 end if
16176
16177 if (proc_rank == 0) then
16178 print *, ' * Total number of interpolated boundary vertices:', total_vertices
16179 end if
16180 end if
16181
16182 if (proc_rank == 0) then
16183 write (*, "(A, 3(2X, F20.10))") " > Model: Min:", bbox%min(1:3)
16184 write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2._wp
16185 write (*, "(A, 3(2X, F20.10))") " > Max:", bbox%max(1:3)
16186
16187 !call s_model_write("__out__.stl", model)
16188 !call s_model_write("__out__.obj", model)
16189
16190 grid_mm(1, :) = (/minval(x_cc) - 0.e5_wp*dx, maxval(x_cc) + 0.e5_wp*dx/)
16191 grid_mm(2, :) = (/minval(y_cc) - 0.e5_wp*dy, maxval(y_cc) + 0.e5_wp*dy/)
16192
16193 if (p > 0) then
16194 grid_mm(3, :) = (/minval(z_cc) - 0.e5_wp*dz, maxval(z_cc) + 0.e5_wp*dz/)
16195 else
16196 grid_mm(3, :) = (/0._wp, 0._wp/)
16197 end if
16198
16199 write (*, "(A, 3(2X, F20.10))") " > Domain: Min:", grid_mm(:, 1)
16200 write (*, "(A, 3(2X, F20.10))") " > Cen:", (grid_mm(:, 1) + grid_mm(:, 2))/2._wp
16201 write (*, "(A, 3(2X, F20.10))") " > Max:", grid_mm(:, 2)
16202 end if
16203
16204 ncells = (m + 1)*(n + 1)*(p + 1)
16205 do i = 0, m; do j = 0, n; do k = 0, p
16206
16207 cell_num = i*(n + 1)*(p + 1) + j*(p + 1) + (k + 1)
16208 if (proc_rank == 0 .and. mod(cell_num, ncells/100) == 0) then
16209 write (*, "(A, I3, A)", advance="no") &
16210 char(13)//" * Generating grid: ", &
16211 nint(100*real(cell_num)/ncells), "%"
16212 end if
16213
16214 point = (/x_cc(i), y_cc(j), 0._wp/)
16215 if (p > 0) then
16216 point(3) = z_cc(k)
16217 end if
16218
16219 if (grid_geometry == 3) then
16220 point = f_convert_cyl_to_cart(point)
16221 end if
16222
16223 eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc)
16224
16225 if (eta > patch_icpp(patch_id)%model_threshold) then
16226 eta = 1._wp
16227 else if (.not. patch_icpp(patch_id)%smoothen) then
16228 eta = 0._wp
16229 end if
16230
16231 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
16232 eta, q_prim_vf, patch_id_fp)
16233
16234 ! Note: Should probably use *eta* to compute primitive variables
16235 ! if defining them analytically.
16236
16237 end do; end do; end do
16238
16239 if (proc_rank == 0) then
16240 print *, ""
16241 print *, " * Cleaning up."
16242 end if
16243
16244 call s_model_free(model)
16245
16246 end subroutine s_icpp_model
16247
16248 !> @brief Converts cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
16250
16251# 1755 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16252#if MFC_OpenACC
16253# 1755 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16254!$acc routine seq
16255# 1755 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16256#elif MFC_OpenMP
16257# 1755 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16258
16259# 1755 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16260
16261# 1755 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16262!$omp declare target device_type(any)
16263# 1755 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16264#endif
16265
16266 real(wp), intent(in) :: cyl_y, cyl_z
16267
16268 cart_y = cyl_y*sin(cyl_z)
16269 cart_z = cyl_y*cos(cyl_z)
16270
16272
16273 !> @brief Returns a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
16274 function f_convert_cyl_to_cart(cyl) result(cart)
16275
16276
16277# 1767 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16278#if MFC_OpenACC
16279# 1767 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16280!$acc routine seq
16281# 1767 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16282#elif MFC_OpenMP
16283# 1767 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16284
16285# 1767 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16286
16287# 1767 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16288!$omp declare target device_type(any)
16289# 1767 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16290#endif
16291
16292 real(wp), dimension(1:3), intent(in) :: cyl
16293 real(wp), dimension(1:3) :: cart
16294
16295 cart = (/cyl(1), &
16296 cyl(2)*sin(cyl(3)), &
16297 cyl(2)*cos(cyl(3))/)
16298
16299 end function f_convert_cyl_to_cart
16300
16301 !> @brief Computes the spherical azimuthal angle from cylindrical (x, r) coordinates.
16303
16304# 1780 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16305#if MFC_OpenACC
16306# 1780 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16307!$acc routine seq
16308# 1780 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16309#elif MFC_OpenMP
16310# 1780 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16311
16312# 1780 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16313
16314# 1780 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16315!$omp declare target device_type(any)
16316# 1780 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16317#endif
16318
16319 real(wp), intent(IN) :: cyl_x, cyl_y
16320
16321 sph_phi = atan(cyl_y/cyl_x)
16322
16324
16325 !> Archimedes spiral function
16326 !! @param myth Angle
16327 !! @param offset Thickness
16328 !! @param a Starting position
16329 elemental function f_r(myth, offset, a)
16330
16331
16332# 1794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16333#if MFC_OpenACC
16334# 1794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16335!$acc routine seq
16336# 1794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16337#elif MFC_OpenMP
16338# 1794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16339
16340# 1794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16341
16342# 1794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16343!$omp declare target device_type(any)
16344# 1794 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16345#endif
16346 real(wp), intent(in) :: myth, offset, a
16347 real(wp) :: b
16348 real(wp) :: f_r
16349
16350 !r(th) = a + b*th
16351
16352 b = 2._wp*a/(2._wp*pi)
16353 f_r = a + b*myth + offset
16354 end function f_r
16355
16356end 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
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.
integer sys_size
Number of unknowns in the system of equations.
integer num_patches
Number of patches composing initial condition.
type(int_bounds_info) b_idx
Indexes of first and last magnetic field eqns.
integer num_dims
Number of spatial dimensions.
real(wp), dimension(:), allocatable x_cc
type(ic_patch_parameters), dimension(num_patches_max) patch_icpp
Database of the initial condition patch parameters (icpp) for each of the patches employed in the con...
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
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)
Returns 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_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y)
Computes the spherical azimuthal angle from cylindrical (x, r) coordinates.
character(len=5) istr
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,...
real(wp) sph_phi
Variables to be used to hold cell locations in Cartesian coordinates if 3D simulation is using cylind...
impure subroutine, public s_apply_icpp_patches(patch_id_fp, q_prim_vf)
Dispatches each initial condition patch to its geometry-specific initialization routine.
real(wp) smooth_coeff
These variables are analogous in both meaning and use to the similarly named components in the ic_pat...
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
In the case that smoothing of patch boundaries is enabled and the boundary between two adjacent patch...
subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
Initializes a 1D bubble-pulse patch with analytical primitive variable profiles.
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)
Converts 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
These variables combine the centroid and length parameters associated with a particular patch to yiel...
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_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
This patch generates the shape of the spherical harmonics as a perturbation to a perfect sphere.
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)
Initializes a 3D variable-thickness circular annulus patch extruded along the z-axis.
Binary STL file reader and processor for immersed boundary geometry.
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.
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
real(wp), dimension(:), allocatable, public gammas
real(wp), dimension(:), allocatable, public gs_min
real(wp), dimension(:), allocatable, public pi_infs
Derived type adding beginning (beg) and end bounds info as attributes.
Derived type annexing a scalar field (SF).