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# 104 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304# 119 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
305
306# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
307
308# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310# 171 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
311
312# 182 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
313
314# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316# 204 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
317
318# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
319
320# 225 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322# 236 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323
324# 246 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
325
326# 252 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
327
328# 258 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
329
330# 264 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
331
332# 270 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
333
334# 272 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
335# 273 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
336! New line at end of file is required for FYPP
337# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
338
339# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
340
341! Caution:
342! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
343! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
344! For an example see misc/nvidia_uvm/bind.sh.
345# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
346
347# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
352
353# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
354
355# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
356
357# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
358
359# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
360! New line at end of file is required for FYPP
361# 11 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp" 2
362
363!> @brief Constructs initial condition patch geometries (lines, circles, rectangles, spheres, etc.) on the grid
364module m_icpp_patches
365
366 use m_model ! Subroutine(s) related to STL files
367
368 use m_derived_types ! Definitions of the derived types
369
370 use m_global_parameters !< definitions of the global parameters
371
372 use m_constants, only: max_2d_fourier_modes, max_sph_harm_degree, small_radius
373
374 use m_helper_basic !< functions to compare floating point numbers
375
376 use m_helper
377
378 use m_mpi_common
379
380 use m_assign_variables
381
382 use m_mpi_common
383
384 use m_variables_conversion
385
386 implicit none
387
388 private; public :: s_apply_icpp_patches
389
390 real(wp) :: x_centroid, y_centroid, z_centroid
391 real(wp) :: length_x, length_y, length_z
392
393 integer :: smooth_patch_id
394 real(wp) :: smooth_coeff !<
395 !! These variables are analogous in both meaning and use to the similarly
396 !! named components in the ic_patch_parameters type (see m_derived_types.f90
397 !! for additional details). They are employed as a means to more concisely
398 !! perform the actions necessary to lay out a particular patch on the grid.
399
400 real(wp) :: eta !<
401 !! In the case that smoothing of patch boundaries is enabled and the boundary
402 !! between two adjacent patches is to be smeared out, this variable's purpose
403 !! is to act as a pseudo volume fraction to indicate the contribution of each
404 !! patch toward the composition of a cell's fluid state.
405
406 real(wp) :: cart_x, cart_y, cart_z
407 real(wp) :: sph_phi !<
408 !! Variables to be used to hold cell locations in Cartesian coordinates if
409 !! 3D simulation is using cylindrical coordinates
410
411 type(bounds_info) :: x_boundary, y_boundary, z_boundary !<
412 !! These variables combine the centroid and length parameters associated with
413 !! a particular patch to yield the locations of the patch boundaries in the
414 !! x-, y- and z-coordinate directions. They are used as a means to concisely
415 !! perform the actions necessary to lay out a particular patch on the grid.
416
417 character(len=5) :: istr ! string to store int to string result for error checking
418
419contains
420
421 !> @brief Dispatches each initial condition patch to its geometry-specific initialization routine.
422 impure subroutine s_apply_icpp_patches(patch_id_fp, q_prim_vf)
423
424 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
425#ifdef MFC_MIXED_PRECISION
426 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
427#else
428 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
429#endif
430 integer :: i
431
432 ! 3D Patch Geometries
433 if (p > 0) then
434
435 do i = 1, num_patches
436
437 if (proc_rank == 0) then
438 print *, 'Processing patch', i
439 end if
440
441 !> ICPP Patches
442 !> @{
443 ! Spherical patch
444 if (patch_icpp(i)%geometry == 8) then
445 call s_icpp_sphere(i, patch_id_fp, q_prim_vf)
446 ! Cuboidal patch
447 elseif (patch_icpp(i)%geometry == 9) then
448 call s_icpp_cuboid(i, patch_id_fp, q_prim_vf)
449 ! Cylindrical patch
450 elseif (patch_icpp(i)%geometry == 10) then
451 call s_icpp_cylinder(i, patch_id_fp, q_prim_vf)
452 ! Swept plane patch
453 elseif (patch_icpp(i)%geometry == 11) then
454 call s_icpp_sweep_plane(i, patch_id_fp, q_prim_vf)
455 ! Ellipsoidal patch
456 elseif (patch_icpp(i)%geometry == 12) then
457 call s_icpp_ellipsoid(i, patch_id_fp, q_prim_vf)
458 ! 3D spherical harmonic patch
459 elseif (patch_icpp(i)%geometry == 14) then
460 call s_icpp_3d_spherical_harmonic(i, patch_id_fp, q_prim_vf)
461 ! 3D Modified circular patch
462 elseif (patch_icpp(i)%geometry == 19) then
463 call s_icpp_3dvarcircle(i, patch_id_fp, q_prim_vf)
464 ! 3D STL patch
465 elseif (patch_icpp(i)%geometry == 21) then
466 call s_icpp_model(i, patch_id_fp, q_prim_vf)
467 end if
468 end do
469 !> @}
470
471 ! 2D Patch Geometries
472 elseif (n > 0) then
473
474 do i = 1, num_patches
475
476 if (proc_rank == 0) then
477 print *, 'Processing patch', i
478 end if
479
480 !> ICPP Patches
481 !> @{
482 ! Circular patch
483 if (patch_icpp(i)%geometry == 2) then
484 call s_icpp_circle(i, patch_id_fp, q_prim_vf)
485 ! Rectangular patch
486 elseif (patch_icpp(i)%geometry == 3) then
487 call s_icpp_rectangle(i, patch_id_fp, q_prim_vf)
488 ! Swept line patch
489 elseif (patch_icpp(i)%geometry == 4) then
490 call s_icpp_sweep_line(i, patch_id_fp, q_prim_vf)
491 ! Elliptical patch
492 elseif (patch_icpp(i)%geometry == 5) then
493 call s_icpp_ellipse(i, patch_id_fp, q_prim_vf)
494 ! Unimplemented patch (formerly isentropic vortex)
495 elseif (patch_icpp(i)%geometry == 6) then
496 call s_mpi_abort('This used to be the isentropic vortex patch, '// &
497 'which no longer exists. See Examples. Exiting.')
498 ! 2D modal (Fourier) patch
499 elseif (patch_icpp(i)%geometry == 13) then
500 call s_icpp_2d_modal(i, patch_id_fp, q_prim_vf)
501 ! Spiral patch
502 elseif (patch_icpp(i)%geometry == 17) then
503 call s_icpp_spiral(i, patch_id_fp, q_prim_vf)
504 ! Modified circular patch
505 elseif (patch_icpp(i)%geometry == 18) then
506 call s_icpp_varcircle(i, patch_id_fp, q_prim_vf)
507 ! TaylorGreen vortex patch
508 elseif (patch_icpp(i)%geometry == 20) then
509 call s_icpp_2d_taylorgreen_vortex(i, patch_id_fp, q_prim_vf)
510 ! STL patch
511 elseif (patch_icpp(i)%geometry == 21) then
512 call s_icpp_model(i, patch_id_fp, q_prim_vf)
513 end if
514 !> @}
515 end do
516
517 ! 1D Patch Geometries
518 else
519
520 do i = 1, num_patches
521
522 if (proc_rank == 0) then
523 print *, 'Processing patch', i
524 end if
525
526 ! Line segment patch
527 if (patch_icpp(i)%geometry == 1) then
528 call s_icpp_line_segment(i, patch_id_fp, q_prim_vf)
529 ! 1d analytical
530 elseif (patch_icpp(i)%geometry == 16) then
531 call s_icpp_1d_bubble_pulse(i, patch_id_fp, q_prim_vf)
532 end if
533 end do
534
535 end if
536
537 end subroutine s_apply_icpp_patches
538
539 !> The line segment patch is a 1D geometry that may be used,
540 !! for example, in creating a Riemann problem. The geometry
541 !! of the patch is well-defined when its centroid and length
542 !! in the x-coordinate direction are provided. Note that the
543 !! line segment patch DOES NOT allow for the smearing of its
544 !! boundaries.
545 !! @param patch_id patch identifier
546 !! @param patch_id_fp Array to track patch ids
547 !! @param q_prim_vf Array of primitive variables
548 subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
549
550 integer, intent(in) :: patch_id
551#ifdef MFC_MIXED_PRECISION
552 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
553#else
554 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
555#endif
556 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
557
558 ! Generic loop iterators
559 integer :: i, j, k
560
561 ! Placeholders for the cell boundary values
562 real(wp) :: pi_inf, gamma, lit_gamma
563 integer :: xRows, yRows, nRows, iix, iiy, max_files
564# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
565 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
566# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
567 real(wp) :: x_len, x_step, y_len, y_step
568# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
569 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
570# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
571 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
572# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
573 real(wp) :: delta_x, delta_y
574# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
575 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
576# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
577 character(len=200) :: errmsg
578# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
579 real(wp), allocatable :: stored_values(:, :, :)
580# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
581 real(wp), allocatable :: x_coords(:), y_coords(:)
582# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
583 logical :: files_loaded = .false.
584# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
585 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
586# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
587 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
588# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
589 character(len=20) :: file_num_str ! For storing the file number as a string
590# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
591 character(len=20) :: zeros_part ! For the trailing zeros part
592# 212 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
593 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
594 ! Place any declaration of intermediate variables here
595# 213 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
596 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
597
598 pi_inf = pi_infs(1)
599 gamma = gammas(1)
600 lit_gamma = gs_min(1)
601 j = 0
602 k = 0
603
604 ! Transferring the line segment's centroid and length information
605 x_centroid = patch_icpp(patch_id)%x_centroid
606 length_x = patch_icpp(patch_id)%length_x
607
608 ! Computing the beginning and end x-coordinates of the line segment
609 ! based on its centroid and length
610 x_boundary%beg = x_centroid - 0.5_wp*length_x
611 x_boundary%end = x_centroid + 0.5_wp*length_x
612
613 ! Since the line segment patch does not allow for its boundaries to
614 ! be smoothed out, the pseudo volume fraction is set to 1 to ensure
615 ! that only the current patch contributes to the fluid state in the
616 ! cells that this patch covers.
617 eta = 1._wp
618
619 ! Checking whether the line segment covers a particular cell in the
620 ! domain and verifying whether the current patch has the permission
621 ! to write to that cell. If both queries check out, the primitive
622 ! variables of the current patch are assigned to this cell.
623 do i = 0, m
624 if (x_boundary%beg <= x_cc(i) .and. &
625 x_boundary%end >= x_cc(i) .and. &
626 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, 0, 0))) then
627
628 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, &
629 eta, q_prim_vf, patch_id_fp)
630
631
632
633 ! check if this should load a hardcoded patch
634 if (patch_icpp(patch_id)%hcid /= dflt_int) then
635 select case (patch_icpp(patch_id)%hcid)
636# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
637 case (150) ! 1D Smooth Alfven Case for MHD
638# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
639 ! velocity
640# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
641 q_prim_vf(momxb + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
642# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
643 q_prim_vf(momxb + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
644# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
645
646# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
647 ! magnetic field
648# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
649 q_prim_vf(b_idx%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
650# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
651 q_prim_vf(b_idx%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
652# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
653
654# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
655 case (170)
656# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
657 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera, SDtoolbox)
658# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
659
660# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
661 if (.not. files_loaded) then
662# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
663 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
664# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
665 do f = 1, max_files
666# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
667 write (file_num_str, '(I0)') f
668# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
669 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
670# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
671 end do
672# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
673
674# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
675 ! Common file reading setup
676# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
677 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
678# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
679 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
680# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
681
682# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
683 select case (num_dims)
684# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
685 case (1, 2) ! 1D and 2D cases are similar
686# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
687 ! Count lines
688# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
689 line_count = 0
690# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
691 do
692# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
693 read (unit2, *, iostat=ios2) dummy_x, dummy_y
694# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
695 if (ios2 /= 0) exit
696# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
697 line_count = line_count + 1
698# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
699 end do
700# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
701 close (unit2)
702# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
703
704# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
705 xrows = line_count
706# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
707 yrows = 1
708# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
709 index_x = 0
710# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
711 if (num_dims == 2) index_x = i
712# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
713#ifdef MFC_DEBUG
714# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
715 block
716# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
717 use iso_fortran_env, only: output_unit
718# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
719
720# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
721 print *, 'm_icpp_patches.fpp:252: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
722# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
723
724# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
725 call flush (output_unit)
726# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
727 end block
728# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
729#endif
730# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
731 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
732# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
733
734# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
735
736# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
737
738# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
739#if defined(MFC_OpenACC)
740# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
741!$acc enter data create(x_coords, stored_values)
742# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
743#elif defined(MFC_OpenMP)
744# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
745!$omp target enter data map(always,alloc:x_coords, stored_values)
746# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
747#endif
748# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
749
750# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
751 ! Read data from all files
752# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
753 do f = 1, max_files
754# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
755 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
756# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
757 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
758# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
759
760# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
761 do iter = 1, xrows
762# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
763 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
764# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
765 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
766# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
767 end do
768# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
769 close (unit)
770# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
771 end do
772# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
773
774# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
775 ! Calculate offsets
776# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
777 domain_xstart = x_coords(1)
778# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
779 x_step = x_cc(1) - x_cc(0)
780# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
781 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
782# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
783 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
784# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
785 global_offset_x = nint(abs(delta_x)/x_step)
786# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
787
788# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
789 case (3) ! 3D case - determine grid structure
790# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
791 ! Find yRows by counting rows with same x
792# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
793 read (unit2, *, iostat=ios2) x0, y0, dummy_z
794# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
795 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
796# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
797
798# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
799 yrows = 1
800# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
801 do
802# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
803 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
804# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
805 if (ios2 /= 0) exit
806# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
807 if (dummy_x == x0 .and. dummy_y /= y0) then
808# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
809 yrows = yrows + 1
810# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
811 else
812# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
813 exit
814# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
815 end if
816# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
817 end do
818# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
819 close (unit2)
820# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
821
822# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
823 ! Count total rows
824# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
825 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
826# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
827 nrows = 0
828# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
829 do
830# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
831 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
832# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
833 if (ios2 /= 0) exit
834# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
835 nrows = nrows + 1
836# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
837 end do
838# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
839 close (unit2)
840# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
841
842# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
843 xrows = nrows/yrows
844# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
845#ifdef MFC_DEBUG
846# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
847 block
848# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
849 use iso_fortran_env, only: output_unit
850# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
851
852# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
853 print *, 'm_icpp_patches.fpp:252: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
854# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
855
856# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
857 call flush (output_unit)
858# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
859 end block
860# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
861#endif
862# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
863 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
864# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
865
866# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
867
868# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
869
870# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
871
872# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
873#if defined(MFC_OpenACC)
874# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
875!$acc enter data create(x_coords, y_coords, stored_values)
876# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
877#elif defined(MFC_OpenMP)
878# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
879!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
880# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
881#endif
882# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
883 index_x = i
884# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
885 index_y = j
886# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
887
888# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
889 ! Read all files
890# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
891 do f = 1, max_files
892# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
893 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
894# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
895 if (ios /= 0) then
896# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
897 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
898# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
899 cycle
900# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
901 end if
902# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
903
904# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
905 iter = 0
906# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
907 do iix = 1, xrows
908# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
909 do iiy = 1, yrows
910# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
911 iter = iter + 1
912# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
913 if (f == 1) then
914# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
915 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
916# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
917 else
918# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
919 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
920# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
921 end if
922# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
923 if (ios /= 0) call s_mpi_abort("Error reading data")
924# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
925 end do
926# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
927 end do
928# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
929 close (unit)
930# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
931 end do
932# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
933
934# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
935 ! Calculate offsets
936# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
937 x_step = x_cc(1) - x_cc(0)
938# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
939 y_step = y_cc(1) - y_cc(0)
940# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
941 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
942# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
943 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
944# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
945 global_offset_x = nint(abs(delta_x)/x_step)
946# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
947 global_offset_y = nint(abs(delta_y)/y_step)
948# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
949 end select
950# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
951
952# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
953 files_loaded = .true.
954# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
955 end if
956# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
957
958# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
959 ! Data assignment
960# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
961 select case (num_dims)
962# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
963 case (1)
964# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
965 idx = i + 1 + global_offset_x
966# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
967 do f = 1, sys_size
968# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
969 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
970# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
971 end do
972# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
973
974# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
975 case (2)
976# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
977 idx = i + 1 + global_offset_x - index_x
978# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
979 do f = 1, sys_size - 1
980# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
981 jump = merge(1, 0, f >= momxe)
982# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
983 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
984# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
985 end do
986# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
987 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
988# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
989
990# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
991 case (3)
992# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
993 idx = i + 1 + global_offset_x - index_x
994# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
995 idy = j + 1 + global_offset_y - index_y
996# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
997 do f = 1, sys_size - 1
998# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
999 jump = merge(1, 0, f >= momxe)
1000# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1001 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
1002# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1003 end do
1004# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1005 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
1006# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1007 end select
1008# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1009
1010# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1011 case (180)
1012# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1013 ! This is patch is hard-coded for test suite optimization used in the
1014# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1015 ! 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 + 0.2*sin(5*x)"
1016# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1017 if (patch_id == 2) then
1018# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1019 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
1020# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1021 end if
1022# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1023
1024# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1025 case (181)
1026# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1027 ! This is patch is hard-coded for test suite optimization used in the
1028# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1029 ! 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)": "1 + 0.1*sin(20*x*pi)"
1030# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1031 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
1032# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1033
1034# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1035 case (182)
1036# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1037 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
1038# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1039 x_mid_diffu = 0.05_wp/2.0_wp
1040# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1041 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
1042# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1043 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
1044# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1045 q_prim_vf(momxb)%sf(i, 0, 0) = 0.0_wp
1046# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1047 q_prim_vf(e_idx)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
1048# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1049 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp
1050# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1051
1052# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1053 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
1054# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1055 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
1056# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1057 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
1058# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1059 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
1060# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1061
1062# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1063 q_prim_vf(chemxb)%sf(i, 0, 0) = y1
1064# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1065 q_prim_vf(chemxb + 1)%sf(i, 0, 0) = y2
1066# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1067 q_prim_vf(chemxb + 2)%sf(i, 0, 0) = y3
1068# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1069 q_prim_vf(chemxb + 3)%sf(i, 0, 0) = y4
1070# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1071
1072# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1073 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
1074# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1075
1076# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1077 molar_mass_inv = y1/31.998_wp + &
1078# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1079 y2/18.01508_wp + &
1080# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1081 y3/16.04256_wp + &
1082# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1083 y4/28.0134_wp
1084# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1085
1086# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1087 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)
1088# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1089
1090# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1091 case default
1092# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1093 call s_int_to_str(patch_id, istr)
1094# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1095 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
1096# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1097 end select
1098# 252 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1099
1100 end if
1101
1102 ! Updating the patch identities bookkeeping variable
1103 if (1._wp - eta < sgm_eps) patch_id_fp(i, 0, 0) = patch_id
1104
1105 end if
1106 end do
1107 if (allocated(stored_values)) then
1108# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1109#ifdef MFC_DEBUG
1110# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1111 block
1112# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1113 use iso_fortran_env, only: output_unit
1114# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1115
1116# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1117 print *, 'm_icpp_patches.fpp:260: ', '@:DEALLOCATE(stored_values)'
1118# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1119
1120# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1121 call flush (output_unit)
1122# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1123 end block
1124# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1125#endif
1126# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1127
1128# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1129#if defined(MFC_OpenACC)
1130# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1131!$acc exit data delete(stored_values)
1132# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1133#elif defined(MFC_OpenMP)
1134# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1135!$omp target exit data map(release:stored_values)
1136# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1137#endif
1138# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1139 deallocate (stored_values)
1140# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1141#ifdef MFC_DEBUG
1142# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1143 block
1144# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1145 use iso_fortran_env, only: output_unit
1146# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1147
1148# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1149 print *, 'm_icpp_patches.fpp:260: ', '@:DEALLOCATE(x_coords)'
1150# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1151
1152# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1153 call flush (output_unit)
1154# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1155 end block
1156# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1157#endif
1158# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1159
1160# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1161#if defined(MFC_OpenACC)
1162# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1163!$acc exit data delete(x_coords)
1164# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1165#elif defined(MFC_OpenMP)
1166# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1167!$omp target exit data map(release:x_coords)
1168# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1169#endif
1170# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1171 deallocate (x_coords)
1172# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1173 end if
1174# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1175
1176# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1177 if (allocated(y_coords)) then
1178# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1179#ifdef MFC_DEBUG
1180# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1181 block
1182# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1183 use iso_fortran_env, only: output_unit
1184# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1185
1186# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1187 print *, 'm_icpp_patches.fpp:260: ', '@:DEALLOCATE(y_coords)'
1188# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1189
1190# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1191 call flush (output_unit)
1192# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1193 end block
1194# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1195#endif
1196# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1197
1198# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1199#if defined(MFC_OpenACC)
1200# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1201!$acc exit data delete(y_coords)
1202# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1203#elif defined(MFC_OpenMP)
1204# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1205!$omp target exit data map(release:y_coords)
1206# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1207#endif
1208# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1209 deallocate (y_coords)
1210# 260 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1211 end if
1212
1213 end subroutine s_icpp_line_segment
1214
1215 !> The spiral patch is a 2D geometry that may be used, The geometry
1216 !! of the patch is well-defined when its centroid and radius
1217 !! are provided. Note that the circular patch DOES allow for
1218 !! the smoothing of its boundary.
1219 !! @param patch_id patch identifier
1220 !! @param patch_id_fp Array to track patch ids
1221 !! @param q_prim_vf Array of primitive variables
1222 impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
1223
1224 integer, intent(in) :: patch_id
1225#ifdef MFC_MIXED_PRECISION
1226 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
1227#else
1228 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
1229#endif
1230 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
1231
1232 integer :: i, j, k !< Generic loop iterators
1233 real(wp) :: th, thickness, nturns, mya
1234 real(wp) :: spiral_x_min, spiral_x_max, spiral_y_min, spiral_y_max
1235 integer :: xrows, yrows, nrows, iix, iiy, max_files
1236# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1237 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
1238# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1239 real(wp) :: x_len, x_step, y_len, y_step
1240# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1241 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
1242# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1243 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
1244# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1245 real(wp) :: delta_x, delta_y
1246# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1247 character(len=100), dimension(sys_size) :: filenames ! Arrays to store all data from files
1248# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1249 character(len=200) :: errmsg
1250# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1251 real(wp), allocatable :: stored_values(:, :, :)
1252# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1253 real(wp), allocatable :: x_coords(:), y_coords(:)
1254# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1255 logical :: files_loaded = .false.
1256# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1257 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
1258# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1259 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
1260# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1261 character(len=20) :: file_num_str ! For storing the file number as a string
1262# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1263 character(len=20) :: zeros_part ! For the trailing zeros part
1264# 284 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1265 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
1266 ! Place any declaration of intermediate variables here
1267# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1268 real(wp) :: eps, eps_mhd, c_mhd
1269# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1270 real(wp) :: r, rmax, gam, umax, p0
1271# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1272 real(wp) :: rhoh, rhol, pref, pint, h, lam, wl, amp, inth, intl, alph
1273# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1274 real(wp) :: factor
1275# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1276 real(wp) :: r0, alpha, r2
1277# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1278 real(wp) :: sina, cosa
1279# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1280
1281# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1282 real(wp) :: r_sq
1283# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1284
1285# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1286 ! # 207
1287# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1288 real(wp) :: sigma, gauss1, gauss2
1289# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1290 ! # 208
1291# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1292 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
1293# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1294
1295# 285 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1296 eps = 1.e-9_wp
1297
1298 ! Transferring the circular patch's radius, centroid, smearing patch
1299 ! identity and smearing coefficient information
1300 x_centroid = patch_icpp(patch_id)%x_centroid
1301 y_centroid = patch_icpp(patch_id)%y_centroid
1302 mya = patch_icpp(patch_id)%radius
1303 thickness = patch_icpp(patch_id)%length_x
1304 nturns = patch_icpp(patch_id)%length_y
1305
1306 !
1307 logic_grid = 0
1308 do k = 0, int(m*91*nturns)
1309 th = k/real(int(m*91._wp*nturns))*nturns*2._wp*pi
1310
1311 spiral_x_min = minval((/f_r(th, 0.0_wp, mya)*cos(th), &
1312 f_r(th, thickness, mya)*cos(th)/))
1313 spiral_y_min = minval((/f_r(th, 0.0_wp, mya)*sin(th), &
1314 f_r(th, thickness, mya)*sin(th)/))
1315
1316 spiral_x_max = maxval((/f_r(th, 0.0_wp, mya)*cos(th), &
1317 f_r(th, thickness, mya)*cos(th)/))
1318 spiral_y_max = maxval((/f_r(th, 0.0_wp, mya)*sin(th), &
1319 f_r(th, thickness, mya)*sin(th)/))
1320
1321 do j = 0, n; do i = 0, m;
1322 if ((x_cc(i) > spiral_x_min) .and. (x_cc(i) < spiral_x_max) .and. &
1323 (y_cc(j) > spiral_y_min) .and. (y_cc(j) < spiral_y_max)) then
1324 logic_grid(i, j, 0) = 1
1325 end if
1326 end do; end do
1327 end do
1328
1329 do j = 0, n
1330 do i = 0, m
1331 if ((logic_grid(i, j, 0) == 1)) then
1332 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
1333 eta, q_prim_vf, patch_id_fp)
1334
1335
1336 if (patch_icpp(patch_id)%hcid /= dflt_int) then
1337
1338# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1339 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
1340# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1341
1342# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1343 case (200)
1344# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1345 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
1346# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1347 ! Volume Fractions
1348# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1349 q_prim_vf(advxb)%sf(i, j, 0) = eps
1350# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1351 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
1352# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1353 ! Denssities
1354# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1355 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
1356# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1357 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
1358# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1359 ! Pressure
1360# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1361 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
1362# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1363 end if
1364# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1365 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
1366# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1367 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1368# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1369 rmax = 0.2_wp
1370# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1371
1372# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1373 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1374# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1375 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1376# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1377 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1378# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1379
1380# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1381 if (r < rmax) then
1382# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1383 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1384# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1385 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1386# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1387 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1388# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1389 else if (r < 2*rmax) then
1390# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1391 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1392# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1393 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1394# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1395 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
1396# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1397 else
1398# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1399 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
1400# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1401 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
1402# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1403 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
1404# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1405 end if
1406# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1407 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
1408# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1409 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
1410# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1411 rmax = 0.2_wp
1412# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1413
1414# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1415 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
1416# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1417 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
1418# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1419 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
1420# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1421
1422# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1423 if (r < rmax) then
1424# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1425 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
1426# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1427 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
1428# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1429 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
1430# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1431 else if (r < 2*rmax) then
1432# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1433 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1434# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1435 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
1436# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1437 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)))
1438# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1439 else
1440# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1441 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
1442# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1443 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
1444# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1445 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
1446# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1447 end if
1448# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1449
1450# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1451 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
1452# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1453 case (204) ! Rayleigh-Taylor instability
1454# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1455 rhoh = 3._wp
1456# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1457 rhol = 1._wp
1458# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1459 pref = 1.e5_wp
1460# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1461 pint = pref
1462# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1463 h = 0.7_wp
1464# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1465 lam = 0.2_wp
1466# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1467 wl = 2._wp*pi/lam
1468# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1469 amp = 0.05_wp/wl
1470# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1471
1472# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1473 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
1474# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1475
1476# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1477 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
1478# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1479
1480# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1481 if (alph < eps) alph = eps
1482# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1483 if (alph > 1._wp - eps) alph = 1._wp - eps
1484# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1485
1486# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1487 if (y_cc(j) > inth) then
1488# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1489 q_prim_vf(advxb)%sf(i, j, 0) = alph
1490# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1491 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
1492# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1493 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
1494# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1495 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
1496# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1497 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
1498# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1499 else
1500# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1501 q_prim_vf(advxb)%sf(i, j, 0) = alph
1502# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1503 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
1504# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1505 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
1506# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1507 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
1508# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1509 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
1510# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1511 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
1512# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1513 end if
1514# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1515
1516# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1517 case (205) ! 2D lung wave interaction problem
1518# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1519 h = 0.0_wp !non dim origin y
1520# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1521 lam = 1.0_wp !non dim lambda
1522# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1523 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
1524# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1525
1526# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1527 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
1528# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1529
1530# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1531 if (y_cc(j) > inth) then
1532# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1533 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1534# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1535 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1536# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1537 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
1538# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1539 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1540# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1541 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1542# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1543 end if
1544# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1545
1546# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1547 case (206) ! 2D lung wave interaction problem - horizontal domain
1548# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1549 h = 0.0_wp !non dim origin y
1550# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1551 lam = 1.0_wp !non dim lambda
1552# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1553 amp = patch_icpp(patch_id)%a(2)
1554# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1555
1556# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1557 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
1558# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1559
1560# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1561 if (x_cc(i) > intl) then !this is the liquid
1562# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1563 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
1564# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1565 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
1566# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1567 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
1568# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1569 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
1570# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1571 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
1572# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1573 end if
1574# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1575
1576# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1577 case (207) ! Kelvin Helmholtz Instability
1578# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1579 sigma = 0.05_wp/sqrt(2.0_wp)
1580# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1581 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
1582# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1583 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
1584# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1585 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
1586# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1587 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
1588# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1589
1590# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1591 case (208) ! Richtmeyer Meshkov Instability
1592# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1593 lam = 1.0_wp
1594# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1595 eps = 1.0e-6_wp
1596# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1597 ei = 5.0_wp
1598# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1599 ! Smoothening function to smooth out sharp discontinuity in the interface
1600# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1601 if (x_cc(i) <= 0.7_wp*lam) then
1602# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1603 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
1604# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1605 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
1606# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1607 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
1608# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1609 alpha_sf6 = 1.0_wp - alpha_air
1610# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1611 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
1612# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1613 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
1614# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1615 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
1616# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1617 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
1618# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1619 end if
1620# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1621
1622# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1623 case (250) ! MHD Orszag-Tang vortex
1624# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1625 ! gamma = 5/3
1626# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1627 ! rho = 25/(36*pi)
1628# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1629 ! p = 5/(12*pi)
1630# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1631 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
1632# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1633 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
1634# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1635
1636# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1637 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
1638# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1639 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
1640# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1641
1642# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1643 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
1644# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1645 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
1646# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1647
1648# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1649 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
1650# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1651 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
1652# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1653 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
1654# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1655 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
1656# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1657 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
1658# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1659 ! Linear interpolation between r=0.08 and r=1.0
1660# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1661 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
1662# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1663 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
1664# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1665 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
1666# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1667 else
1668# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1669 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
1670# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1671 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
1672# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1673 end if
1674# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1675
1676# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1677 ! case 252 is for the 2D MHD Rotor problem
1678# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1679 case (252) ! 2D MHD Rotor Problem
1680# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1681 ! Ambient conditions are set in the JSON file.
1682# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1683 ! This case imposes the dense, rotating cylinder.
1684# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1685 !
1686# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1687 ! gamma = 1.4
1688# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1689 ! Ambient medium (r > 0.1):
1690# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1691 ! rho = 1, p = 1, v = 0, B = (1,0,0)
1692# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1693 ! Rotor (r <= 0.1):
1694# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1695 ! rho = 10, p = 1
1696# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1697 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
1698# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1699
1700# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1701 ! Calculate distance squared from the center
1702# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1703 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
1704# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1705
1706# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1707 ! inner radius of 0.1
1708# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1709 if (r_sq <= 0.1**2) then
1710# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1711 ! -- Inside the rotor --
1712# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1713 ! Set density uniformly to 10
1714# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1715 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
1716# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1717
1718# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1719 ! Set vup constant rotation of rate v=2
1720# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1721 ! v_x = -omega * (y - y_c)
1722# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1723 ! v_y = omega * (x - x_c)
1724# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1725 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
1726# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1727 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
1728# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1729
1730# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1731 ! taper width of 0.015
1732# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1733 else if (r_sq <= 0.115**2) then
1734# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1735 ! linearly smooth the function between r = 0.1 and 0.115
1736# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1737 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
1738# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1739
1740# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1741 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)
1742# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1743 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)
1744# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1745 end if
1746# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1747
1748# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1749 case (253) ! MHD Smooth Magnetic Vortex
1750# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1751 ! Section 5.2 of
1752# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1753 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
1754# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1755 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
1756# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1757
1758# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1759 ! velocity
1760# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1761 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))
1762# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1763 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))
1764# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1765
1766# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1767 ! magnetic field
1768# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1769 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)
1770# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1771 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)
1772# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1773
1774# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1775 ! pressure
1776# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1777 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)
1778# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1779
1780# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1781 case (260) ! Gaussian Divergence Pulse
1782# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1783 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
1784# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1785 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
1786# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1787 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
1788# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1789 ! ψ is initialized to zero everywhere.
1790# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1791
1792# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1793 eps_mhd = patch_icpp(patch_id)%a(2)
1794# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1795 sigma = patch_icpp(patch_id)%a(3)
1796# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1797 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
1798# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1799
1800# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1801 ! B-field
1802# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1803 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
1804# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1805
1806# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1807 case (261) ! Blob
1808# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1809 r0 = 1._wp/sqrt(8._wp)
1810# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1811 r2 = x_cc(i)**2 + y_cc(j)**2
1812# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1813 r = sqrt(r2)
1814# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1815 alpha = r/r0
1816# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1817 if (alpha < 1) then
1818# 326 "/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/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
1820# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1821 ! 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)
1822# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1823 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
1824# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1825 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
1826# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1827 end if
1828# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1829
1830# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1831 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
1832# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1833 ! rotate by α = atan(2)
1834# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1835 alpha = atan(2._wp)
1836# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1837 cosa = cos(alpha)
1838# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1839 sina = sin(alpha)
1840# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1841 ! projection along shock normal
1842# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1843 r = x_cc(i)*cosa + y_cc(j)*sina
1844# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1845
1846# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1847 if (r <= 0.5_wp) then
1848# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1849 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
1850# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1851 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
1852# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1853 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
1854# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1855 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
1856# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1857 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
1858# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1859 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
1860# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1861 - (5._wp/sqrt(4._wp*pi))*sina
1862# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1863 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
1864# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1865 + (5._wp/sqrt(4._wp*pi))*cosa
1866# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1867 else
1868# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1869 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
1870# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1871 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
1872# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1873 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
1874# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1875 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
1876# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1877 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
1878# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1879 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
1880# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1881 - (5._wp/sqrt(4._wp*pi))*sina
1882# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1883 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
1884# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1885 + (5._wp/sqrt(4._wp*pi))*cosa
1886# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1887 end if
1888# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1889 ! v^z and B^z remain zero by default
1890# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1891
1892# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1893 case (270)
1894# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1895 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
1896# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1897
1898# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1899 if (.not. files_loaded) then
1900# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1901 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
1902# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1903 do f = 1, max_files
1904# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1905 write (file_num_str, '(I0)') f
1906# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1907 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
1908# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1909 end do
1910# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1911
1912# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1913 ! Common file reading setup
1914# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1915 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
1916# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1917 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
1918# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1919
1920# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1921 select case (num_dims)
1922# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1923 case (1, 2) ! 1D and 2D cases are similar
1924# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1925 ! Count lines
1926# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1927 line_count = 0
1928# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1929 do
1930# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1931 read (unit2, *, iostat=ios2) dummy_x, dummy_y
1932# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1933 if (ios2 /= 0) exit
1934# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1935 line_count = line_count + 1
1936# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1937 end do
1938# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1939 close (unit2)
1940# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1941
1942# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1943 xrows = line_count
1944# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1945 yrows = 1
1946# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1947 index_x = 0
1948# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1949 if (num_dims == 2) index_x = i
1950# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1951#ifdef MFC_DEBUG
1952# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1953 block
1954# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1955 use iso_fortran_env, only: output_unit
1956# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1957
1958# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1959 print *, 'm_icpp_patches.fpp:326: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
1960# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1961
1962# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1963 call flush (output_unit)
1964# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1965 end block
1966# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1967#endif
1968# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1969 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
1970# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1971
1972# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1973
1974# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1975
1976# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1977#if defined(MFC_OpenACC)
1978# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1979!$acc enter data create(x_coords, stored_values)
1980# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1981#elif defined(MFC_OpenMP)
1982# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1983!$omp target enter data map(always,alloc:x_coords, stored_values)
1984# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1985#endif
1986# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1987
1988# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1989 ! Read data from all files
1990# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1991 do f = 1, max_files
1992# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1993 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
1994# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1995 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
1996# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1997
1998# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
1999 do iter = 1, xrows
2000# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2001 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
2002# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2003 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
2004# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2005 end do
2006# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2007 close (unit)
2008# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2009 end do
2010# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2011
2012# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2013 ! Calculate offsets
2014# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2015 domain_xstart = x_coords(1)
2016# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2017 x_step = x_cc(1) - x_cc(0)
2018# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2019 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
2020# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2021 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
2022# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2023 global_offset_x = nint(abs(delta_x)/x_step)
2024# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2025
2026# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2027 case (3) ! 3D case - determine grid structure
2028# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2029 ! Find yRows by counting rows with same x
2030# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2031 read (unit2, *, iostat=ios2) x0, y0, dummy_z
2032# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2033 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
2034# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2035
2036# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2037 yrows = 1
2038# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2039 do
2040# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2041 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2042# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2043 if (ios2 /= 0) exit
2044# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2045 if (dummy_x == x0 .and. dummy_y /= y0) then
2046# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2047 yrows = yrows + 1
2048# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2049 else
2050# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2051 exit
2052# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2053 end if
2054# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2055 end do
2056# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2057 close (unit2)
2058# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2059
2060# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2061 ! Count total rows
2062# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2063 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
2064# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2065 nrows = 0
2066# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2067 do
2068# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2069 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
2070# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2071 if (ios2 /= 0) exit
2072# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2073 nrows = nrows + 1
2074# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2075 end do
2076# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2077 close (unit2)
2078# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2079
2080# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2081 xrows = nrows/yrows
2082# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2083#ifdef MFC_DEBUG
2084# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2085 block
2086# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2087 use iso_fortran_env, only: output_unit
2088# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2089
2090# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2091 print *, 'm_icpp_patches.fpp:326: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
2092# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2093
2094# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2095 call flush (output_unit)
2096# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2097 end block
2098# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2099#endif
2100# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2101 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
2102# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2103
2104# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2105
2106# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2107
2108# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2109
2110# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2111#if defined(MFC_OpenACC)
2112# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2113!$acc enter data create(x_coords, y_coords, stored_values)
2114# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2115#elif defined(MFC_OpenMP)
2116# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2117!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
2118# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2119#endif
2120# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2121 index_x = i
2122# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2123 index_y = j
2124# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2125
2126# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2127 ! Read all files
2128# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2129 do f = 1, max_files
2130# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2131 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
2132# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2133 if (ios /= 0) then
2134# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2135 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
2136# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2137 cycle
2138# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2139 end if
2140# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2141
2142# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2143 iter = 0
2144# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2145 do iix = 1, xrows
2146# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2147 do iiy = 1, yrows
2148# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2149 iter = iter + 1
2150# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2151 if (f == 1) then
2152# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2153 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
2154# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2155 else
2156# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2157 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
2158# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2159 end if
2160# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2161 if (ios /= 0) call s_mpi_abort("Error reading data")
2162# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2163 end do
2164# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2165 end do
2166# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2167 close (unit)
2168# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2169 end do
2170# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2171
2172# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2173 ! Calculate offsets
2174# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2175 x_step = x_cc(1) - x_cc(0)
2176# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2177 y_step = y_cc(1) - y_cc(0)
2178# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2179 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
2180# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2181 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
2182# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2183 global_offset_x = nint(abs(delta_x)/x_step)
2184# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2185 global_offset_y = nint(abs(delta_y)/y_step)
2186# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2187 end select
2188# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2189
2190# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2191 files_loaded = .true.
2192# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2193 end if
2194# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2195
2196# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2197 ! Data assignment
2198# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2199 select case (num_dims)
2200# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2201 case (1)
2202# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2203 idx = i + 1 + global_offset_x
2204# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2205 do f = 1, sys_size
2206# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2207 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
2208# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2209 end do
2210# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2211
2212# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2213 case (2)
2214# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2215 idx = i + 1 + global_offset_x - index_x
2216# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2217 do f = 1, sys_size - 1
2218# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2219 jump = merge(1, 0, f >= momxe)
2220# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2221 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
2222# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2223 end do
2224# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2225 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
2226# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2227
2228# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2229 case (3)
2230# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2231 idx = i + 1 + global_offset_x - index_x
2232# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2233 idy = j + 1 + global_offset_y - index_y
2234# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2235 do f = 1, sys_size - 1
2236# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2237 jump = merge(1, 0, f >= momxe)
2238# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2239 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
2240# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2241 end do
2242# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2243 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
2244# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2245 end select
2246# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2247
2248# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2249 case (280)
2250# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2251 ! This is patch is hard-coded for test suite optimization used in the
2252# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2253 ! 2D_isentropicvortex case:
2254# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2255 ! This analytic patch uses geometry 2
2256# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2257 if (patch_id == 1) then
2258# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2259 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)
2260# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2261 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
2262# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2263 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))
2264# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2265 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))
2266# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2267 end if
2268# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2269
2270# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2271 case (281)
2272# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2273 ! This is patch is hard-coded for test suite optimization used in the
2274# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2275 ! 2D_acoustic_pulse case:
2276# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2277 ! This analytic patch uses geometry 2
2278# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2279 if (patch_id == 2) then
2280# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2281 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))
2282# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2283 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))
2284# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2285 end if
2286# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2287
2288# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2289 case (282)
2290# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2291 ! This is patch is hard-coded for test suite optimization used in the
2292# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2293 ! 2D_zero_circ_vortex case:
2294# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2295 ! This analytic patch uses geometry 2
2296# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2297 if (patch_id == 2) then
2298# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2299 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))
2300# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2301 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))
2302# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2303 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)))
2304# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2305 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)))
2306# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2307 end if
2308# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2309
2310# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2311 case default
2312# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2313 if (proc_rank == 0) then
2314# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2315 call s_int_to_str(patch_id, istr)
2316# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2317 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
2318# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2319 end if
2320# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2321
2322# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2323 end select
2324# 326 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2325
2326 end if
2327
2328 ! Updating the patch identities bookkeeping variable
2329 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
2330 end if
2331 end do
2332 end do
2333 if (allocated(stored_values)) then
2334# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2335#ifdef MFC_DEBUG
2336# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2337 block
2338# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2339 use iso_fortran_env, only: output_unit
2340# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2341
2342# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2343 print *, 'm_icpp_patches.fpp:334: ', '@:DEALLOCATE(stored_values)'
2344# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2345
2346# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2347 call flush (output_unit)
2348# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2349 end block
2350# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2351#endif
2352# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2353
2354# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2355#if defined(MFC_OpenACC)
2356# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2357!$acc exit data delete(stored_values)
2358# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2359#elif defined(MFC_OpenMP)
2360# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2361!$omp target exit data map(release:stored_values)
2362# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2363#endif
2364# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2365 deallocate (stored_values)
2366# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2367#ifdef MFC_DEBUG
2368# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2369 block
2370# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2371 use iso_fortran_env, only: output_unit
2372# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2373
2374# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2375 print *, 'm_icpp_patches.fpp:334: ', '@:DEALLOCATE(x_coords)'
2376# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2377
2378# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2379 call flush (output_unit)
2380# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2381 end block
2382# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2383#endif
2384# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2385
2386# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2387#if defined(MFC_OpenACC)
2388# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2389!$acc exit data delete(x_coords)
2390# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2391#elif defined(MFC_OpenMP)
2392# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2393!$omp target exit data map(release:x_coords)
2394# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2395#endif
2396# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2397 deallocate (x_coords)
2398# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2399 end if
2400# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2401
2402# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2403 if (allocated(y_coords)) then
2404# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2405#ifdef MFC_DEBUG
2406# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2407 block
2408# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2409 use iso_fortran_env, only: output_unit
2410# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2411
2412# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2413 print *, 'm_icpp_patches.fpp:334: ', '@:DEALLOCATE(y_coords)'
2414# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2415
2416# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2417 call flush (output_unit)
2418# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2419 end block
2420# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2421#endif
2422# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2423
2424# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2425#if defined(MFC_OpenACC)
2426# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2427!$acc exit data delete(y_coords)
2428# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2429#elif defined(MFC_OpenMP)
2430# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2431!$omp target exit data map(release:y_coords)
2432# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2433#endif
2434# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2435 deallocate (y_coords)
2436# 334 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2437 end if
2438
2439 end subroutine s_icpp_spiral
2440
2441 !> The circular patch is a 2D geometry that may be used, for
2442 !! example, in creating a bubble or a droplet. The geometry
2443 !! of the patch is well-defined when its centroid and radius
2444 !! are provided. Note that the circular patch DOES allow for
2445 !! the smoothing of its boundary.
2446 !! @param patch_id is the patch identifier
2447 !! @param patch_id_fp Array to track patch ids
2448 !! @param q_prim_vf Array of primitive variables
2449 subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
2450
2451 integer, intent(in) :: patch_id
2452#ifdef MFC_MIXED_PRECISION
2453 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
2454#else
2455 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
2456#endif
2457 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
2458
2459 real(wp) :: radius
2460
2461 integer :: i, j, k !< Generic loop iterators
2462 integer :: xRows, yRows, nRows, iix, iiy, max_files
2463# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2464 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
2465# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2466 real(wp) :: x_len, x_step, y_len, y_step
2467# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2468 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
2469# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2470 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
2471# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2472 real(wp) :: delta_x, delta_y
2473# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2474 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
2475# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2476 character(len=200) :: errmsg
2477# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2478 real(wp), allocatable :: stored_values(:, :, :)
2479# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2480 real(wp), allocatable :: x_coords(:), y_coords(:)
2481# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2482 logical :: files_loaded = .false.
2483# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2484 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
2485# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2486 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
2487# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2488 character(len=20) :: file_num_str ! For storing the file number as a string
2489# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2490 character(len=20) :: zeros_part ! For the trailing zeros part
2491# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2492 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
2493 ! Place any declaration of intermediate variables here
2494# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2495 real(wp) :: eps, eps_mhd, C_mhd
2496# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2497 real(wp) :: r, rmax, gam, umax, p0
2498# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2499 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
2500# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2501 real(wp) :: factor
2502# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2503 real(wp) :: r0, alpha, r2
2504# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2505 real(wp) :: sinA, cosA
2506# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2507
2508# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2509 real(wp) :: r_sq
2510# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2511
2512# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2513 ! # 207
2514# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2515 real(wp) :: sigma, gauss1, gauss2
2516# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2517 ! # 208
2518# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2519 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
2520# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2521
2522# 360 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2523 eps = 1.e-9_wp
2524
2525 ! Transferring the circular patch's radius, centroid, smearing patch
2526 ! identity and smearing coefficient information
2527
2528 x_centroid = patch_icpp(patch_id)%x_centroid
2529 y_centroid = patch_icpp(patch_id)%y_centroid
2530 radius = patch_icpp(patch_id)%radius
2531 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
2532 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
2533
2534 ! Initializing the pseudo volume fraction value to 1. The value will
2535 ! be modified as the patch is laid out on the grid, but only in the
2536 ! case that smoothing of the circular patch's boundary is enabled.
2537 eta = 1._wp
2538
2539 ! Checking whether the circle covers a particular cell in the domain
2540 ! and verifying whether the current patch has permission to write to
2541 ! that cell. If both queries check out, the primitive variables of
2542 ! the current patch are assigned to this cell.
2543
2544 do j = 0, n
2545 do i = 0, m
2546
2547 if (patch_icpp(patch_id)%smoothen) then
2548
2549 eta = tanh(smooth_coeff/min(dx, dy)* &
2550 (sqrt((x_cc(i) - x_centroid)**2 &
2551 + (y_cc(j) - y_centroid)**2) &
2552 - radius))*(-0.5_wp) + 0.5_wp
2553
2554 end if
2555
2556 if (((x_cc(i) - x_centroid)**2 &
2557 + (y_cc(j) - y_centroid)**2 <= radius**2 &
2558 .and. &
2559 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
2560 .or. &
2561 patch_id_fp(i, j, 0) == smooth_patch_id) &
2562 then
2563
2564 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
2565 eta, q_prim_vf, patch_id_fp)
2566
2567
2568 if (patch_icpp(patch_id)%hcid /= dflt_int) then
2569
2570# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2571 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
2572# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2573
2574# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2575 case (200)
2576# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2577 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
2578# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2579 ! Volume Fractions
2580# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2581 q_prim_vf(advxb)%sf(i, j, 0) = eps
2582# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2583 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
2584# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2585 ! Denssities
2586# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2587 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
2588# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2589 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
2590# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2591 ! Pressure
2592# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2593 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
2594# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2595 end if
2596# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2597 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
2598# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2599 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2600# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2601 rmax = 0.2_wp
2602# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2603
2604# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2605 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2606# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2607 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2608# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2609 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2610# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2611
2612# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2613 if (r < rmax) then
2614# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2615 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2616# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2617 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2618# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2619 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2620# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2621 else if (r < 2*rmax) then
2622# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2623 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2624# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2625 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2626# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2627 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
2628# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2629 else
2630# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2631 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
2632# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2633 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
2634# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2635 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
2636# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2637 end if
2638# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2639 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
2640# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2641 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
2642# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2643 rmax = 0.2_wp
2644# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2645
2646# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2647 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
2648# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2649 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
2650# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2651 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
2652# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2653
2654# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2655 if (r < rmax) then
2656# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2657 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
2658# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2659 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
2660# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2661 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
2662# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2663 else if (r < 2*rmax) then
2664# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2665 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2666# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2667 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
2668# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2669 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)))
2670# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2671 else
2672# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2673 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
2674# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2675 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
2676# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2677 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
2678# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2679 end if
2680# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2681
2682# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2683 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
2684# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2685 case (204) ! Rayleigh-Taylor instability
2686# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2687 rhoh = 3._wp
2688# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2689 rhol = 1._wp
2690# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2691 pref = 1.e5_wp
2692# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2693 pint = pref
2694# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2695 h = 0.7_wp
2696# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2697 lam = 0.2_wp
2698# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2699 wl = 2._wp*pi/lam
2700# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2701 amp = 0.05_wp/wl
2702# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2703
2704# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2705 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
2706# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2707
2708# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2709 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
2710# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2711
2712# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2713 if (alph < eps) alph = eps
2714# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2715 if (alph > 1._wp - eps) alph = 1._wp - eps
2716# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2717
2718# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2719 if (y_cc(j) > inth) then
2720# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2721 q_prim_vf(advxb)%sf(i, j, 0) = alph
2722# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2723 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
2724# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2725 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
2726# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2727 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
2728# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2729 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
2730# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2731 else
2732# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2733 q_prim_vf(advxb)%sf(i, j, 0) = alph
2734# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2735 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
2736# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2737 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
2738# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2739 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
2740# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2741 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
2742# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2743 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
2744# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2745 end if
2746# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2747
2748# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2749 case (205) ! 2D lung wave interaction problem
2750# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2751 h = 0.0_wp !non dim origin y
2752# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2753 lam = 1.0_wp !non dim lambda
2754# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2755 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
2756# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2757
2758# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2759 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
2760# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2761
2762# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2763 if (y_cc(j) > inth) then
2764# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2765 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2766# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2767 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2768# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2769 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
2770# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2771 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2772# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2773 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2774# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2775 end if
2776# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2777
2778# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2779 case (206) ! 2D lung wave interaction problem - horizontal domain
2780# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2781 h = 0.0_wp !non dim origin y
2782# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2783 lam = 1.0_wp !non dim lambda
2784# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2785 amp = patch_icpp(patch_id)%a(2)
2786# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2787
2788# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2789 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
2790# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2791
2792# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2793 if (x_cc(i) > intl) then !this is the liquid
2794# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2795 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
2796# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2797 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
2798# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2799 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
2800# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2801 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
2802# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2803 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
2804# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2805 end if
2806# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2807
2808# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2809 case (207) ! Kelvin Helmholtz Instability
2810# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2811 sigma = 0.05_wp/sqrt(2.0_wp)
2812# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2813 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
2814# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2815 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
2816# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2817 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
2818# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2819 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
2820# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2821
2822# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2823 case (208) ! Richtmeyer Meshkov Instability
2824# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2825 lam = 1.0_wp
2826# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2827 eps = 1.0e-6_wp
2828# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2829 ei = 5.0_wp
2830# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2831 ! Smoothening function to smooth out sharp discontinuity in the interface
2832# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2833 if (x_cc(i) <= 0.7_wp*lam) then
2834# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2835 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
2836# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2837 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
2838# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2839 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
2840# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2841 alpha_sf6 = 1.0_wp - alpha_air
2842# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2843 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
2844# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2845 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
2846# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2847 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
2848# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2849 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
2850# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2851 end if
2852# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2853
2854# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2855 case (250) ! MHD Orszag-Tang vortex
2856# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2857 ! gamma = 5/3
2858# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2859 ! rho = 25/(36*pi)
2860# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2861 ! p = 5/(12*pi)
2862# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2863 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
2864# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2865 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
2866# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2867
2868# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2869 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
2870# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2871 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
2872# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2873
2874# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2875 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
2876# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2877 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
2878# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2879
2880# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2881 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
2882# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2883 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
2884# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2885 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
2886# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2887 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
2888# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2889 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
2890# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2891 ! Linear interpolation between r=0.08 and r=1.0
2892# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2893 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
2894# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2895 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
2896# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2897 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
2898# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2899 else
2900# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2901 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
2902# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2903 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
2904# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2905 end if
2906# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2907
2908# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2909 ! case 252 is for the 2D MHD Rotor problem
2910# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2911 case (252) ! 2D MHD Rotor Problem
2912# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2913 ! Ambient conditions are set in the JSON file.
2914# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2915 ! This case imposes the dense, rotating cylinder.
2916# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2917 !
2918# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2919 ! gamma = 1.4
2920# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2921 ! Ambient medium (r > 0.1):
2922# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2923 ! rho = 1, p = 1, v = 0, B = (1,0,0)
2924# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2925 ! Rotor (r <= 0.1):
2926# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2927 ! rho = 10, p = 1
2928# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2929 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
2930# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2931
2932# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2933 ! Calculate distance squared from the center
2934# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2935 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
2936# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2937
2938# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2939 ! inner radius of 0.1
2940# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2941 if (r_sq <= 0.1**2) then
2942# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2943 ! -- Inside the rotor --
2944# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2945 ! Set density uniformly to 10
2946# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2947 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
2948# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2949
2950# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2951 ! Set vup constant rotation of rate v=2
2952# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2953 ! v_x = -omega * (y - y_c)
2954# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2955 ! v_y = omega * (x - x_c)
2956# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2957 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
2958# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2959 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
2960# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2961
2962# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2963 ! taper width of 0.015
2964# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2965 else if (r_sq <= 0.115**2) then
2966# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2967 ! linearly smooth the function between r = 0.1 and 0.115
2968# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2969 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
2970# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2971
2972# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2973 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)
2974# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2975 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)
2976# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2977 end if
2978# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2979
2980# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2981 case (253) ! MHD Smooth Magnetic Vortex
2982# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2983 ! Section 5.2 of
2984# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2985 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
2986# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2987 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
2988# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2989
2990# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2991 ! velocity
2992# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2993 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))
2994# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2995 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))
2996# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2997
2998# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
2999 ! magnetic field
3000# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3001 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)
3002# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3003 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)
3004# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3005
3006# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3007 ! pressure
3008# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3009 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)
3010# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3011
3012# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3013 case (260) ! Gaussian Divergence Pulse
3014# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3015 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
3016# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3017 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
3018# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3019 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
3020# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3021 ! ψ is initialized to zero everywhere.
3022# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3023
3024# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3025 eps_mhd = patch_icpp(patch_id)%a(2)
3026# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3027 sigma = patch_icpp(patch_id)%a(3)
3028# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3029 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
3030# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3031
3032# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3033 ! B-field
3034# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3035 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
3036# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3037
3038# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3039 case (261) ! Blob
3040# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3041 r0 = 1._wp/sqrt(8._wp)
3042# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3043 r2 = x_cc(i)**2 + y_cc(j)**2
3044# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3045 r = sqrt(r2)
3046# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3047 alpha = r/r0
3048# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3049 if (alpha < 1) then
3050# 406 "/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/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
3052# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3053 ! 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)
3054# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3055 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
3056# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3057 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
3058# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3059 end if
3060# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3061
3062# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3063 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
3064# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3065 ! rotate by α = atan(2)
3066# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3067 alpha = atan(2._wp)
3068# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3069 cosa = cos(alpha)
3070# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3071 sina = sin(alpha)
3072# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3073 ! projection along shock normal
3074# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3075 r = x_cc(i)*cosa + y_cc(j)*sina
3076# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3077
3078# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3079 if (r <= 0.5_wp) then
3080# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3081 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
3082# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3083 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
3084# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3085 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
3086# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3087 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
3088# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3089 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
3090# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3091 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
3092# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3093 - (5._wp/sqrt(4._wp*pi))*sina
3094# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3095 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
3096# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3097 + (5._wp/sqrt(4._wp*pi))*cosa
3098# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3099 else
3100# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3101 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
3102# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3103 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
3104# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3105 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
3106# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3107 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
3108# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3109 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
3110# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3111 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
3112# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3113 - (5._wp/sqrt(4._wp*pi))*sina
3114# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3115 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
3116# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3117 + (5._wp/sqrt(4._wp*pi))*cosa
3118# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3119 end if
3120# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3121 ! v^z and B^z remain zero by default
3122# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3123
3124# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3125 case (270)
3126# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3127 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
3128# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3129
3130# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3131 if (.not. files_loaded) then
3132# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3133 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
3134# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3135 do f = 1, max_files
3136# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3137 write (file_num_str, '(I0)') f
3138# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3139 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
3140# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3141 end do
3142# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3143
3144# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3145 ! Common file reading setup
3146# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3147 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3148# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3149 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
3150# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3151
3152# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3153 select case (num_dims)
3154# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3155 case (1, 2) ! 1D and 2D cases are similar
3156# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3157 ! Count lines
3158# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3159 line_count = 0
3160# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3161 do
3162# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3163 read (unit2, *, iostat=ios2) dummy_x, dummy_y
3164# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3165 if (ios2 /= 0) exit
3166# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3167 line_count = line_count + 1
3168# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3169 end do
3170# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3171 close (unit2)
3172# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3173
3174# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3175 xrows = line_count
3176# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3177 yrows = 1
3178# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3179 index_x = 0
3180# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3181 if (num_dims == 2) index_x = i
3182# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3183#ifdef MFC_DEBUG
3184# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3185 block
3186# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3187 use iso_fortran_env, only: output_unit
3188# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3189
3190# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3191 print *, 'm_icpp_patches.fpp:406: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
3192# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3193
3194# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3195 call flush (output_unit)
3196# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3197 end block
3198# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3199#endif
3200# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3201 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
3202# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3203
3204# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3205
3206# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3207
3208# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3209#if defined(MFC_OpenACC)
3210# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3211!$acc enter data create(x_coords, stored_values)
3212# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3213#elif defined(MFC_OpenMP)
3214# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3215!$omp target enter data map(always,alloc:x_coords, stored_values)
3216# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3217#endif
3218# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3219
3220# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3221 ! Read data from all files
3222# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3223 do f = 1, max_files
3224# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3225 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3226# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3227 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
3228# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3229
3230# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3231 do iter = 1, xrows
3232# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3233 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
3234# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3235 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
3236# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3237 end do
3238# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3239 close (unit)
3240# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3241 end do
3242# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3243
3244# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3245 ! Calculate offsets
3246# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3247 domain_xstart = x_coords(1)
3248# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3249 x_step = x_cc(1) - x_cc(0)
3250# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3251 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
3252# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3253 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
3254# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3255 global_offset_x = nint(abs(delta_x)/x_step)
3256# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3257
3258# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3259 case (3) ! 3D case - determine grid structure
3260# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3261 ! Find yRows by counting rows with same x
3262# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3263 read (unit2, *, iostat=ios2) x0, y0, dummy_z
3264# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3265 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
3266# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3267
3268# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3269 yrows = 1
3270# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3271 do
3272# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3273 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3274# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3275 if (ios2 /= 0) exit
3276# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3277 if (dummy_x == x0 .and. dummy_y /= y0) then
3278# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3279 yrows = yrows + 1
3280# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3281 else
3282# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3283 exit
3284# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3285 end if
3286# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3287 end do
3288# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3289 close (unit2)
3290# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3291
3292# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3293 ! Count total rows
3294# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3295 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
3296# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3297 nrows = 0
3298# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3299 do
3300# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3301 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
3302# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3303 if (ios2 /= 0) exit
3304# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3305 nrows = nrows + 1
3306# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3307 end do
3308# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3309 close (unit2)
3310# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3311
3312# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3313 xrows = nrows/yrows
3314# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3315#ifdef MFC_DEBUG
3316# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3317 block
3318# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3319 use iso_fortran_env, only: output_unit
3320# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3321
3322# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3323 print *, 'm_icpp_patches.fpp:406: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
3324# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3325
3326# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3327 call flush (output_unit)
3328# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3329 end block
3330# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3331#endif
3332# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3333 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
3334# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3335
3336# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3337
3338# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3339
3340# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3341
3342# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3343#if defined(MFC_OpenACC)
3344# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3345!$acc enter data create(x_coords, y_coords, stored_values)
3346# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3347#elif defined(MFC_OpenMP)
3348# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3349!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
3350# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3351#endif
3352# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3353 index_x = i
3354# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3355 index_y = j
3356# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3357
3358# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3359 ! Read all files
3360# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3361 do f = 1, max_files
3362# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3363 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
3364# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3365 if (ios /= 0) then
3366# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3367 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
3368# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3369 cycle
3370# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3371 end if
3372# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3373
3374# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3375 iter = 0
3376# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3377 do iix = 1, xrows
3378# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3379 do iiy = 1, yrows
3380# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3381 iter = iter + 1
3382# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3383 if (f == 1) then
3384# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3385 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
3386# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3387 else
3388# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3389 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
3390# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3391 end if
3392# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3393 if (ios /= 0) call s_mpi_abort("Error reading data")
3394# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3395 end do
3396# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3397 end do
3398# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3399 close (unit)
3400# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3401 end do
3402# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3403
3404# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3405 ! Calculate offsets
3406# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3407 x_step = x_cc(1) - x_cc(0)
3408# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3409 y_step = y_cc(1) - y_cc(0)
3410# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3411 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
3412# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3413 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
3414# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3415 global_offset_x = nint(abs(delta_x)/x_step)
3416# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3417 global_offset_y = nint(abs(delta_y)/y_step)
3418# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3419 end select
3420# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3421
3422# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3423 files_loaded = .true.
3424# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3425 end if
3426# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3427
3428# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3429 ! Data assignment
3430# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3431 select case (num_dims)
3432# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3433 case (1)
3434# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3435 idx = i + 1 + global_offset_x
3436# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3437 do f = 1, sys_size
3438# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3439 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
3440# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3441 end do
3442# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3443
3444# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3445 case (2)
3446# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3447 idx = i + 1 + global_offset_x - index_x
3448# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3449 do f = 1, sys_size - 1
3450# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3451 jump = merge(1, 0, f >= momxe)
3452# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3453 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
3454# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3455 end do
3456# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3457 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
3458# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3459
3460# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3461 case (3)
3462# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3463 idx = i + 1 + global_offset_x - index_x
3464# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3465 idy = j + 1 + global_offset_y - index_y
3466# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3467 do f = 1, sys_size - 1
3468# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3469 jump = merge(1, 0, f >= momxe)
3470# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3471 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
3472# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3473 end do
3474# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3475 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
3476# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3477 end select
3478# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3479
3480# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3481 case (280)
3482# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3483 ! This is patch is hard-coded for test suite optimization used in the
3484# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3485 ! 2D_isentropicvortex case:
3486# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3487 ! This analytic patch uses geometry 2
3488# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3489 if (patch_id == 1) then
3490# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3491 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)
3492# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3493 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
3494# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3495 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))
3496# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3497 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))
3498# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3499 end if
3500# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3501
3502# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3503 case (281)
3504# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3505 ! This is patch is hard-coded for test suite optimization used in the
3506# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3507 ! 2D_acoustic_pulse case:
3508# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3509 ! This analytic patch uses geometry 2
3510# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3511 if (patch_id == 2) then
3512# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3513 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))
3514# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3515 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))
3516# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3517 end if
3518# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3519
3520# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3521 case (282)
3522# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3523 ! This is patch is hard-coded for test suite optimization used in the
3524# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3525 ! 2D_zero_circ_vortex case:
3526# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3527 ! This analytic patch uses geometry 2
3528# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3529 if (patch_id == 2) then
3530# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3531 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))
3532# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3533 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))
3534# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3535 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)))
3536# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3537 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)))
3538# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3539 end if
3540# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3541
3542# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3543 case default
3544# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3545 if (proc_rank == 0) then
3546# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3547 call s_int_to_str(patch_id, istr)
3548# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3549 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
3550# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3551 end if
3552# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3553
3554# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3555 end select
3556# 406 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3557
3558 end if
3559
3560 end if
3561 end do
3562 end do
3563 if (allocated(stored_values)) then
3564# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3565#ifdef MFC_DEBUG
3566# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3567 block
3568# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3569 use iso_fortran_env, only: output_unit
3570# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3571
3572# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3573 print *, 'm_icpp_patches.fpp:412: ', '@:DEALLOCATE(stored_values)'
3574# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3575
3576# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3577 call flush (output_unit)
3578# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3579 end block
3580# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3581#endif
3582# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3583
3584# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3585#if defined(MFC_OpenACC)
3586# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3587!$acc exit data delete(stored_values)
3588# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3589#elif defined(MFC_OpenMP)
3590# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3591!$omp target exit data map(release:stored_values)
3592# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3593#endif
3594# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3595 deallocate (stored_values)
3596# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3597#ifdef MFC_DEBUG
3598# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3599 block
3600# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3601 use iso_fortran_env, only: output_unit
3602# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3603
3604# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3605 print *, 'm_icpp_patches.fpp:412: ', '@:DEALLOCATE(x_coords)'
3606# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3607
3608# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3609 call flush (output_unit)
3610# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3611 end block
3612# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3613#endif
3614# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3615
3616# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3617#if defined(MFC_OpenACC)
3618# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3619!$acc exit data delete(x_coords)
3620# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3621#elif defined(MFC_OpenMP)
3622# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3623!$omp target exit data map(release:x_coords)
3624# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3625#endif
3626# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3627 deallocate (x_coords)
3628# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3629 end if
3630# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3631
3632# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3633 if (allocated(y_coords)) then
3634# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3635#ifdef MFC_DEBUG
3636# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3637 block
3638# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3639 use iso_fortran_env, only: output_unit
3640# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3641
3642# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3643 print *, 'm_icpp_patches.fpp:412: ', '@:DEALLOCATE(y_coords)'
3644# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3645
3646# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3647 call flush (output_unit)
3648# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3649 end block
3650# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3651#endif
3652# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3653
3654# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3655#if defined(MFC_OpenACC)
3656# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3657!$acc exit data delete(y_coords)
3658# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3659#elif defined(MFC_OpenMP)
3660# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3661!$omp target exit data map(release:y_coords)
3662# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3663#endif
3664# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3665 deallocate (y_coords)
3666# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3667 end if
3668
3669 end subroutine s_icpp_circle
3670
3671 !> The varcircle patch is a 2D geometry that may be used
3672 !! . It generatres an annulus
3673 !! @param patch_id is the patch identifier
3674 !! @param patch_id_fp Array to track patch ids
3675 !! @param q_prim_vf Array of primitive variables
3676 subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
3677
3678 ! Patch identifier
3679 integer, intent(in) :: patch_id
3680#ifdef MFC_MIXED_PRECISION
3681 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
3682#else
3683 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
3684#endif
3685 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
3686
3687 ! Generic loop iterators
3688 integer :: i, j, k
3689 real(wp) :: radius, myr, thickness
3690 integer :: xRows, yRows, nRows, iix, iiy, max_files
3691# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3692 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
3693# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3694 real(wp) :: x_len, x_step, y_len, y_step
3695# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3696 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
3697# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3698 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
3699# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3700 real(wp) :: delta_x, delta_y
3701# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3702 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
3703# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3704 character(len=200) :: errmsg
3705# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3706 real(wp), allocatable :: stored_values(:, :, :)
3707# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3708 real(wp), allocatable :: x_coords(:), y_coords(:)
3709# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3710 logical :: files_loaded = .false.
3711# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3712 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
3713# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3714 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
3715# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3716 character(len=20) :: file_num_str ! For storing the file number as a string
3717# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3718 character(len=20) :: zeros_part ! For the trailing zeros part
3719# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3720 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
3721 ! Place any declaration of intermediate variables here
3722# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3723 real(wp) :: eps, eps_mhd, C_mhd
3724# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3725 real(wp) :: r, rmax, gam, umax, p0
3726# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3727 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
3728# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3729 real(wp) :: factor
3730# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3731 real(wp) :: r0, alpha, r2
3732# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3733 real(wp) :: sinA, cosA
3734# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3735
3736# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3737 real(wp) :: r_sq
3738# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3739
3740# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3741 ! # 207
3742# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3743 real(wp) :: sigma, gauss1, gauss2
3744# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3745 ! # 208
3746# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3747 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
3748# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3749
3750# 436 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3751 eps = 1.e-9_wp
3752
3753 ! Transferring the circular patch's radius, centroid, smearing patch
3754 ! identity and smearing coefficient information
3755 x_centroid = patch_icpp(patch_id)%x_centroid
3756 y_centroid = patch_icpp(patch_id)%y_centroid
3757 radius = patch_icpp(patch_id)%radius
3758 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
3759 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
3760 thickness = patch_icpp(patch_id)%epsilon
3761
3762 ! Initializing the pseudo volume fraction value to 1. The value will
3763 ! be modified as the patch is laid out on the grid, but only in the
3764 ! case that smoothing of the circular patch's boundary is enabled.
3765 eta = 1._wp
3766
3767 ! Checking whether the circle covers a particular cell in the domain
3768 ! and verifying whether the current patch has permission to write to
3769 ! that cell. If both queries check out, the primitive variables of
3770 ! the current patch are assigned to this cell.
3771 do j = 0, n
3772 do i = 0, m
3773 myr = sqrt((x_cc(i) - x_centroid)**2 &
3774 + (y_cc(j) - y_centroid)**2)
3775
3776 if (myr <= radius + thickness/2._wp .and. &
3777 myr >= radius - thickness/2._wp .and. &
3778 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
3779
3780 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
3781 eta, q_prim_vf, patch_id_fp)
3782
3783
3784 if (patch_icpp(patch_id)%hcid /= dflt_int) then
3785
3786# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3787 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
3788# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3789
3790# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3791 case (200)
3792# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3793 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
3794# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3795 ! Volume Fractions
3796# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3797 q_prim_vf(advxb)%sf(i, j, 0) = eps
3798# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3799 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
3800# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3801 ! Denssities
3802# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3803 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
3804# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3805 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
3806# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3807 ! Pressure
3808# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3809 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
3810# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3811 end if
3812# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3813 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
3814# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3815 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3816# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3817 rmax = 0.2_wp
3818# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3819
3820# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3821 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3822# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3823 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3824# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3825 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3826# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3827
3828# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3829 if (r < rmax) then
3830# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3831 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3832# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3833 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3834# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3835 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3836# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3837 else if (r < 2*rmax) then
3838# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3839 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3840# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3841 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3842# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3843 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
3844# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3845 else
3846# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3847 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
3848# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3849 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
3850# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3851 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
3852# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3853 end if
3854# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3855 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
3856# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3857 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
3858# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3859 rmax = 0.2_wp
3860# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3861
3862# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3863 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
3864# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3865 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
3866# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3867 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
3868# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3869
3870# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3871 if (r < rmax) then
3872# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3873 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
3874# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3875 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
3876# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3877 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
3878# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3879 else if (r < 2*rmax) then
3880# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3881 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3882# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3883 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
3884# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3885 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)))
3886# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3887 else
3888# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3889 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
3890# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3891 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
3892# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3893 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
3894# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3895 end if
3896# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3897
3898# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3899 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
3900# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3901 case (204) ! Rayleigh-Taylor instability
3902# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3903 rhoh = 3._wp
3904# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3905 rhol = 1._wp
3906# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3907 pref = 1.e5_wp
3908# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3909 pint = pref
3910# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3911 h = 0.7_wp
3912# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3913 lam = 0.2_wp
3914# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3915 wl = 2._wp*pi/lam
3916# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3917 amp = 0.05_wp/wl
3918# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3919
3920# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3921 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
3922# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3923
3924# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3925 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
3926# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3927
3928# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3929 if (alph < eps) alph = eps
3930# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3931 if (alph > 1._wp - eps) alph = 1._wp - eps
3932# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3933
3934# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3935 if (y_cc(j) > inth) then
3936# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3937 q_prim_vf(advxb)%sf(i, j, 0) = alph
3938# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3939 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
3940# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3941 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
3942# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3943 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
3944# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3945 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
3946# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3947 else
3948# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3949 q_prim_vf(advxb)%sf(i, j, 0) = alph
3950# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3951 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
3952# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3953 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
3954# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3955 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
3956# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3957 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
3958# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3959 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
3960# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3961 end if
3962# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3963
3964# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3965 case (205) ! 2D lung wave interaction problem
3966# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3967 h = 0.0_wp !non dim origin y
3968# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3969 lam = 1.0_wp !non dim lambda
3970# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3971 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
3972# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3973
3974# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3975 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
3976# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3977
3978# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3979 if (y_cc(j) > inth) then
3980# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3981 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
3982# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3983 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
3984# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3985 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
3986# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3987 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
3988# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3989 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
3990# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3991 end if
3992# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3993
3994# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3995 case (206) ! 2D lung wave interaction problem - horizontal domain
3996# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3997 h = 0.0_wp !non dim origin y
3998# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
3999 lam = 1.0_wp !non dim lambda
4000# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4001 amp = patch_icpp(patch_id)%a(2)
4002# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4003
4004# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4005 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
4006# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4007
4008# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4009 if (x_cc(i) > intl) then !this is the liquid
4010# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4011 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
4012# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4013 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
4014# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4015 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
4016# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4017 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
4018# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4019 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
4020# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4021 end if
4022# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4023
4024# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4025 case (207) ! Kelvin Helmholtz Instability
4026# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4027 sigma = 0.05_wp/sqrt(2.0_wp)
4028# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4029 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
4030# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4031 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
4032# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4033 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
4034# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4035 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
4036# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4037
4038# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4039 case (208) ! Richtmeyer Meshkov Instability
4040# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4041 lam = 1.0_wp
4042# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4043 eps = 1.0e-6_wp
4044# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4045 ei = 5.0_wp
4046# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4047 ! Smoothening function to smooth out sharp discontinuity in the interface
4048# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4049 if (x_cc(i) <= 0.7_wp*lam) then
4050# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4051 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
4052# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4053 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
4054# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4055 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
4056# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4057 alpha_sf6 = 1.0_wp - alpha_air
4058# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4059 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
4060# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4061 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
4062# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4063 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
4064# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4065 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
4066# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4067 end if
4068# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4069
4070# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4071 case (250) ! MHD Orszag-Tang vortex
4072# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4073 ! gamma = 5/3
4074# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4075 ! rho = 25/(36*pi)
4076# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4077 ! p = 5/(12*pi)
4078# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4079 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
4080# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4081 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
4082# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4083
4084# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4085 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
4086# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4087 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
4088# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4089
4090# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4091 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
4092# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4093 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
4094# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4095
4096# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4097 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
4098# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4099 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
4100# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4101 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
4102# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4103 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
4104# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4105 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
4106# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4107 ! Linear interpolation between r=0.08 and r=1.0
4108# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4109 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
4110# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4111 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
4112# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4113 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
4114# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4115 else
4116# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4117 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
4118# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4119 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
4120# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4121 end if
4122# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4123
4124# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4125 ! case 252 is for the 2D MHD Rotor problem
4126# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4127 case (252) ! 2D MHD Rotor Problem
4128# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4129 ! Ambient conditions are set in the JSON file.
4130# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4131 ! This case imposes the dense, rotating cylinder.
4132# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4133 !
4134# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4135 ! gamma = 1.4
4136# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4137 ! Ambient medium (r > 0.1):
4138# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4139 ! rho = 1, p = 1, v = 0, B = (1,0,0)
4140# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4141 ! Rotor (r <= 0.1):
4142# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4143 ! rho = 10, p = 1
4144# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4145 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
4146# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4147
4148# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4149 ! Calculate distance squared from the center
4150# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4151 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
4152# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4153
4154# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4155 ! inner radius of 0.1
4156# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4157 if (r_sq <= 0.1**2) then
4158# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4159 ! -- Inside the rotor --
4160# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4161 ! Set density uniformly to 10
4162# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4163 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
4164# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4165
4166# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4167 ! Set vup constant rotation of rate v=2
4168# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4169 ! v_x = -omega * (y - y_c)
4170# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4171 ! v_y = omega * (x - x_c)
4172# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4173 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
4174# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4175 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
4176# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4177
4178# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4179 ! taper width of 0.015
4180# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4181 else if (r_sq <= 0.115**2) then
4182# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4183 ! linearly smooth the function between r = 0.1 and 0.115
4184# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4185 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
4186# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4187
4188# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4189 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)
4190# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4191 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)
4192# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4193 end if
4194# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4195
4196# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4197 case (253) ! MHD Smooth Magnetic Vortex
4198# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4199 ! Section 5.2 of
4200# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4201 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
4202# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4203 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
4204# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4205
4206# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4207 ! velocity
4208# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4209 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))
4210# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4211 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))
4212# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4213
4214# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4215 ! magnetic field
4216# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4217 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)
4218# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4219 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)
4220# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4221
4222# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4223 ! pressure
4224# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4225 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)
4226# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4227
4228# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4229 case (260) ! Gaussian Divergence Pulse
4230# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4231 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
4232# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4233 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
4234# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4235 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
4236# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4237 ! ψ is initialized to zero everywhere.
4238# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4239
4240# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4241 eps_mhd = patch_icpp(patch_id)%a(2)
4242# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4243 sigma = patch_icpp(patch_id)%a(3)
4244# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4245 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
4246# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4247
4248# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4249 ! B-field
4250# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4251 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
4252# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4253
4254# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4255 case (261) ! Blob
4256# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4257 r0 = 1._wp/sqrt(8._wp)
4258# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4259 r2 = x_cc(i)**2 + y_cc(j)**2
4260# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4261 r = sqrt(r2)
4262# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4263 alpha = r/r0
4264# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4265 if (alpha < 1) then
4266# 470 "/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/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
4268# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4269 ! 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)
4270# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4271 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
4272# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4273 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
4274# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4275 end if
4276# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4277
4278# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4279 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
4280# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4281 ! rotate by α = atan(2)
4282# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4283 alpha = atan(2._wp)
4284# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4285 cosa = cos(alpha)
4286# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4287 sina = sin(alpha)
4288# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4289 ! projection along shock normal
4290# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4291 r = x_cc(i)*cosa + y_cc(j)*sina
4292# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4293
4294# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4295 if (r <= 0.5_wp) then
4296# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4297 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
4298# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4299 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
4300# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4301 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
4302# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4303 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
4304# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4305 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
4306# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4307 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
4308# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4309 - (5._wp/sqrt(4._wp*pi))*sina
4310# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4311 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
4312# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4313 + (5._wp/sqrt(4._wp*pi))*cosa
4314# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4315 else
4316# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4317 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
4318# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4319 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
4320# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4321 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
4322# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4323 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
4324# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4325 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
4326# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4327 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
4328# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4329 - (5._wp/sqrt(4._wp*pi))*sina
4330# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4331 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
4332# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4333 + (5._wp/sqrt(4._wp*pi))*cosa
4334# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4335 end if
4336# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4337 ! v^z and B^z remain zero by default
4338# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4339
4340# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4341 case (270)
4342# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4343 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
4344# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4345
4346# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4347 if (.not. files_loaded) then
4348# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4349 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
4350# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4351 do f = 1, max_files
4352# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4353 write (file_num_str, '(I0)') f
4354# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4355 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
4356# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4357 end do
4358# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4359
4360# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4361 ! Common file reading setup
4362# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4363 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4364# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4365 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
4366# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4367
4368# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4369 select case (num_dims)
4370# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4371 case (1, 2) ! 1D and 2D cases are similar
4372# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4373 ! Count lines
4374# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4375 line_count = 0
4376# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4377 do
4378# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4379 read (unit2, *, iostat=ios2) dummy_x, dummy_y
4380# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4381 if (ios2 /= 0) exit
4382# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4383 line_count = line_count + 1
4384# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4385 end do
4386# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4387 close (unit2)
4388# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4389
4390# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4391 xrows = line_count
4392# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4393 yrows = 1
4394# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4395 index_x = 0
4396# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4397 if (num_dims == 2) index_x = i
4398# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4399#ifdef MFC_DEBUG
4400# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4401 block
4402# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4403 use iso_fortran_env, only: output_unit
4404# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4405
4406# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4407 print *, 'm_icpp_patches.fpp:470: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
4408# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4409
4410# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4411 call flush (output_unit)
4412# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4413 end block
4414# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4415#endif
4416# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4417 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
4418# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4419
4420# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4421
4422# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4423
4424# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4425#if defined(MFC_OpenACC)
4426# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4427!$acc enter data create(x_coords, stored_values)
4428# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4429#elif defined(MFC_OpenMP)
4430# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4431!$omp target enter data map(always,alloc:x_coords, stored_values)
4432# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4433#endif
4434# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4435
4436# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4437 ! Read data from all files
4438# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4439 do f = 1, max_files
4440# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4441 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4442# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4443 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
4444# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4445
4446# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4447 do iter = 1, xrows
4448# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4449 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
4450# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4451 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
4452# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4453 end do
4454# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4455 close (unit)
4456# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4457 end do
4458# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4459
4460# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4461 ! Calculate offsets
4462# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4463 domain_xstart = x_coords(1)
4464# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4465 x_step = x_cc(1) - x_cc(0)
4466# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4467 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
4468# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4469 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
4470# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4471 global_offset_x = nint(abs(delta_x)/x_step)
4472# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4473
4474# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4475 case (3) ! 3D case - determine grid structure
4476# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4477 ! Find yRows by counting rows with same x
4478# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4479 read (unit2, *, iostat=ios2) x0, y0, dummy_z
4480# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4481 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
4482# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4483
4484# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4485 yrows = 1
4486# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4487 do
4488# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4489 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4490# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4491 if (ios2 /= 0) exit
4492# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4493 if (dummy_x == x0 .and. dummy_y /= y0) then
4494# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4495 yrows = yrows + 1
4496# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4497 else
4498# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4499 exit
4500# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4501 end if
4502# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4503 end do
4504# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4505 close (unit2)
4506# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4507
4508# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4509 ! Count total rows
4510# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4511 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
4512# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4513 nrows = 0
4514# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4515 do
4516# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4517 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
4518# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4519 if (ios2 /= 0) exit
4520# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4521 nrows = nrows + 1
4522# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4523 end do
4524# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4525 close (unit2)
4526# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4527
4528# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4529 xrows = nrows/yrows
4530# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4531#ifdef MFC_DEBUG
4532# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4533 block
4534# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4535 use iso_fortran_env, only: output_unit
4536# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4537
4538# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4539 print *, 'm_icpp_patches.fpp:470: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
4540# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4541
4542# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4543 call flush (output_unit)
4544# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4545 end block
4546# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4547#endif
4548# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4549 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
4550# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4551
4552# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4553
4554# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4555
4556# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4557
4558# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4559#if defined(MFC_OpenACC)
4560# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4561!$acc enter data create(x_coords, y_coords, stored_values)
4562# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4563#elif defined(MFC_OpenMP)
4564# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4565!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
4566# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4567#endif
4568# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4569 index_x = i
4570# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4571 index_y = j
4572# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4573
4574# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4575 ! Read all files
4576# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4577 do f = 1, max_files
4578# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4579 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
4580# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4581 if (ios /= 0) then
4582# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4583 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
4584# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4585 cycle
4586# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4587 end if
4588# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4589
4590# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4591 iter = 0
4592# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4593 do iix = 1, xrows
4594# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4595 do iiy = 1, yrows
4596# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4597 iter = iter + 1
4598# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4599 if (f == 1) then
4600# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4601 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
4602# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4603 else
4604# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4605 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
4606# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4607 end if
4608# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4609 if (ios /= 0) call s_mpi_abort("Error reading data")
4610# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4611 end do
4612# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4613 end do
4614# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4615 close (unit)
4616# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4617 end do
4618# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4619
4620# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4621 ! Calculate offsets
4622# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4623 x_step = x_cc(1) - x_cc(0)
4624# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4625 y_step = y_cc(1) - y_cc(0)
4626# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4627 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
4628# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4629 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
4630# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4631 global_offset_x = nint(abs(delta_x)/x_step)
4632# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4633 global_offset_y = nint(abs(delta_y)/y_step)
4634# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4635 end select
4636# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4637
4638# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4639 files_loaded = .true.
4640# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4641 end if
4642# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4643
4644# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4645 ! Data assignment
4646# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4647 select case (num_dims)
4648# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4649 case (1)
4650# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4651 idx = i + 1 + global_offset_x
4652# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4653 do f = 1, sys_size
4654# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4655 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
4656# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4657 end do
4658# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4659
4660# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4661 case (2)
4662# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4663 idx = i + 1 + global_offset_x - index_x
4664# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4665 do f = 1, sys_size - 1
4666# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4667 jump = merge(1, 0, f >= momxe)
4668# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4669 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
4670# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4671 end do
4672# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4673 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
4674# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4675
4676# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4677 case (3)
4678# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4679 idx = i + 1 + global_offset_x - index_x
4680# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4681 idy = j + 1 + global_offset_y - index_y
4682# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4683 do f = 1, sys_size - 1
4684# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4685 jump = merge(1, 0, f >= momxe)
4686# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4687 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
4688# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4689 end do
4690# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4691 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
4692# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4693 end select
4694# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4695
4696# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4697 case (280)
4698# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4699 ! This is patch is hard-coded for test suite optimization used in the
4700# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4701 ! 2D_isentropicvortex case:
4702# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4703 ! This analytic patch uses geometry 2
4704# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4705 if (patch_id == 1) then
4706# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4707 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)
4708# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4709 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
4710# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4711 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))
4712# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4713 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))
4714# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4715 end if
4716# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4717
4718# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4719 case (281)
4720# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4721 ! This is patch is hard-coded for test suite optimization used in the
4722# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4723 ! 2D_acoustic_pulse case:
4724# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4725 ! This analytic patch uses geometry 2
4726# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4727 if (patch_id == 2) then
4728# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4729 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))
4730# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4731 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))
4732# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4733 end if
4734# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4735
4736# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4737 case (282)
4738# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4739 ! This is patch is hard-coded for test suite optimization used in the
4740# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4741 ! 2D_zero_circ_vortex case:
4742# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4743 ! This analytic patch uses geometry 2
4744# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4745 if (patch_id == 2) then
4746# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4747 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))
4748# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4749 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))
4750# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4751 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)))
4752# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4753 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)))
4754# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4755 end if
4756# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4757
4758# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4759 case default
4760# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4761 if (proc_rank == 0) then
4762# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4763 call s_int_to_str(patch_id, istr)
4764# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4765 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
4766# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4767 end if
4768# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4769
4770# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4771 end select
4772# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4773
4774 end if
4775
4776 ! Updating the patch identities bookkeeping variable
4777 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
4778
4779 q_prim_vf(alf_idx)%sf(i, j, 0) = patch_icpp(patch_id)%alpha(1)* &
4780 exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
4781 end if
4782
4783 end do
4784 end do
4785 if (allocated(stored_values)) then
4786# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4787#ifdef MFC_DEBUG
4788# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4789 block
4790# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4791 use iso_fortran_env, only: output_unit
4792# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4793
4794# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4795 print *, 'm_icpp_patches.fpp:482: ', '@:DEALLOCATE(stored_values)'
4796# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4797
4798# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4799 call flush (output_unit)
4800# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4801 end block
4802# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4803#endif
4804# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4805
4806# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4807#if defined(MFC_OpenACC)
4808# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4809!$acc exit data delete(stored_values)
4810# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4811#elif defined(MFC_OpenMP)
4812# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4813!$omp target exit data map(release:stored_values)
4814# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4815#endif
4816# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4817 deallocate (stored_values)
4818# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4819#ifdef MFC_DEBUG
4820# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4821 block
4822# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4823 use iso_fortran_env, only: output_unit
4824# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4825
4826# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4827 print *, 'm_icpp_patches.fpp:482: ', '@:DEALLOCATE(x_coords)'
4828# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4829
4830# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4831 call flush (output_unit)
4832# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4833 end block
4834# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4835#endif
4836# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4837
4838# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4839#if defined(MFC_OpenACC)
4840# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4841!$acc exit data delete(x_coords)
4842# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4843#elif defined(MFC_OpenMP)
4844# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4845!$omp target exit data map(release:x_coords)
4846# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4847#endif
4848# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4849 deallocate (x_coords)
4850# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4851 end if
4852# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4853
4854# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4855 if (allocated(y_coords)) then
4856# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4857#ifdef MFC_DEBUG
4858# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4859 block
4860# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4861 use iso_fortran_env, only: output_unit
4862# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4863
4864# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4865 print *, 'm_icpp_patches.fpp:482: ', '@:DEALLOCATE(y_coords)'
4866# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4867
4868# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4869 call flush (output_unit)
4870# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4871 end block
4872# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4873#endif
4874# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4875
4876# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4877#if defined(MFC_OpenACC)
4878# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4879!$acc exit data delete(y_coords)
4880# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4881#elif defined(MFC_OpenMP)
4882# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4883!$omp target exit data map(release:y_coords)
4884# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4885#endif
4886# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4887 deallocate (y_coords)
4888# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4889 end if
4890
4891 end subroutine s_icpp_varcircle
4892
4893 !> @brief Initializes a 3D variable-thickness circular annulus patch extruded along the z-axis.
4894 !! @param patch_id is the patch identifier
4895 !! @param patch_id_fp Array to track patch ids
4896 !! @param q_prim_vf Array of primitive variables
4897 subroutine s_icpp_3dvarcircle(patch_id, patch_id_fp, q_prim_vf)
4898
4899 ! Patch identifier
4900 integer, intent(in) :: patch_id
4901#ifdef MFC_MIXED_PRECISION
4902 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
4903#else
4904 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
4905#endif
4906 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
4907
4908 ! Generic loop iterators
4909 integer :: i, j, k
4910 real(wp) :: radius, myr, thickness
4911 integer :: xRows, yRows, nRows, iix, iiy, max_files
4912# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4913 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
4914# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4915 real(wp) :: x_len, x_step, y_len, y_step
4916# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4917 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
4918# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4919 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
4920# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4921 real(wp) :: delta_x, delta_y
4922# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4923 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
4924# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4925 character(len=200) :: errmsg
4926# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4927 real(wp), allocatable :: stored_values(:, :, :)
4928# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4929 real(wp), allocatable :: x_coords(:), y_coords(:)
4930# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4931 logical :: files_loaded = .false.
4932# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4933 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
4934# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4935 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
4936# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4937 character(len=20) :: file_num_str ! For storing the file number as a string
4938# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4939 character(len=20) :: zeros_part ! For the trailing zeros part
4940# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4941 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
4942 ! Place any declaration of intermediate variables here
4943# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4944 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
4945# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4946 real(wp) :: eps
4947# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4948
4949# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4950 ! IGR Jets
4951# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4952 ! Arrays to stor position and radii of jets from input file
4953# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4954 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
4955# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4956 ! Variables to describe initial condition of jet
4957# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4958 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
4959# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4960 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
4961# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4962
4963# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4964 real(wp), dimension(0:n, 0:p) :: rcut_arr
4965# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4966 integer :: l, q, s ! Iterators for reading input files
4967# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4968 integer :: start, end ! Ints to keep track of position in file
4969# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4970 character(len=1000) :: line ! String to store line in ile
4971# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4972 character(len=25) :: value ! String to store value in line
4973# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4974 integer :: NJet ! Number of jets
4975# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4976
4977# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4978 eps = 1e-9_wp
4979# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4980
4981# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4982 if (patch_icpp(patch_id)%hcid == 303) then
4983# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4984 eps_smooth = 3._wp
4985# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4986 open (unit=10, file="njet.txt", status="old", action="read")
4987# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4988 read (10, *) njet
4989# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4990 close (10)
4991# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4992
4993# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4994 allocate (y_th_arr(0:njet - 1))
4995# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4996 allocate (z_th_arr(0:njet - 1))
4997# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
4998 allocate (r_th_arr(0:njet - 1))
4999# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5000
5001# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5002 open (unit=10, file="jets.csv", status="old", action="read")
5003# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5004 do q = 0, njet - 1
5005# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5006 read (10, '(A)') line ! Read a full line as a string
5007# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5008 start = 1
5009# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5010
5011# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5012 do l = 0, 2
5013# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5014 end = index(line(start:), ',') ! Find the next comma
5015# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5016 if (end == 0) then
5017# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5018 value = trim(adjustl(line(start:))) ! Last value in the line
5019# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5020 else
5021# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5022 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
5023# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5024 start = start + end ! Move to next value
5025# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5026 end if
5027# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5028 if (l == 0) then
5029# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5030 read (value, *) y_th_arr(q) ! Convert string to numeric value
5031# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5032 elseif (l == 1) then
5033# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5034 read (value, *) z_th_arr(q)
5035# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5036 else
5037# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5038 read (value, *) r_th_arr(q)
5039# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5040 end if
5041# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5042 end do
5043# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5044 end do
5045# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5046 close (10)
5047# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5048
5049# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5050 do q = 0, p
5051# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5052 do l = 0, n
5053# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5054 rcut = 0._wp
5055# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5056 do s = 0, njet - 1
5057# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5058 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
5059# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5060 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
5061# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5062 end do
5063# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5064 rcut_arr(l, q) = rcut
5065# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5066 end do
5067# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5068 end do
5069# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5070 end if
5071# 505 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5072
5073
5074 ! Transferring the circular patch's radius, centroid, smearing patch
5075 ! identity and smearing coefficient information
5076 x_centroid = patch_icpp(patch_id)%x_centroid
5077 y_centroid = patch_icpp(patch_id)%y_centroid
5078 z_centroid = patch_icpp(patch_id)%z_centroid
5079 length_z = patch_icpp(patch_id)%length_z
5080 radius = patch_icpp(patch_id)%radius
5081 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
5082 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
5083 thickness = patch_icpp(patch_id)%epsilon
5084
5085 ! Initializing the pseudo volume fraction value to 1. The value will
5086 ! be modified as the patch is laid out on the grid, but only in the
5087 ! case that smoothing of the circular patch's boundary is enabled.
5088 eta = 1._wp
5089
5090 ! write for all z
5091
5092 ! Checking whether the circle covers a particular cell in the domain
5093 ! and verifying whether the current patch has permission to write to
5094 ! that cell. If both queries check out, the primitive variables of
5095 ! the current patch are assigned to this cell.
5096 do k = 0, p
5097 do j = 0, n
5098 do i = 0, m
5099 myr = sqrt((x_cc(i) - x_centroid)**2 &
5100 + (y_cc(j) - y_centroid)**2)
5101
5102 if (myr <= radius + thickness/2._wp .and. &
5103 myr >= radius - thickness/2._wp .and. &
5104 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
5105
5106 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
5107 eta, q_prim_vf, patch_id_fp)
5108
5109
5110 if (patch_icpp(patch_id)%hcid /= dflt_int) then
5111
5112# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5113 select case (patch_icpp(patch_id)%hcid)
5114# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5115 case (300) ! Rayleigh-Taylor instability
5116# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5117 rhoh = 3._wp
5118# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5119 rhol = 1._wp
5120# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5121 pref = 1.e5_wp
5122# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5123 pint = pref
5124# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5125 h = 0.7_wp
5126# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5127 lam = 0.2_wp
5128# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5129 wl = 2._wp*pi/lam
5130# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5131 amp = 0.025_wp/wl
5132# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5133
5134# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5135 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
5136# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5137
5138# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5139 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
5140# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5141
5142# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5143 if (alph < eps) alph = eps
5144# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5145 if (alph > 1._wp - eps) alph = 1._wp - eps
5146# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5147
5148# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5149 if (y_cc(j) > inth) then
5150# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5151 q_prim_vf(advxb)%sf(i, j, k) = alph
5152# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5153 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
5154# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5155 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
5156# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5157 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
5158# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5159 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
5160# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5161 else
5162# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5163 q_prim_vf(advxb)%sf(i, j, k) = alph
5164# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5165 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
5166# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5167 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
5168# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5169 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
5170# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5171 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
5172# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5173 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
5174# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5175 end if
5176# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5177
5178# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5179 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
5180# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5181 h = 0.0_wp
5182# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5183 lam = 1.0_wp
5184# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5185 amp = patch_icpp(patch_id)%a(2)
5186# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5187 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
5188# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5189 if (x_cc(i) > inth) then
5190# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5191 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
5192# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5193 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
5194# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5195 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
5196# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5197 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
5198# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5199 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
5200# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5201 end if
5202# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5203
5204# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5205 case (302) ! 3D Jet with IGR
5206# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5207 ux_th = 10*sqrt(1.4*0.4)
5208# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5209 ux_am = 0.0*sqrt(1.4)
5210# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5211 p_th = 2.0_wp
5212# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5213 p_am = 1.0_wp
5214# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5215 rho_th = 1._wp
5216# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5217 rho_am = 1._wp
5218# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5219 y_th = 0.0_wp
5220# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5221 z_th = 0.0_wp
5222# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5223 r_th = 1._wp
5224# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5225 eps_smooth = 1._wp
5226# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5227 eps = 1e-6
5228# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5229
5230# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5231 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
5232# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5233 rcut = f_cut_on(r - r_th, eps_smooth)
5234# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5235 xcut = f_cut_on(x_cc(i), eps_smooth)
5236# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5237
5238# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5239 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5240# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5241 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
5242# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5243 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
5244# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5245
5246# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5247 if (num_fluids == 1) then
5248# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5249 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5250# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5251 else
5252# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5253 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5254# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5255 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
5256# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5257 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
5258# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5259 end if
5260# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5261
5262# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5263 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
5264# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5265
5266# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5267 case (303) ! 3D Multijet
5268# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5269
5270# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5271 eps_smooth = 3.0_wp
5272# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5273 ux_th = 10*sqrt(1.4*0.4)
5274# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5275 ux_am = 2.5*sqrt(1.4*0.4)
5276# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5277 p_th = 0.8_wp
5278# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5279 p_am = 0.4_wp
5280# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5281 rho_th = 1._wp
5282# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5283 rho_am = 1._wp
5284# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5285 eps = 1e-6
5286# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5287
5288# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5289 rcut = rcut_arr(j, k)
5290# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5291 xcut = f_cut_on(x_cc(i), eps_smooth)
5292# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5293
5294# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5295 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
5296# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5297 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
5298# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5299 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
5300# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5301
5302# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5303 if (num_fluids == 1) then
5304# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5305 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
5306# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5307 else
5308# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5309 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
5310# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5311 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
5312# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5313 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
5314# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5315 end if
5316# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5317
5318# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5319 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
5320# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5321
5322# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5323 case (370)
5324# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5325 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
5326# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5327
5328# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5329 if (.not. files_loaded) then
5330# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5331 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
5332# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5333 do f = 1, max_files
5334# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5335 write (file_num_str, '(I0)') f
5336# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5337 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
5338# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5339 end do
5340# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5341
5342# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5343 ! Common file reading setup
5344# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5345 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5346# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5347 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
5348# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5349
5350# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5351 select case (num_dims)
5352# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5353 case (1, 2) ! 1D and 2D cases are similar
5354# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5355 ! Count lines
5356# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5357 line_count = 0
5358# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5359 do
5360# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5361 read (unit2, *, iostat=ios2) dummy_x, dummy_y
5362# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5363 if (ios2 /= 0) exit
5364# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5365 line_count = line_count + 1
5366# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5367 end do
5368# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5369 close (unit2)
5370# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5371
5372# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5373 xrows = line_count
5374# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5375 yrows = 1
5376# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5377 index_x = 0
5378# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5379 if (num_dims == 2) index_x = i
5380# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5381#ifdef MFC_DEBUG
5382# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5383 block
5384# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5385 use iso_fortran_env, only: output_unit
5386# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5387
5388# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5389 print *, 'm_icpp_patches.fpp:544: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
5390# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5391
5392# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5393 call flush (output_unit)
5394# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5395 end block
5396# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5397#endif
5398# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5399 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
5400# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5401
5402# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5403
5404# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5405
5406# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5407#if defined(MFC_OpenACC)
5408# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5409!$acc enter data create(x_coords, stored_values)
5410# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5411#elif defined(MFC_OpenMP)
5412# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5413!$omp target enter data map(always,alloc:x_coords, stored_values)
5414# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5415#endif
5416# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5417
5418# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5419 ! Read data from all files
5420# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5421 do f = 1, max_files
5422# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5423 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5424# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5425 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
5426# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5427
5428# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5429 do iter = 1, xrows
5430# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5431 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
5432# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5433 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
5434# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5435 end do
5436# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5437 close (unit)
5438# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5439 end do
5440# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5441
5442# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5443 ! Calculate offsets
5444# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5445 domain_xstart = x_coords(1)
5446# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5447 x_step = x_cc(1) - x_cc(0)
5448# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5449 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
5450# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5451 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
5452# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5453 global_offset_x = nint(abs(delta_x)/x_step)
5454# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5455
5456# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5457 case (3) ! 3D case - determine grid structure
5458# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5459 ! Find yRows by counting rows with same x
5460# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5461 read (unit2, *, iostat=ios2) x0, y0, dummy_z
5462# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5463 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
5464# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5465
5466# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5467 yrows = 1
5468# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5469 do
5470# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5471 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5472# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5473 if (ios2 /= 0) exit
5474# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5475 if (dummy_x == x0 .and. dummy_y /= y0) then
5476# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5477 yrows = yrows + 1
5478# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5479 else
5480# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5481 exit
5482# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5483 end if
5484# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5485 end do
5486# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5487 close (unit2)
5488# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5489
5490# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5491 ! Count total rows
5492# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5493 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
5494# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5495 nrows = 0
5496# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5497 do
5498# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5499 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
5500# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5501 if (ios2 /= 0) exit
5502# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5503 nrows = nrows + 1
5504# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5505 end do
5506# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5507 close (unit2)
5508# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5509
5510# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5511 xrows = nrows/yrows
5512# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5513#ifdef MFC_DEBUG
5514# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5515 block
5516# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5517 use iso_fortran_env, only: output_unit
5518# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5519
5520# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5521 print *, 'm_icpp_patches.fpp:544: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
5522# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5523
5524# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5525 call flush (output_unit)
5526# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5527 end block
5528# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5529#endif
5530# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5531 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
5532# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5533
5534# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5535
5536# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5537
5538# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5539
5540# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5541#if defined(MFC_OpenACC)
5542# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5543!$acc enter data create(x_coords, y_coords, stored_values)
5544# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5545#elif defined(MFC_OpenMP)
5546# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5547!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
5548# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5549#endif
5550# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5551 index_x = i
5552# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5553 index_y = j
5554# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5555
5556# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5557 ! Read all files
5558# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5559 do f = 1, max_files
5560# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5561 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
5562# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5563 if (ios /= 0) then
5564# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5565 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
5566# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5567 cycle
5568# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5569 end if
5570# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5571
5572# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5573 iter = 0
5574# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5575 do iix = 1, xrows
5576# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5577 do iiy = 1, yrows
5578# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5579 iter = iter + 1
5580# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5581 if (f == 1) then
5582# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5583 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
5584# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5585 else
5586# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5587 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
5588# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5589 end if
5590# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5591 if (ios /= 0) call s_mpi_abort("Error reading data")
5592# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5593 end do
5594# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5595 end do
5596# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5597 close (unit)
5598# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5599 end do
5600# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5601
5602# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5603 ! Calculate offsets
5604# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5605 x_step = x_cc(1) - x_cc(0)
5606# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5607 y_step = y_cc(1) - y_cc(0)
5608# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5609 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
5610# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5611 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
5612# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5613 global_offset_x = nint(abs(delta_x)/x_step)
5614# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5615 global_offset_y = nint(abs(delta_y)/y_step)
5616# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5617 end select
5618# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5619
5620# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5621 files_loaded = .true.
5622# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5623 end if
5624# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5625
5626# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5627 ! Data assignment
5628# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5629 select case (num_dims)
5630# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5631 case (1)
5632# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5633 idx = i + 1 + global_offset_x
5634# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5635 do f = 1, sys_size
5636# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5637 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
5638# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5639 end do
5640# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5641
5642# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5643 case (2)
5644# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5645 idx = i + 1 + global_offset_x - index_x
5646# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5647 do f = 1, sys_size - 1
5648# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5649 jump = merge(1, 0, f >= momxe)
5650# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5651 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
5652# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5653 end do
5654# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5655 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
5656# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5657
5658# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5659 case (3)
5660# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5661 idx = i + 1 + global_offset_x - index_x
5662# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5663 idy = j + 1 + global_offset_y - index_y
5664# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5665 do f = 1, sys_size - 1
5666# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5667 jump = merge(1, 0, f >= momxe)
5668# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5669 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
5670# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5671 end do
5672# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5673 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
5674# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5675 end select
5676# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5677
5678# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5679 case (380)
5680# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5681 ! This is patch is hard-coded for test suite optimization used in the
5682# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5683 ! 3D_TaylorGreenVortex case:
5684# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5685 ! This analytic patch used geometry 9
5686# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5687 mach = 0.1
5688# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5689 if (patch_id == 1) then
5690# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5691 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)
5692# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5693 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)
5694# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5695 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)
5696# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5697 end if
5698# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5699
5700# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5701 case default
5702# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5703 call s_int_to_str(patch_id, istr)
5704# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5705 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
5706# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5707 end select
5708# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5709
5710 end if
5711
5712 ! Updating the patch identities bookkeeping variable
5713 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
5714
5715 q_prim_vf(alf_idx)%sf(i, j, k) = patch_icpp(patch_id)%alpha(1)* &
5716 exp(-0.5_wp*((myr - radius)**2._wp)/(thickness/3._wp)**2._wp)
5717 end if
5718
5719 end do
5720 end do
5721 end do
5722 if (allocated(stored_values)) then
5723# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5724#ifdef MFC_DEBUG
5725# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5726 block
5727# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5728 use iso_fortran_env, only: output_unit
5729# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5730
5731# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5732 print *, 'm_icpp_patches.fpp:557: ', '@:DEALLOCATE(stored_values)'
5733# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5734
5735# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5736 call flush (output_unit)
5737# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5738 end block
5739# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5740#endif
5741# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5742
5743# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5744#if defined(MFC_OpenACC)
5745# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5746!$acc exit data delete(stored_values)
5747# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5748#elif defined(MFC_OpenMP)
5749# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5750!$omp target exit data map(release:stored_values)
5751# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5752#endif
5753# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5754 deallocate (stored_values)
5755# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5756#ifdef MFC_DEBUG
5757# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5758 block
5759# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5760 use iso_fortran_env, only: output_unit
5761# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5762
5763# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5764 print *, 'm_icpp_patches.fpp:557: ', '@:DEALLOCATE(x_coords)'
5765# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5766
5767# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5768 call flush (output_unit)
5769# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5770 end block
5771# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5772#endif
5773# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5774
5775# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5776#if defined(MFC_OpenACC)
5777# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5778!$acc exit data delete(x_coords)
5779# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5780#elif defined(MFC_OpenMP)
5781# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5782!$omp target exit data map(release:x_coords)
5783# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5784#endif
5785# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5786 deallocate (x_coords)
5787# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5788 end if
5789# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5790
5791# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5792 if (allocated(y_coords)) then
5793# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5794#ifdef MFC_DEBUG
5795# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5796 block
5797# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5798 use iso_fortran_env, only: output_unit
5799# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5800
5801# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5802 print *, 'm_icpp_patches.fpp:557: ', '@:DEALLOCATE(y_coords)'
5803# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5804
5805# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5806 call flush (output_unit)
5807# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5808 end block
5809# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5810#endif
5811# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5812
5813# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5814#if defined(MFC_OpenACC)
5815# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5816!$acc exit data delete(y_coords)
5817# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5818#elif defined(MFC_OpenMP)
5819# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5820!$omp target exit data map(release:y_coords)
5821# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5822#endif
5823# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5824 deallocate (y_coords)
5825# 557 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5826 end if
5827
5828 end subroutine s_icpp_3dvarcircle
5829
5830 !> The elliptical patch is a 2D geometry. The geometry of
5831 !! the patch is well-defined when its centroid and radii
5832 !! are provided. Note that the elliptical patch DOES allow
5833 !! for the smoothing of its boundary
5834 !! @param patch_id is the patch identifier
5835 !! @param patch_id_fp Array to track patch ids
5836 !! @param q_prim_vf Array of primitive variables
5837 subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
5838
5839 integer, intent(in) :: patch_id
5840#ifdef MFC_MIXED_PRECISION
5841 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
5842#else
5843 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
5844#endif
5845 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
5846
5847 integer :: i, j, k !< Generic loop operators
5848 real(wp) :: a, b
5849 integer :: xRows, yRows, nRows, iix, iiy, max_files
5850# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5851 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
5852# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5853 real(wp) :: x_len, x_step, y_len, y_step
5854# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5855 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
5856# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5857 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
5858# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5859 real(wp) :: delta_x, delta_y
5860# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5861 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
5862# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5863 character(len=200) :: errmsg
5864# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5865 real(wp), allocatable :: stored_values(:, :, :)
5866# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5867 real(wp), allocatable :: x_coords(:), y_coords(:)
5868# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5869 logical :: files_loaded = .false.
5870# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5871 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
5872# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5873 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
5874# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5875 character(len=20) :: file_num_str ! For storing the file number as a string
5876# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5877 character(len=20) :: zeros_part ! For the trailing zeros part
5878# 580 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5879 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
5880 ! Place any declaration of intermediate variables here
5881# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5882 real(wp) :: eps, eps_mhd, C_mhd
5883# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5884 real(wp) :: r, rmax, gam, umax, p0
5885# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5886 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
5887# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5888 real(wp) :: factor
5889# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5890 real(wp) :: r0, alpha, r2
5891# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5892 real(wp) :: sinA, cosA
5893# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5894
5895# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5896 real(wp) :: r_sq
5897# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5898
5899# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5900 ! # 207
5901# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5902 real(wp) :: sigma, gauss1, gauss2
5903# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5904 ! # 208
5905# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5906 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
5907# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5908
5909# 581 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5910 eps = 1.e-9_wp
5911
5912 ! Transferring the elliptical patch's radii, centroid, smearing
5913 ! patch identity, and smearing coefficient information
5914 x_centroid = patch_icpp(patch_id)%x_centroid
5915 y_centroid = patch_icpp(patch_id)%y_centroid
5916 a = patch_icpp(patch_id)%radii(1)
5917 b = patch_icpp(patch_id)%radii(2)
5918 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
5919 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
5920
5921 ! Initializing the pseudo volume fraction value to 1. The value
5922 ! be modified as the patch is laid out on the grid, but only in
5923 ! the case that smoothing of the elliptical patch's boundary is
5924 ! enabled.
5925 eta = 1._wp
5926
5927 ! Checking whether the ellipse covers a particular cell in the
5928 ! domain and verifying whether the current patch has permission
5929 ! to write to that cell. If both queries check out, the primitive
5930 ! variables of the current patch are assigned to this cell.
5931 do j = 0, n
5932 do i = 0, m
5933
5934 if (patch_icpp(patch_id)%smoothen) then
5935 eta = tanh(smooth_coeff/min(dx, dy)* &
5936 (sqrt(((x_cc(i) - x_centroid)/a)**2 + &
5937 ((y_cc(j) - y_centroid)/b)**2) &
5938 - 1._wp))*(-0.5_wp) + 0.5_wp
5939 end if
5940
5941 if ((((x_cc(i) - x_centroid)/a)**2 + &
5942 ((y_cc(j) - y_centroid)/b)**2 <= 1._wp &
5943 .and. &
5944 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
5945 .or. &
5946 patch_id_fp(i, j, 0) == smooth_patch_id) &
5947 then
5948
5949 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
5950 eta, q_prim_vf, patch_id_fp)
5951
5952
5953 if (patch_icpp(patch_id)%hcid /= dflt_int) then
5954
5955# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5956 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
5957# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5958
5959# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5960 case (200)
5961# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5962 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
5963# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5964 ! Volume Fractions
5965# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5966 q_prim_vf(advxb)%sf(i, j, 0) = eps
5967# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5968 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
5969# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5970 ! Denssities
5971# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5972 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
5973# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5974 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
5975# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5976 ! Pressure
5977# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5978 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
5979# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5980 end if
5981# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5982 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
5983# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5984 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
5985# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5986 rmax = 0.2_wp
5987# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5988
5989# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5990 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
5991# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5992 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
5993# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5994 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
5995# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5996
5997# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
5998 if (r < rmax) then
5999# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6000 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6001# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6002 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6003# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6004 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6005# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6006 else if (r < 2*rmax) then
6007# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6008 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6009# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6010 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6011# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6012 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
6013# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6014 else
6015# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6016 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
6017# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6018 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
6019# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6020 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
6021# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6022 end if
6023# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6024 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
6025# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6026 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
6027# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6028 rmax = 0.2_wp
6029# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6030
6031# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6032 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
6033# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6034 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
6035# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6036 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
6037# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6038
6039# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6040 if (r < rmax) then
6041# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6042 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
6043# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6044 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
6045# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6046 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
6047# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6048 else if (r < 2*rmax) then
6049# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6050 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6051# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6052 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
6053# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6054 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)))
6055# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6056 else
6057# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6058 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
6059# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6060 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
6061# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6062 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
6063# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6064 end if
6065# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6066
6067# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6068 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
6069# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6070 case (204) ! Rayleigh-Taylor instability
6071# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6072 rhoh = 3._wp
6073# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6074 rhol = 1._wp
6075# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6076 pref = 1.e5_wp
6077# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6078 pint = pref
6079# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6080 h = 0.7_wp
6081# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6082 lam = 0.2_wp
6083# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6084 wl = 2._wp*pi/lam
6085# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6086 amp = 0.05_wp/wl
6087# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6088
6089# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6090 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
6091# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6092
6093# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6094 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
6095# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6096
6097# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6098 if (alph < eps) alph = eps
6099# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6100 if (alph > 1._wp - eps) alph = 1._wp - eps
6101# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6102
6103# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6104 if (y_cc(j) > inth) then
6105# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6106 q_prim_vf(advxb)%sf(i, j, 0) = alph
6107# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6108 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
6109# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6110 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
6111# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6112 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
6113# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6114 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
6115# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6116 else
6117# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6118 q_prim_vf(advxb)%sf(i, j, 0) = alph
6119# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6120 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
6121# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6122 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
6123# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6124 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
6125# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6126 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
6127# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6128 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
6129# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6130 end if
6131# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6132
6133# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6134 case (205) ! 2D lung wave interaction problem
6135# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6136 h = 0.0_wp !non dim origin y
6137# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6138 lam = 1.0_wp !non dim lambda
6139# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6140 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
6141# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6142
6143# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6144 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
6145# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6146
6147# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6148 if (y_cc(j) > inth) then
6149# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6150 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6151# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6152 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6153# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6154 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
6155# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6156 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6157# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6158 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6159# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6160 end if
6161# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6162
6163# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6164 case (206) ! 2D lung wave interaction problem - horizontal domain
6165# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6166 h = 0.0_wp !non dim origin y
6167# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6168 lam = 1.0_wp !non dim lambda
6169# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6170 amp = patch_icpp(patch_id)%a(2)
6171# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6172
6173# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6174 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
6175# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6176
6177# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6178 if (x_cc(i) > intl) then !this is the liquid
6179# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6180 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
6181# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6182 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
6183# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6184 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
6185# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6186 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
6187# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6188 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
6189# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6190 end if
6191# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6192
6193# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6194 case (207) ! Kelvin Helmholtz Instability
6195# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6196 sigma = 0.05_wp/sqrt(2.0_wp)
6197# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6198 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
6199# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6200 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
6201# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6202 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
6203# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6204 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
6205# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6206
6207# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6208 case (208) ! Richtmeyer Meshkov Instability
6209# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6210 lam = 1.0_wp
6211# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6212 eps = 1.0e-6_wp
6213# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6214 ei = 5.0_wp
6215# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6216 ! Smoothening function to smooth out sharp discontinuity in the interface
6217# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6218 if (x_cc(i) <= 0.7_wp*lam) then
6219# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6220 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
6221# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6222 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
6223# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6224 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
6225# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6226 alpha_sf6 = 1.0_wp - alpha_air
6227# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6228 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
6229# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6230 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
6231# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6232 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
6233# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6234 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
6235# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6236 end if
6237# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6238
6239# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6240 case (250) ! MHD Orszag-Tang vortex
6241# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6242 ! gamma = 5/3
6243# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6244 ! rho = 25/(36*pi)
6245# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6246 ! p = 5/(12*pi)
6247# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6248 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
6249# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6250 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
6251# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6252
6253# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6254 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
6255# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6256 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
6257# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6258
6259# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6260 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
6261# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6262 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
6263# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6264
6265# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6266 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
6267# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6268 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
6269# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6270 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
6271# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6272 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
6273# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6274 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
6275# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6276 ! Linear interpolation between r=0.08 and r=1.0
6277# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6278 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
6279# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6280 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
6281# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6282 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
6283# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6284 else
6285# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6286 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
6287# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6288 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
6289# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6290 end if
6291# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6292
6293# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6294 ! case 252 is for the 2D MHD Rotor problem
6295# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6296 case (252) ! 2D MHD Rotor Problem
6297# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6298 ! Ambient conditions are set in the JSON file.
6299# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6300 ! This case imposes the dense, rotating cylinder.
6301# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6302 !
6303# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6304 ! gamma = 1.4
6305# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6306 ! Ambient medium (r > 0.1):
6307# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6308 ! rho = 1, p = 1, v = 0, B = (1,0,0)
6309# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6310 ! Rotor (r <= 0.1):
6311# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6312 ! rho = 10, p = 1
6313# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6314 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
6315# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6316
6317# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6318 ! Calculate distance squared from the center
6319# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6320 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
6321# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6322
6323# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6324 ! inner radius of 0.1
6325# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6326 if (r_sq <= 0.1**2) then
6327# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6328 ! -- Inside the rotor --
6329# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6330 ! Set density uniformly to 10
6331# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6332 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
6333# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6334
6335# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6336 ! Set vup constant rotation of rate v=2
6337# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6338 ! v_x = -omega * (y - y_c)
6339# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6340 ! v_y = omega * (x - x_c)
6341# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6342 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
6343# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6344 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
6345# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6346
6347# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6348 ! taper width of 0.015
6349# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6350 else if (r_sq <= 0.115**2) then
6351# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6352 ! linearly smooth the function between r = 0.1 and 0.115
6353# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6354 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
6355# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6356
6357# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6358 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)
6359# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6360 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)
6361# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6362 end if
6363# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6364
6365# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6366 case (253) ! MHD Smooth Magnetic Vortex
6367# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6368 ! Section 5.2 of
6369# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6370 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
6371# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6372 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
6373# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6374
6375# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6376 ! velocity
6377# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6378 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))
6379# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6380 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))
6381# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6382
6383# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6384 ! magnetic field
6385# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6386 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)
6387# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6388 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)
6389# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6390
6391# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6392 ! pressure
6393# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6394 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)
6395# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6396
6397# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6398 case (260) ! Gaussian Divergence Pulse
6399# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6400 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
6401# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6402 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
6403# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6404 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
6405# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6406 ! ψ is initialized to zero everywhere.
6407# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6408
6409# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6410 eps_mhd = patch_icpp(patch_id)%a(2)
6411# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6412 sigma = patch_icpp(patch_id)%a(3)
6413# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6414 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
6415# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6416
6417# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6418 ! B-field
6419# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6420 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
6421# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6422
6423# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6424 case (261) ! Blob
6425# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6426 r0 = 1._wp/sqrt(8._wp)
6427# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6428 r2 = x_cc(i)**2 + y_cc(j)**2
6429# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6430 r = sqrt(r2)
6431# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6432 alpha = r/r0
6433# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6434 if (alpha < 1) then
6435# 625 "/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/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
6437# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6438 ! 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)
6439# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6440 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
6441# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6442 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
6443# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6444 end if
6445# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6446
6447# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6448 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
6449# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6450 ! rotate by α = atan(2)
6451# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6452 alpha = atan(2._wp)
6453# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6454 cosa = cos(alpha)
6455# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6456 sina = sin(alpha)
6457# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6458 ! projection along shock normal
6459# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6460 r = x_cc(i)*cosa + y_cc(j)*sina
6461# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6462
6463# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6464 if (r <= 0.5_wp) then
6465# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6466 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
6467# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6468 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
6469# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6470 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
6471# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6472 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
6473# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6474 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
6475# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6476 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
6477# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6478 - (5._wp/sqrt(4._wp*pi))*sina
6479# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6480 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
6481# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6482 + (5._wp/sqrt(4._wp*pi))*cosa
6483# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6484 else
6485# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6486 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
6487# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6488 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
6489# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6490 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
6491# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6492 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
6493# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6494 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
6495# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6496 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
6497# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6498 - (5._wp/sqrt(4._wp*pi))*sina
6499# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6500 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
6501# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6502 + (5._wp/sqrt(4._wp*pi))*cosa
6503# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6504 end if
6505# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6506 ! v^z and B^z remain zero by default
6507# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6508
6509# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6510 case (270)
6511# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6512 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
6513# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6514
6515# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6516 if (.not. files_loaded) then
6517# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6518 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
6519# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6520 do f = 1, max_files
6521# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6522 write (file_num_str, '(I0)') f
6523# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6524 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
6525# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6526 end do
6527# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6528
6529# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6530 ! Common file reading setup
6531# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6532 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6533# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6534 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
6535# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6536
6537# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6538 select case (num_dims)
6539# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6540 case (1, 2) ! 1D and 2D cases are similar
6541# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6542 ! Count lines
6543# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6544 line_count = 0
6545# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6546 do
6547# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6548 read (unit2, *, iostat=ios2) dummy_x, dummy_y
6549# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6550 if (ios2 /= 0) exit
6551# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6552 line_count = line_count + 1
6553# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6554 end do
6555# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6556 close (unit2)
6557# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6558
6559# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6560 xrows = line_count
6561# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6562 yrows = 1
6563# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6564 index_x = 0
6565# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6566 if (num_dims == 2) index_x = i
6567# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6568#ifdef MFC_DEBUG
6569# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6570 block
6571# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6572 use iso_fortran_env, only: output_unit
6573# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6574
6575# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6576 print *, 'm_icpp_patches.fpp:625: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
6577# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6578
6579# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6580 call flush (output_unit)
6581# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6582 end block
6583# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6584#endif
6585# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6586 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
6587# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6588
6589# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6590
6591# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6592
6593# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6594#if defined(MFC_OpenACC)
6595# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6596!$acc enter data create(x_coords, stored_values)
6597# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6598#elif defined(MFC_OpenMP)
6599# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6600!$omp target enter data map(always,alloc:x_coords, stored_values)
6601# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6602#endif
6603# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6604
6605# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6606 ! Read data from all files
6607# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6608 do f = 1, max_files
6609# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6610 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6611# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6612 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
6613# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6614
6615# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6616 do iter = 1, xrows
6617# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6618 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
6619# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6620 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
6621# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6622 end do
6623# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6624 close (unit)
6625# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6626 end do
6627# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6628
6629# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6630 ! Calculate offsets
6631# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6632 domain_xstart = x_coords(1)
6633# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6634 x_step = x_cc(1) - x_cc(0)
6635# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6636 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
6637# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6638 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
6639# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6640 global_offset_x = nint(abs(delta_x)/x_step)
6641# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6642
6643# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6644 case (3) ! 3D case - determine grid structure
6645# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6646 ! Find yRows by counting rows with same x
6647# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6648 read (unit2, *, iostat=ios2) x0, y0, dummy_z
6649# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6650 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
6651# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6652
6653# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6654 yrows = 1
6655# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6656 do
6657# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6658 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6659# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6660 if (ios2 /= 0) exit
6661# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6662 if (dummy_x == x0 .and. dummy_y /= y0) then
6663# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6664 yrows = yrows + 1
6665# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6666 else
6667# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6668 exit
6669# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6670 end if
6671# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6672 end do
6673# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6674 close (unit2)
6675# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6676
6677# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6678 ! Count total rows
6679# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6680 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
6681# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6682 nrows = 0
6683# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6684 do
6685# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6686 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
6687# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6688 if (ios2 /= 0) exit
6689# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6690 nrows = nrows + 1
6691# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6692 end do
6693# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6694 close (unit2)
6695# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6696
6697# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6698 xrows = nrows/yrows
6699# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6700#ifdef MFC_DEBUG
6701# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6702 block
6703# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6704 use iso_fortran_env, only: output_unit
6705# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6706
6707# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6708 print *, 'm_icpp_patches.fpp:625: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
6709# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6710
6711# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6712 call flush (output_unit)
6713# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6714 end block
6715# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6716#endif
6717# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6718 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
6719# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6720
6721# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6722
6723# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6724
6725# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6726
6727# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6728#if defined(MFC_OpenACC)
6729# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6730!$acc enter data create(x_coords, y_coords, stored_values)
6731# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6732#elif defined(MFC_OpenMP)
6733# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6734!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
6735# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6736#endif
6737# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6738 index_x = i
6739# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6740 index_y = j
6741# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6742
6743# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6744 ! Read all files
6745# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6746 do f = 1, max_files
6747# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6748 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
6749# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6750 if (ios /= 0) then
6751# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6752 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
6753# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6754 cycle
6755# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6756 end if
6757# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6758
6759# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6760 iter = 0
6761# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6762 do iix = 1, xrows
6763# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6764 do iiy = 1, yrows
6765# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6766 iter = iter + 1
6767# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6768 if (f == 1) then
6769# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6770 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
6771# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6772 else
6773# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6774 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
6775# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6776 end if
6777# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6778 if (ios /= 0) call s_mpi_abort("Error reading data")
6779# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6780 end do
6781# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6782 end do
6783# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6784 close (unit)
6785# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6786 end do
6787# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6788
6789# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6790 ! Calculate offsets
6791# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6792 x_step = x_cc(1) - x_cc(0)
6793# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6794 y_step = y_cc(1) - y_cc(0)
6795# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6796 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
6797# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6798 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
6799# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6800 global_offset_x = nint(abs(delta_x)/x_step)
6801# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6802 global_offset_y = nint(abs(delta_y)/y_step)
6803# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6804 end select
6805# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6806
6807# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6808 files_loaded = .true.
6809# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6810 end if
6811# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6812
6813# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6814 ! Data assignment
6815# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6816 select case (num_dims)
6817# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6818 case (1)
6819# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6820 idx = i + 1 + global_offset_x
6821# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6822 do f = 1, sys_size
6823# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6824 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
6825# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6826 end do
6827# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6828
6829# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6830 case (2)
6831# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6832 idx = i + 1 + global_offset_x - index_x
6833# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6834 do f = 1, sys_size - 1
6835# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6836 jump = merge(1, 0, f >= momxe)
6837# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6838 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
6839# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6840 end do
6841# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6842 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
6843# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6844
6845# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6846 case (3)
6847# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6848 idx = i + 1 + global_offset_x - index_x
6849# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6850 idy = j + 1 + global_offset_y - index_y
6851# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6852 do f = 1, sys_size - 1
6853# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6854 jump = merge(1, 0, f >= momxe)
6855# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6856 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
6857# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6858 end do
6859# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6860 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
6861# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6862 end select
6863# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6864
6865# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6866 case (280)
6867# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6868 ! This is patch is hard-coded for test suite optimization used in the
6869# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6870 ! 2D_isentropicvortex case:
6871# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6872 ! This analytic patch uses geometry 2
6873# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6874 if (patch_id == 1) then
6875# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6876 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)
6877# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6878 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
6879# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6880 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))
6881# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6882 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))
6883# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6884 end if
6885# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6886
6887# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6888 case (281)
6889# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6890 ! This is patch is hard-coded for test suite optimization used in the
6891# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6892 ! 2D_acoustic_pulse case:
6893# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6894 ! This analytic patch uses geometry 2
6895# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6896 if (patch_id == 2) then
6897# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6898 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))
6899# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6900 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))
6901# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6902 end if
6903# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6904
6905# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6906 case (282)
6907# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6908 ! This is patch is hard-coded for test suite optimization used in the
6909# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6910 ! 2D_zero_circ_vortex case:
6911# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6912 ! This analytic patch uses geometry 2
6913# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6914 if (patch_id == 2) then
6915# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6916 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))
6917# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6918 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))
6919# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6920 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)))
6921# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6922 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)))
6923# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6924 end if
6925# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6926
6927# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6928 case default
6929# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6930 if (proc_rank == 0) then
6931# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6932 call s_int_to_str(patch_id, istr)
6933# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6934 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
6935# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6936 end if
6937# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6938
6939# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6940 end select
6941# 625 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6942
6943 end if
6944
6945 ! Updating the patch identities bookkeeping variable
6946 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
6947 end if
6948 end do
6949 end do
6950 if (allocated(stored_values)) then
6951# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6952#ifdef MFC_DEBUG
6953# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6954 block
6955# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6956 use iso_fortran_env, only: output_unit
6957# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6958
6959# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6960 print *, 'm_icpp_patches.fpp:633: ', '@:DEALLOCATE(stored_values)'
6961# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6962
6963# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6964 call flush (output_unit)
6965# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6966 end block
6967# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6968#endif
6969# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6970
6971# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6972#if defined(MFC_OpenACC)
6973# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6974!$acc exit data delete(stored_values)
6975# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6976#elif defined(MFC_OpenMP)
6977# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6978!$omp target exit data map(release:stored_values)
6979# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6980#endif
6981# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6982 deallocate (stored_values)
6983# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6984#ifdef MFC_DEBUG
6985# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6986 block
6987# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6988 use iso_fortran_env, only: output_unit
6989# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6990
6991# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6992 print *, 'm_icpp_patches.fpp:633: ', '@:DEALLOCATE(x_coords)'
6993# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6994
6995# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6996 call flush (output_unit)
6997# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
6998 end block
6999# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7000#endif
7001# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7002
7003# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7004#if defined(MFC_OpenACC)
7005# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7006!$acc exit data delete(x_coords)
7007# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7008#elif defined(MFC_OpenMP)
7009# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7010!$omp target exit data map(release:x_coords)
7011# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7012#endif
7013# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7014 deallocate (x_coords)
7015# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7016 end if
7017# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7018
7019# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7020 if (allocated(y_coords)) then
7021# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7022#ifdef MFC_DEBUG
7023# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7024 block
7025# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7026 use iso_fortran_env, only: output_unit
7027# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7028
7029# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7030 print *, 'm_icpp_patches.fpp:633: ', '@:DEALLOCATE(y_coords)'
7031# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7032
7033# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7034 call flush (output_unit)
7035# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7036 end block
7037# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7038#endif
7039# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7040
7041# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7042#if defined(MFC_OpenACC)
7043# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7044!$acc exit data delete(y_coords)
7045# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7046#elif defined(MFC_OpenMP)
7047# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7048!$omp target exit data map(release:y_coords)
7049# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7050#endif
7051# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7052 deallocate (y_coords)
7053# 633 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7054 end if
7055
7056 end subroutine s_icpp_ellipse
7057
7058 !> The ellipsoidal patch is a 3D geometry. The geometry of
7059 !! the patch is well-defined when its centroid and radii
7060 !! are provided. Note that the ellipsoidal patch DOES allow
7061 !! for the smoothing of its boundary
7062 !! @param patch_id is the patch identifier
7063 !! @param patch_id_fp Array to track patch ids
7064 !! @param q_prim_vf Array of primitive variables
7065 subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
7066
7067 ! Patch identifier
7068 integer, intent(in) :: patch_id
7069#ifdef MFC_MIXED_PRECISION
7070 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
7071#else
7072 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
7073#endif
7074 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
7075
7076 ! Generic loop iterators
7077 integer :: i, j, k
7078 real(wp) :: a, b, c
7079 integer :: xRows, yRows, nRows, iix, iiy, max_files
7080# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7081 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
7082# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7083 real(wp) :: x_len, x_step, y_len, y_step
7084# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7085 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
7086# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7087 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
7088# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7089 real(wp) :: delta_x, delta_y
7090# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7091 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
7092# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7093 character(len=200) :: errmsg
7094# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7095 real(wp), allocatable :: stored_values(:, :, :)
7096# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7097 real(wp), allocatable :: x_coords(:), y_coords(:)
7098# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7099 logical :: files_loaded = .false.
7100# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7101 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
7102# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7103 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
7104# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7105 character(len=20) :: file_num_str ! For storing the file number as a string
7106# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7107 character(len=20) :: zeros_part ! For the trailing zeros part
7108# 658 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7109 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
7110 ! Place any declaration of intermediate variables here
7111# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7112 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
7113# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7114 real(wp) :: eps
7115# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7116
7117# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7118 ! IGR Jets
7119# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7120 ! Arrays to stor position and radii of jets from input file
7121# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7122 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
7123# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7124 ! Variables to describe initial condition of jet
7125# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7126 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
7127# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7128 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
7129# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7130
7131# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7132 real(wp), dimension(0:n, 0:p) :: rcut_arr
7133# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7134 integer :: l, q, s ! Iterators for reading input files
7135# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7136 integer :: start, end ! Ints to keep track of position in file
7137# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7138 character(len=1000) :: line ! String to store line in ile
7139# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7140 character(len=25) :: value ! String to store value in line
7141# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7142 integer :: NJet ! Number of jets
7143# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7144
7145# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7146 eps = 1e-9_wp
7147# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7148
7149# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7150 if (patch_icpp(patch_id)%hcid == 303) then
7151# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7152 eps_smooth = 3._wp
7153# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7154 open (unit=10, file="njet.txt", status="old", action="read")
7155# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7156 read (10, *) njet
7157# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7158 close (10)
7159# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7160
7161# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7162 allocate (y_th_arr(0:njet - 1))
7163# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7164 allocate (z_th_arr(0:njet - 1))
7165# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7166 allocate (r_th_arr(0:njet - 1))
7167# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7168
7169# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7170 open (unit=10, file="jets.csv", status="old", action="read")
7171# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7172 do q = 0, njet - 1
7173# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7174 read (10, '(A)') line ! Read a full line as a string
7175# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7176 start = 1
7177# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7178
7179# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7180 do l = 0, 2
7181# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7182 end = index(line(start:), ',') ! Find the next comma
7183# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7184 if (end == 0) then
7185# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7186 value = trim(adjustl(line(start:))) ! Last value in the line
7187# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7188 else
7189# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7190 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
7191# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7192 start = start + end ! Move to next value
7193# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7194 end if
7195# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7196 if (l == 0) then
7197# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7198 read (value, *) y_th_arr(q) ! Convert string to numeric value
7199# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7200 elseif (l == 1) then
7201# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7202 read (value, *) z_th_arr(q)
7203# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7204 else
7205# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7206 read (value, *) r_th_arr(q)
7207# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7208 end if
7209# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7210 end do
7211# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7212 end do
7213# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7214 close (10)
7215# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7216
7217# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7218 do q = 0, p
7219# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7220 do l = 0, n
7221# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7222 rcut = 0._wp
7223# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7224 do s = 0, njet - 1
7225# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7226 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
7227# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7228 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
7229# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7230 end do
7231# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7232 rcut_arr(l, q) = rcut
7233# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7234 end do
7235# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7236 end do
7237# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7238 end if
7239# 659 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7240
7241
7242 ! Transferring the ellipsoidal patch's radii, centroid, smearing
7243 ! patch identity, and smearing coefficient information
7244 x_centroid = patch_icpp(patch_id)%x_centroid
7245 y_centroid = patch_icpp(patch_id)%y_centroid
7246 z_centroid = patch_icpp(patch_id)%z_centroid
7247 a = patch_icpp(patch_id)%radii(1)
7248 b = patch_icpp(patch_id)%radii(2)
7249 c = patch_icpp(patch_id)%radii(3)
7250 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
7251 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
7252
7253 ! Initializing the pseudo volume fraction value to 1. The value
7254 ! be modified as the patch is laid out on the grid, but only in
7255 ! the case that smoothing of the ellipsoidal patch's boundary is
7256 ! enabled.
7257 eta = 1._wp
7258
7259 ! Checking whether the ellipsoid covers a particular cell in the
7260 ! domain and verifying whether the current patch has permission
7261 ! to write to that cell. If both queries check out, the primitive
7262 ! variables of the current patch are assigned to this cell.
7263 do k = 0, p
7264 do j = 0, n
7265 do i = 0, m
7266
7267 if (grid_geometry == 3) then
7268 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
7269 else
7270 cart_y = y_cc(j)
7271 cart_z = z_cc(k)
7272 end if
7273
7274 if (patch_icpp(patch_id)%smoothen) then
7275 eta = tanh(smooth_coeff/min(dx, dy, dz)* &
7276 (sqrt(((x_cc(i) - x_centroid)/a)**2 + &
7277 ((cart_y - y_centroid)/b)**2 + &
7278 ((cart_z - z_centroid)/c)**2) &
7279 - 1._wp))*(-0.5_wp) + 0.5_wp
7280 end if
7281
7282 if ((((x_cc(i) - x_centroid)/a)**2 + &
7283 ((cart_y - y_centroid)/b)**2 + &
7284 ((cart_z - z_centroid)/c)**2 <= 1._wp &
7285 .and. &
7286 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) &
7287 .or. &
7288 patch_id_fp(i, j, k) == smooth_patch_id) &
7289 then
7290
7291 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
7292 eta, q_prim_vf, patch_id_fp)
7293
7294
7295 if (patch_icpp(patch_id)%hcid /= dflt_int) then
7296
7297# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7298 select case (patch_icpp(patch_id)%hcid)
7299# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7300 case (300) ! Rayleigh-Taylor instability
7301# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7302 rhoh = 3._wp
7303# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7304 rhol = 1._wp
7305# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7306 pref = 1.e5_wp
7307# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7308 pint = pref
7309# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7310 h = 0.7_wp
7311# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7312 lam = 0.2_wp
7313# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7314 wl = 2._wp*pi/lam
7315# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7316 amp = 0.025_wp/wl
7317# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7318
7319# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7320 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
7321# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7322
7323# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7324 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
7325# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7326
7327# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7328 if (alph < eps) alph = eps
7329# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7330 if (alph > 1._wp - eps) alph = 1._wp - eps
7331# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7332
7333# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7334 if (y_cc(j) > inth) then
7335# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7336 q_prim_vf(advxb)%sf(i, j, k) = alph
7337# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7338 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
7339# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7340 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
7341# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7342 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
7343# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7344 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
7345# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7346 else
7347# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7348 q_prim_vf(advxb)%sf(i, j, k) = alph
7349# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7350 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
7351# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7352 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
7353# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7354 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
7355# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7356 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
7357# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7358 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
7359# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7360 end if
7361# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7362
7363# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7364 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
7365# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7366 h = 0.0_wp
7367# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7368 lam = 1.0_wp
7369# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7370 amp = patch_icpp(patch_id)%a(2)
7371# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7372 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
7373# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7374 if (x_cc(i) > inth) then
7375# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7376 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
7377# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7378 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
7379# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7380 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
7381# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7382 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
7383# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7384 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
7385# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7386 end if
7387# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7388
7389# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7390 case (302) ! 3D Jet with IGR
7391# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7392 ux_th = 10*sqrt(1.4*0.4)
7393# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7394 ux_am = 0.0*sqrt(1.4)
7395# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7396 p_th = 2.0_wp
7397# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7398 p_am = 1.0_wp
7399# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7400 rho_th = 1._wp
7401# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7402 rho_am = 1._wp
7403# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7404 y_th = 0.0_wp
7405# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7406 z_th = 0.0_wp
7407# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7408 r_th = 1._wp
7409# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7410 eps_smooth = 1._wp
7411# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7412 eps = 1e-6
7413# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7414
7415# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7416 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
7417# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7418 rcut = f_cut_on(r - r_th, eps_smooth)
7419# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7420 xcut = f_cut_on(x_cc(i), eps_smooth)
7421# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7422
7423# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7424 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7425# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7426 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
7427# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7428 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
7429# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7430
7431# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7432 if (num_fluids == 1) then
7433# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7434 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7435# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7436 else
7437# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7438 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7439# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7440 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
7441# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7442 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
7443# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7444 end if
7445# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7446
7447# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7448 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
7449# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7450
7451# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7452 case (303) ! 3D Multijet
7453# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7454
7455# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7456 eps_smooth = 3.0_wp
7457# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7458 ux_th = 10*sqrt(1.4*0.4)
7459# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7460 ux_am = 2.5*sqrt(1.4*0.4)
7461# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7462 p_th = 0.8_wp
7463# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7464 p_am = 0.4_wp
7465# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7466 rho_th = 1._wp
7467# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7468 rho_am = 1._wp
7469# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7470 eps = 1e-6
7471# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7472
7473# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7474 rcut = rcut_arr(j, k)
7475# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7476 xcut = f_cut_on(x_cc(i), eps_smooth)
7477# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7478
7479# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7480 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
7481# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7482 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
7483# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7484 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
7485# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7486
7487# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7488 if (num_fluids == 1) then
7489# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7490 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
7491# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7492 else
7493# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7494 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
7495# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7496 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
7497# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7498 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
7499# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7500 end if
7501# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7502
7503# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7504 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
7505# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7506
7507# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7508 case (370)
7509# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7510 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
7511# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7512
7513# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7514 if (.not. files_loaded) then
7515# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7516 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
7517# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7518 do f = 1, max_files
7519# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7520 write (file_num_str, '(I0)') f
7521# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7522 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
7523# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7524 end do
7525# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7526
7527# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7528 ! Common file reading setup
7529# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7530 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7531# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7532 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
7533# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7534
7535# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7536 select case (num_dims)
7537# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7538 case (1, 2) ! 1D and 2D cases are similar
7539# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7540 ! Count lines
7541# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7542 line_count = 0
7543# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7544 do
7545# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7546 read (unit2, *, iostat=ios2) dummy_x, dummy_y
7547# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7548 if (ios2 /= 0) exit
7549# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7550 line_count = line_count + 1
7551# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7552 end do
7553# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7554 close (unit2)
7555# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7556
7557# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7558 xrows = line_count
7559# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7560 yrows = 1
7561# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7562 index_x = 0
7563# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7564 if (num_dims == 2) index_x = i
7565# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7566#ifdef MFC_DEBUG
7567# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7568 block
7569# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7570 use iso_fortran_env, only: output_unit
7571# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7572
7573# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7574 print *, 'm_icpp_patches.fpp:715: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
7575# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7576
7577# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7578 call flush (output_unit)
7579# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7580 end block
7581# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7582#endif
7583# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7584 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
7585# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7586
7587# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7588
7589# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7590
7591# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7592#if defined(MFC_OpenACC)
7593# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7594!$acc enter data create(x_coords, stored_values)
7595# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7596#elif defined(MFC_OpenMP)
7597# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7598!$omp target enter data map(always,alloc:x_coords, stored_values)
7599# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7600#endif
7601# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7602
7603# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7604 ! Read data from all files
7605# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7606 do f = 1, max_files
7607# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7608 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7609# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7610 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
7611# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7612
7613# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7614 do iter = 1, xrows
7615# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7616 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
7617# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7618 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
7619# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7620 end do
7621# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7622 close (unit)
7623# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7624 end do
7625# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7626
7627# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7628 ! Calculate offsets
7629# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7630 domain_xstart = x_coords(1)
7631# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7632 x_step = x_cc(1) - x_cc(0)
7633# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7634 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
7635# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7636 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
7637# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7638 global_offset_x = nint(abs(delta_x)/x_step)
7639# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7640
7641# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7642 case (3) ! 3D case - determine grid structure
7643# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7644 ! Find yRows by counting rows with same x
7645# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7646 read (unit2, *, iostat=ios2) x0, y0, dummy_z
7647# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7648 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
7649# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7650
7651# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7652 yrows = 1
7653# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7654 do
7655# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7656 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7657# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7658 if (ios2 /= 0) exit
7659# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7660 if (dummy_x == x0 .and. dummy_y /= y0) then
7661# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7662 yrows = yrows + 1
7663# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7664 else
7665# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7666 exit
7667# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7668 end if
7669# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7670 end do
7671# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7672 close (unit2)
7673# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7674
7675# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7676 ! Count total rows
7677# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7678 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
7679# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7680 nrows = 0
7681# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7682 do
7683# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7684 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
7685# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7686 if (ios2 /= 0) exit
7687# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7688 nrows = nrows + 1
7689# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7690 end do
7691# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7692 close (unit2)
7693# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7694
7695# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7696 xrows = nrows/yrows
7697# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7698#ifdef MFC_DEBUG
7699# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7700 block
7701# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7702 use iso_fortran_env, only: output_unit
7703# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7704
7705# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7706 print *, 'm_icpp_patches.fpp:715: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
7707# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7708
7709# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7710 call flush (output_unit)
7711# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7712 end block
7713# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7714#endif
7715# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7716 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
7717# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7718
7719# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7720
7721# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7722
7723# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7724
7725# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7726#if defined(MFC_OpenACC)
7727# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7728!$acc enter data create(x_coords, y_coords, stored_values)
7729# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7730#elif defined(MFC_OpenMP)
7731# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7732!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
7733# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7734#endif
7735# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7736 index_x = i
7737# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7738 index_y = j
7739# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7740
7741# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7742 ! Read all files
7743# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7744 do f = 1, max_files
7745# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7746 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
7747# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7748 if (ios /= 0) then
7749# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7750 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
7751# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7752 cycle
7753# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7754 end if
7755# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7756
7757# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7758 iter = 0
7759# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7760 do iix = 1, xrows
7761# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7762 do iiy = 1, yrows
7763# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7764 iter = iter + 1
7765# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7766 if (f == 1) then
7767# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7768 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
7769# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7770 else
7771# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7772 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
7773# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7774 end if
7775# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7776 if (ios /= 0) call s_mpi_abort("Error reading data")
7777# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7778 end do
7779# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7780 end do
7781# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7782 close (unit)
7783# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7784 end do
7785# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7786
7787# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7788 ! Calculate offsets
7789# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7790 x_step = x_cc(1) - x_cc(0)
7791# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7792 y_step = y_cc(1) - y_cc(0)
7793# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7794 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
7795# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7796 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
7797# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7798 global_offset_x = nint(abs(delta_x)/x_step)
7799# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7800 global_offset_y = nint(abs(delta_y)/y_step)
7801# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7802 end select
7803# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7804
7805# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7806 files_loaded = .true.
7807# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7808 end if
7809# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7810
7811# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7812 ! Data assignment
7813# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7814 select case (num_dims)
7815# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7816 case (1)
7817# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7818 idx = i + 1 + global_offset_x
7819# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7820 do f = 1, sys_size
7821# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7822 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
7823# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7824 end do
7825# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7826
7827# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7828 case (2)
7829# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7830 idx = i + 1 + global_offset_x - index_x
7831# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7832 do f = 1, sys_size - 1
7833# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7834 jump = merge(1, 0, f >= momxe)
7835# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7836 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
7837# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7838 end do
7839# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7840 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
7841# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7842
7843# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7844 case (3)
7845# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7846 idx = i + 1 + global_offset_x - index_x
7847# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7848 idy = j + 1 + global_offset_y - index_y
7849# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7850 do f = 1, sys_size - 1
7851# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7852 jump = merge(1, 0, f >= momxe)
7853# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7854 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
7855# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7856 end do
7857# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7858 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
7859# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7860 end select
7861# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7862
7863# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7864 case (380)
7865# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7866 ! This is patch is hard-coded for test suite optimization used in the
7867# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7868 ! 3D_TaylorGreenVortex case:
7869# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7870 ! This analytic patch used geometry 9
7871# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7872 mach = 0.1
7873# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7874 if (patch_id == 1) then
7875# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7876 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)
7877# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7878 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)
7879# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7880 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)
7881# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7882 end if
7883# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7884
7885# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7886 case default
7887# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7888 call s_int_to_str(patch_id, istr)
7889# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7890 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
7891# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7892 end select
7893# 715 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7894
7895 end if
7896
7897 ! Updating the patch identities bookkeeping variable
7898 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
7899 end if
7900 end do
7901 end do
7902 end do
7903 if (allocated(stored_values)) then
7904# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7905#ifdef MFC_DEBUG
7906# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7907 block
7908# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7909 use iso_fortran_env, only: output_unit
7910# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7911
7912# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7913 print *, 'm_icpp_patches.fpp:724: ', '@:DEALLOCATE(stored_values)'
7914# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7915
7916# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7917 call flush (output_unit)
7918# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7919 end block
7920# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7921#endif
7922# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7923
7924# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7925#if defined(MFC_OpenACC)
7926# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7927!$acc exit data delete(stored_values)
7928# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7929#elif defined(MFC_OpenMP)
7930# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7931!$omp target exit data map(release:stored_values)
7932# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7933#endif
7934# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7935 deallocate (stored_values)
7936# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7937#ifdef MFC_DEBUG
7938# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7939 block
7940# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7941 use iso_fortran_env, only: output_unit
7942# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7943
7944# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7945 print *, 'm_icpp_patches.fpp:724: ', '@:DEALLOCATE(x_coords)'
7946# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7947
7948# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7949 call flush (output_unit)
7950# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7951 end block
7952# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7953#endif
7954# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7955
7956# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7957#if defined(MFC_OpenACC)
7958# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7959!$acc exit data delete(x_coords)
7960# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7961#elif defined(MFC_OpenMP)
7962# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7963!$omp target exit data map(release:x_coords)
7964# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7965#endif
7966# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7967 deallocate (x_coords)
7968# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7969 end if
7970# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7971
7972# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7973 if (allocated(y_coords)) then
7974# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7975#ifdef MFC_DEBUG
7976# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7977 block
7978# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7979 use iso_fortran_env, only: output_unit
7980# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7981
7982# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7983 print *, 'm_icpp_patches.fpp:724: ', '@:DEALLOCATE(y_coords)'
7984# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7985
7986# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7987 call flush (output_unit)
7988# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7989 end block
7990# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7991#endif
7992# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7993
7994# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7995#if defined(MFC_OpenACC)
7996# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7997!$acc exit data delete(y_coords)
7998# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
7999#elif defined(MFC_OpenMP)
8000# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8001!$omp target exit data map(release:y_coords)
8002# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8003#endif
8004# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8005 deallocate (y_coords)
8006# 724 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8007 end if
8008
8009 end subroutine s_icpp_ellipsoid
8010
8011 !> The rectangular patch is a 2D geometry that may be used,
8012 !! for example, in creating a solid boundary, or pre-/post-
8013 !! shock region, in alignment with the axes of the Cartesian
8014 !! coordinate system. The geometry of such a patch is well-
8015 !! defined when its centroid and lengths in the x- and y-
8016 !! coordinate directions are provided. Please note that the
8017 !! rectangular patch DOES NOT allow for the smoothing of its
8018 !! boundaries.
8019 !! @param patch_id is the patch identifier
8020 !! @param patch_id_fp Array to track patch ids
8021 !! @param q_prim_vf Array of primitive variables
8022 subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
8023
8024 integer, intent(in) :: patch_id
8025#ifdef MFC_MIXED_PRECISION
8026 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
8027#else
8028 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
8029#endif
8030 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
8031
8032 integer :: i, j, k !< generic loop iterators
8033 real(wp) :: pi_inf, gamma, lit_gamma !< Equation of state parameters
8034 integer :: xRows, yRows, nRows, iix, iiy, max_files
8035# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8036 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
8037# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8038 real(wp) :: x_len, x_step, y_len, y_step
8039# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8040 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
8041# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8042 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
8043# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8044 real(wp) :: delta_x, delta_y
8045# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8046 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
8047# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8048 character(len=200) :: errmsg
8049# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8050 real(wp), allocatable :: stored_values(:, :, :)
8051# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8052 real(wp), allocatable :: x_coords(:), y_coords(:)
8053# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8054 logical :: files_loaded = .false.
8055# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8056 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
8057# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8058 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
8059# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8060 character(len=20) :: file_num_str ! For storing the file number as a string
8061# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8062 character(len=20) :: zeros_part ! For the trailing zeros part
8063# 751 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8064 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
8065 ! Place any declaration of intermediate variables here
8066# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8067 real(wp) :: eps, eps_mhd, C_mhd
8068# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8069 real(wp) :: r, rmax, gam, umax, p0
8070# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8071 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
8072# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8073 real(wp) :: factor
8074# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8075 real(wp) :: r0, alpha, r2
8076# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8077 real(wp) :: sinA, cosA
8078# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8079
8080# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8081 real(wp) :: r_sq
8082# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8083
8084# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8085 ! # 207
8086# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8087 real(wp) :: sigma, gauss1, gauss2
8088# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8089 ! # 208
8090# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8091 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
8092# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8093
8094# 752 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8095 eps = 1.e-9_wp
8096
8097 pi_inf = pi_infs(1)
8098 gamma = gammas(1)
8099 lit_gamma = gs_min(1)
8100
8101 ! Transferring the rectangle's centroid and length information
8102 x_centroid = patch_icpp(patch_id)%x_centroid
8103 y_centroid = patch_icpp(patch_id)%y_centroid
8104 length_x = patch_icpp(patch_id)%length_x
8105 length_y = patch_icpp(patch_id)%length_y
8106
8107 ! Computing the beginning and the end x- and y-coordinates of the
8108 ! rectangle based on its centroid and lengths
8109 x_boundary%beg = x_centroid - 0.5_wp*length_x
8110 x_boundary%end = x_centroid + 0.5_wp*length_x
8111 y_boundary%beg = y_centroid - 0.5_wp*length_y
8112 y_boundary%end = y_centroid + 0.5_wp*length_y
8113
8114 ! Since the rectangular patch does not allow for its boundaries to
8115 ! be smoothed out, the pseudo volume fraction is set to 1 to ensure
8116 ! that only the current patch contributes to the fluid state in the
8117 ! cells that this patch covers.
8118 eta = 1._wp
8119
8120 ! Checking whether the rectangle covers a particular cell in the
8121 ! domain and verifying whether the current patch has the permission
8122 ! to write to that cell. If both queries check out, the primitive
8123 ! variables of the current patch are assigned to this cell.
8124 do j = 0, n
8125 do i = 0, m
8126 if (x_boundary%beg <= x_cc(i) .and. &
8127 x_boundary%end >= x_cc(i) .and. &
8128 y_boundary%beg <= y_cc(j) .and. &
8129 y_boundary%end >= y_cc(j)) then
8130 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
8131 then
8132
8133 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
8134 eta, q_prim_vf, patch_id_fp)
8135
8136
8137
8138 if (patch_icpp(patch_id)%hcid /= dflt_int) then
8139
8140# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8141 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
8142# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8143
8144# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8145 case (200)
8146# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8147 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
8148# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8149 ! Volume Fractions
8150# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8151 q_prim_vf(advxb)%sf(i, j, 0) = eps
8152# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8153 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
8154# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8155 ! Denssities
8156# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8157 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
8158# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8159 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
8160# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8161 ! Pressure
8162# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8163 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
8164# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8165 end if
8166# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8167 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
8168# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8169 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8170# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8171 rmax = 0.2_wp
8172# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8173
8174# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8175 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8176# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8177 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8178# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8179 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8180# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8181
8182# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8183 if (r < rmax) then
8184# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8185 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8186# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8187 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8188# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8189 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8190# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8191 else if (r < 2*rmax) then
8192# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8193 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8194# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8195 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8196# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8197 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
8198# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8199 else
8200# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8201 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
8202# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8203 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
8204# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8205 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
8206# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8207 end if
8208# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8209 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
8210# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8211 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
8212# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8213 rmax = 0.2_wp
8214# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8215
8216# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8217 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
8218# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8219 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
8220# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8221 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
8222# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8223
8224# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8225 if (r < rmax) then
8226# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8227 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
8228# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8229 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
8230# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8231 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
8232# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8233 else if (r < 2*rmax) then
8234# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8235 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8236# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8237 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
8238# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8239 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)))
8240# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8241 else
8242# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8243 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
8244# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8245 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
8246# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8247 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
8248# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8249 end if
8250# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8251
8252# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8253 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
8254# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8255 case (204) ! Rayleigh-Taylor instability
8256# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8257 rhoh = 3._wp
8258# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8259 rhol = 1._wp
8260# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8261 pref = 1.e5_wp
8262# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8263 pint = pref
8264# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8265 h = 0.7_wp
8266# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8267 lam = 0.2_wp
8268# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8269 wl = 2._wp*pi/lam
8270# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8271 amp = 0.05_wp/wl
8272# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8273
8274# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8275 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
8276# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8277
8278# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8279 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
8280# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8281
8282# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8283 if (alph < eps) alph = eps
8284# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8285 if (alph > 1._wp - eps) alph = 1._wp - eps
8286# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8287
8288# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8289 if (y_cc(j) > inth) then
8290# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8291 q_prim_vf(advxb)%sf(i, j, 0) = alph
8292# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8293 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
8294# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8295 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
8296# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8297 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
8298# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8299 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
8300# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8301 else
8302# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8303 q_prim_vf(advxb)%sf(i, j, 0) = alph
8304# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8305 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
8306# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8307 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
8308# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8309 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
8310# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8311 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
8312# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8313 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
8314# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8315 end if
8316# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8317
8318# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8319 case (205) ! 2D lung wave interaction problem
8320# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8321 h = 0.0_wp !non dim origin y
8322# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8323 lam = 1.0_wp !non dim lambda
8324# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8325 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
8326# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8327
8328# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8329 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
8330# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8331
8332# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8333 if (y_cc(j) > inth) then
8334# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8335 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8336# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8337 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8338# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8339 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
8340# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8341 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8342# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8343 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8344# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8345 end if
8346# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8347
8348# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8349 case (206) ! 2D lung wave interaction problem - horizontal domain
8350# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8351 h = 0.0_wp !non dim origin y
8352# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8353 lam = 1.0_wp !non dim lambda
8354# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8355 amp = patch_icpp(patch_id)%a(2)
8356# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8357
8358# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8359 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
8360# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8361
8362# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8363 if (x_cc(i) > intl) then !this is the liquid
8364# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8365 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
8366# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8367 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
8368# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8369 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
8370# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8371 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
8372# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8373 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
8374# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8375 end if
8376# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8377
8378# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8379 case (207) ! Kelvin Helmholtz Instability
8380# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8381 sigma = 0.05_wp/sqrt(2.0_wp)
8382# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8383 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
8384# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8385 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
8386# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8387 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
8388# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8389 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
8390# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8391
8392# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8393 case (208) ! Richtmeyer Meshkov Instability
8394# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8395 lam = 1.0_wp
8396# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8397 eps = 1.0e-6_wp
8398# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8399 ei = 5.0_wp
8400# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8401 ! Smoothening function to smooth out sharp discontinuity in the interface
8402# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8403 if (x_cc(i) <= 0.7_wp*lam) then
8404# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8405 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
8406# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8407 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
8408# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8409 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
8410# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8411 alpha_sf6 = 1.0_wp - alpha_air
8412# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8413 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
8414# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8415 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
8416# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8417 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
8418# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8419 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
8420# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8421 end if
8422# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8423
8424# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8425 case (250) ! MHD Orszag-Tang vortex
8426# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8427 ! gamma = 5/3
8428# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8429 ! rho = 25/(36*pi)
8430# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8431 ! p = 5/(12*pi)
8432# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8433 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
8434# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8435 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
8436# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8437
8438# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8439 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
8440# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8441 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
8442# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8443
8444# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8445 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
8446# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8447 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
8448# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8449
8450# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8451 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
8452# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8453 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
8454# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8455 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
8456# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8457 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
8458# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8459 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
8460# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8461 ! Linear interpolation between r=0.08 and r=1.0
8462# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8463 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
8464# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8465 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
8466# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8467 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
8468# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8469 else
8470# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8471 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
8472# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8473 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
8474# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8475 end if
8476# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8477
8478# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8479 ! case 252 is for the 2D MHD Rotor problem
8480# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8481 case (252) ! 2D MHD Rotor Problem
8482# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8483 ! Ambient conditions are set in the JSON file.
8484# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8485 ! This case imposes the dense, rotating cylinder.
8486# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8487 !
8488# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8489 ! gamma = 1.4
8490# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8491 ! Ambient medium (r > 0.1):
8492# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8493 ! rho = 1, p = 1, v = 0, B = (1,0,0)
8494# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8495 ! Rotor (r <= 0.1):
8496# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8497 ! rho = 10, p = 1
8498# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8499 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
8500# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8501
8502# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8503 ! Calculate distance squared from the center
8504# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8505 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
8506# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8507
8508# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8509 ! inner radius of 0.1
8510# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8511 if (r_sq <= 0.1**2) then
8512# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8513 ! -- Inside the rotor --
8514# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8515 ! Set density uniformly to 10
8516# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8517 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
8518# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8519
8520# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8521 ! Set vup constant rotation of rate v=2
8522# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8523 ! v_x = -omega * (y - y_c)
8524# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8525 ! v_y = omega * (x - x_c)
8526# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8527 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
8528# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8529 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
8530# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8531
8532# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8533 ! taper width of 0.015
8534# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8535 else if (r_sq <= 0.115**2) then
8536# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8537 ! linearly smooth the function between r = 0.1 and 0.115
8538# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8539 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
8540# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8541
8542# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8543 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)
8544# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8545 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)
8546# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8547 end if
8548# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8549
8550# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8551 case (253) ! MHD Smooth Magnetic Vortex
8552# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8553 ! Section 5.2 of
8554# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8555 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
8556# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8557 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
8558# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8559
8560# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8561 ! velocity
8562# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8563 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))
8564# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8565 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))
8566# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8567
8568# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8569 ! magnetic field
8570# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8571 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)
8572# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8573 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)
8574# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8575
8576# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8577 ! pressure
8578# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8579 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)
8580# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8581
8582# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8583 case (260) ! Gaussian Divergence Pulse
8584# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8585 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
8586# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8587 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
8588# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8589 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
8590# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8591 ! ψ is initialized to zero everywhere.
8592# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8593
8594# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8595 eps_mhd = patch_icpp(patch_id)%a(2)
8596# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8597 sigma = patch_icpp(patch_id)%a(3)
8598# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8599 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
8600# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8601
8602# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8603 ! B-field
8604# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8605 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
8606# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8607
8608# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8609 case (261) ! Blob
8610# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8611 r0 = 1._wp/sqrt(8._wp)
8612# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8613 r2 = x_cc(i)**2 + y_cc(j)**2
8614# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8615 r = sqrt(r2)
8616# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8617 alpha = r/r0
8618# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8619 if (alpha < 1) then
8620# 796 "/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/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
8622# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8623 ! 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)
8624# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8625 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
8626# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8627 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
8628# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8629 end if
8630# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8631
8632# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8633 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
8634# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8635 ! rotate by α = atan(2)
8636# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8637 alpha = atan(2._wp)
8638# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8639 cosa = cos(alpha)
8640# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8641 sina = sin(alpha)
8642# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8643 ! projection along shock normal
8644# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8645 r = x_cc(i)*cosa + y_cc(j)*sina
8646# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8647
8648# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8649 if (r <= 0.5_wp) then
8650# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8651 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
8652# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8653 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
8654# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8655 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
8656# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8657 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
8658# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8659 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
8660# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8661 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
8662# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8663 - (5._wp/sqrt(4._wp*pi))*sina
8664# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8665 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
8666# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8667 + (5._wp/sqrt(4._wp*pi))*cosa
8668# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8669 else
8670# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8671 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
8672# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8673 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
8674# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8675 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
8676# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8677 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
8678# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8679 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
8680# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8681 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
8682# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8683 - (5._wp/sqrt(4._wp*pi))*sina
8684# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8685 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
8686# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8687 + (5._wp/sqrt(4._wp*pi))*cosa
8688# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8689 end if
8690# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8691 ! v^z and B^z remain zero by default
8692# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8693
8694# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8695 case (270)
8696# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8697 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
8698# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8699
8700# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8701 if (.not. files_loaded) then
8702# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8703 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
8704# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8705 do f = 1, max_files
8706# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8707 write (file_num_str, '(I0)') f
8708# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8709 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
8710# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8711 end do
8712# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8713
8714# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8715 ! Common file reading setup
8716# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8717 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8718# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8719 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
8720# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8721
8722# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8723 select case (num_dims)
8724# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8725 case (1, 2) ! 1D and 2D cases are similar
8726# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8727 ! Count lines
8728# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8729 line_count = 0
8730# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8731 do
8732# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8733 read (unit2, *, iostat=ios2) dummy_x, dummy_y
8734# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8735 if (ios2 /= 0) exit
8736# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8737 line_count = line_count + 1
8738# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8739 end do
8740# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8741 close (unit2)
8742# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8743
8744# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8745 xrows = line_count
8746# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8747 yrows = 1
8748# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8749 index_x = 0
8750# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8751 if (num_dims == 2) index_x = i
8752# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8753#ifdef MFC_DEBUG
8754# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8755 block
8756# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8757 use iso_fortran_env, only: output_unit
8758# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8759
8760# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8761 print *, 'm_icpp_patches.fpp:796: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
8762# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8763
8764# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8765 call flush (output_unit)
8766# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8767 end block
8768# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8769#endif
8770# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8771 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
8772# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8773
8774# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8775
8776# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8777
8778# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8779#if defined(MFC_OpenACC)
8780# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8781!$acc enter data create(x_coords, stored_values)
8782# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8783#elif defined(MFC_OpenMP)
8784# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8785!$omp target enter data map(always,alloc:x_coords, stored_values)
8786# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8787#endif
8788# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8789
8790# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8791 ! Read data from all files
8792# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8793 do f = 1, max_files
8794# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8795 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8796# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8797 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
8798# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8799
8800# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8801 do iter = 1, xrows
8802# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8803 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
8804# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8805 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
8806# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8807 end do
8808# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8809 close (unit)
8810# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8811 end do
8812# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8813
8814# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8815 ! Calculate offsets
8816# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8817 domain_xstart = x_coords(1)
8818# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8819 x_step = x_cc(1) - x_cc(0)
8820# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8821 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
8822# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8823 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
8824# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8825 global_offset_x = nint(abs(delta_x)/x_step)
8826# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8827
8828# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8829 case (3) ! 3D case - determine grid structure
8830# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8831 ! Find yRows by counting rows with same x
8832# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8833 read (unit2, *, iostat=ios2) x0, y0, dummy_z
8834# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8835 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
8836# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8837
8838# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8839 yrows = 1
8840# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8841 do
8842# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8843 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8844# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8845 if (ios2 /= 0) exit
8846# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8847 if (dummy_x == x0 .and. dummy_y /= y0) then
8848# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8849 yrows = yrows + 1
8850# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8851 else
8852# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8853 exit
8854# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8855 end if
8856# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8857 end do
8858# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8859 close (unit2)
8860# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8861
8862# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8863 ! Count total rows
8864# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8865 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
8866# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8867 nrows = 0
8868# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8869 do
8870# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8871 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
8872# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8873 if (ios2 /= 0) exit
8874# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8875 nrows = nrows + 1
8876# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8877 end do
8878# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8879 close (unit2)
8880# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8881
8882# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8883 xrows = nrows/yrows
8884# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8885#ifdef MFC_DEBUG
8886# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8887 block
8888# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8889 use iso_fortran_env, only: output_unit
8890# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8891
8892# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8893 print *, 'm_icpp_patches.fpp:796: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
8894# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8895
8896# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8897 call flush (output_unit)
8898# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8899 end block
8900# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8901#endif
8902# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8903 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
8904# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8905
8906# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8907
8908# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8909
8910# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8911
8912# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8913#if defined(MFC_OpenACC)
8914# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8915!$acc enter data create(x_coords, y_coords, stored_values)
8916# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8917#elif defined(MFC_OpenMP)
8918# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8919!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
8920# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8921#endif
8922# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8923 index_x = i
8924# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8925 index_y = j
8926# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8927
8928# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8929 ! Read all files
8930# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8931 do f = 1, max_files
8932# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8933 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
8934# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8935 if (ios /= 0) then
8936# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8937 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
8938# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8939 cycle
8940# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8941 end if
8942# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8943
8944# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8945 iter = 0
8946# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8947 do iix = 1, xrows
8948# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8949 do iiy = 1, yrows
8950# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8951 iter = iter + 1
8952# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8953 if (f == 1) then
8954# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8955 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
8956# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8957 else
8958# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8959 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
8960# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8961 end if
8962# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8963 if (ios /= 0) call s_mpi_abort("Error reading data")
8964# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8965 end do
8966# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8967 end do
8968# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8969 close (unit)
8970# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8971 end do
8972# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8973
8974# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8975 ! Calculate offsets
8976# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8977 x_step = x_cc(1) - x_cc(0)
8978# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8979 y_step = y_cc(1) - y_cc(0)
8980# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8981 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
8982# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8983 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
8984# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8985 global_offset_x = nint(abs(delta_x)/x_step)
8986# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8987 global_offset_y = nint(abs(delta_y)/y_step)
8988# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8989 end select
8990# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8991
8992# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8993 files_loaded = .true.
8994# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8995 end if
8996# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8997
8998# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
8999 ! Data assignment
9000# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9001 select case (num_dims)
9002# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9003 case (1)
9004# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9005 idx = i + 1 + global_offset_x
9006# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9007 do f = 1, sys_size
9008# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9009 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
9010# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9011 end do
9012# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9013
9014# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9015 case (2)
9016# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9017 idx = i + 1 + global_offset_x - index_x
9018# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9019 do f = 1, sys_size - 1
9020# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9021 jump = merge(1, 0, f >= momxe)
9022# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9023 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
9024# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9025 end do
9026# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9027 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
9028# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9029
9030# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9031 case (3)
9032# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9033 idx = i + 1 + global_offset_x - index_x
9034# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9035 idy = j + 1 + global_offset_y - index_y
9036# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9037 do f = 1, sys_size - 1
9038# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9039 jump = merge(1, 0, f >= momxe)
9040# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9041 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
9042# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9043 end do
9044# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9045 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
9046# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9047 end select
9048# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9049
9050# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9051 case (280)
9052# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9053 ! This is patch is hard-coded for test suite optimization used in the
9054# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9055 ! 2D_isentropicvortex case:
9056# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9057 ! This analytic patch uses geometry 2
9058# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9059 if (patch_id == 1) then
9060# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9061 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)
9062# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9063 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
9064# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9065 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))
9066# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9067 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))
9068# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9069 end if
9070# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9071
9072# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9073 case (281)
9074# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9075 ! This is patch is hard-coded for test suite optimization used in the
9076# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9077 ! 2D_acoustic_pulse case:
9078# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9079 ! This analytic patch uses geometry 2
9080# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9081 if (patch_id == 2) then
9082# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9083 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))
9084# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9085 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))
9086# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9087 end if
9088# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9089
9090# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9091 case (282)
9092# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9093 ! This is patch is hard-coded for test suite optimization used in the
9094# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9095 ! 2D_zero_circ_vortex case:
9096# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9097 ! This analytic patch uses geometry 2
9098# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9099 if (patch_id == 2) then
9100# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9101 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))
9102# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9103 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))
9104# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9105 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)))
9106# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9107 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)))
9108# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9109 end if
9110# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9111
9112# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9113 case default
9114# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9115 if (proc_rank == 0) then
9116# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9117 call s_int_to_str(patch_id, istr)
9118# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9119 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
9120# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9121 end if
9122# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9123
9124# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9125 end select
9126# 796 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9127
9128 end if
9129
9130 if ((q_prim_vf(1)%sf(i, j, 0) < 1.e-10) .and. (model_eqns == 4)) then
9131 !zero density, reassign according to Tait EOS
9132 q_prim_vf(1)%sf(i, j, 0) = &
9133 (((q_prim_vf(e_idx)%sf(i, j, 0) + pi_inf)/(pref + pi_inf))**(1._wp/lit_gamma))* &
9134 rhoref*(1._wp - q_prim_vf(alf_idx)%sf(i, j, 0))
9135 end if
9136
9137 ! Updating the patch identities bookkeeping variable
9138 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
9139 end if
9140 end if
9141 end do
9142 end do
9143 if (allocated(stored_values)) then
9144# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9145#ifdef MFC_DEBUG
9146# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9147 block
9148# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9149 use iso_fortran_env, only: output_unit
9150# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9151
9152# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9153 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(stored_values)'
9154# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9155
9156# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9157 call flush (output_unit)
9158# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9159 end block
9160# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9161#endif
9162# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9163
9164# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9165#if defined(MFC_OpenACC)
9166# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9167!$acc exit data delete(stored_values)
9168# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9169#elif defined(MFC_OpenMP)
9170# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9171!$omp target exit data map(release:stored_values)
9172# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9173#endif
9174# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9175 deallocate (stored_values)
9176# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9177#ifdef MFC_DEBUG
9178# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9179 block
9180# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9181 use iso_fortran_env, only: output_unit
9182# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9183
9184# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9185 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(x_coords)'
9186# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9187
9188# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9189 call flush (output_unit)
9190# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9191 end block
9192# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9193#endif
9194# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9195
9196# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9197#if defined(MFC_OpenACC)
9198# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9199!$acc exit data delete(x_coords)
9200# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9201#elif defined(MFC_OpenMP)
9202# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9203!$omp target exit data map(release:x_coords)
9204# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9205#endif
9206# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9207 deallocate (x_coords)
9208# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9209 end if
9210# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9211
9212# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9213 if (allocated(y_coords)) then
9214# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9215#ifdef MFC_DEBUG
9216# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9217 block
9218# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9219 use iso_fortran_env, only: output_unit
9220# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9221
9222# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9223 print *, 'm_icpp_patches.fpp:812: ', '@:DEALLOCATE(y_coords)'
9224# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9225
9226# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9227 call flush (output_unit)
9228# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9229 end block
9230# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9231#endif
9232# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9233
9234# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9235#if defined(MFC_OpenACC)
9236# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9237!$acc exit data delete(y_coords)
9238# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9239#elif defined(MFC_OpenMP)
9240# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9241!$omp target exit data map(release:y_coords)
9242# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9243#endif
9244# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9245 deallocate (y_coords)
9246# 812 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9247 end if
9248
9249 end subroutine s_icpp_rectangle
9250
9251 !> The swept line patch is a 2D geometry that may be used,
9252 !! for example, in creating a solid boundary, or pre-/post-
9253 !! shock region, at an angle with respect to the axes of the
9254 !! Cartesian coordinate system. The geometry of the patch is
9255 !! well-defined when its centroid and normal vector, aimed
9256 !! in the sweep direction, are provided. Note that the sweep
9257 !! line patch DOES allow the smoothing of its boundary.
9258 !! @param patch_id is the patch identifier
9259 !! @param patch_id_fp Array to track patch ids
9260 !! @param q_prim_vf Array of primitive variables
9261 subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
9262
9263 integer, intent(in) :: patch_id
9264#ifdef MFC_MIXED_PRECISION
9265 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
9266#else
9267 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
9268#endif
9269 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
9270
9271 integer :: i, j, k !< Generic loop operators
9272 real(wp) :: a, b, c
9273 integer :: xRows, yRows, nRows, iix, iiy, max_files
9274# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9275 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
9276# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9277 real(wp) :: x_len, x_step, y_len, y_step
9278# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9279 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
9280# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9281 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
9282# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9283 real(wp) :: delta_x, delta_y
9284# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9285 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
9286# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9287 character(len=200) :: errmsg
9288# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9289 real(wp), allocatable :: stored_values(:, :, :)
9290# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9291 real(wp), allocatable :: x_coords(:), y_coords(:)
9292# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9293 logical :: files_loaded = .false.
9294# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9295 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
9296# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9297 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
9298# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9299 character(len=20) :: file_num_str ! For storing the file number as a string
9300# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9301 character(len=20) :: zeros_part ! For the trailing zeros part
9302# 838 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9303 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
9304 ! Place any declaration of intermediate variables here
9305# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9306 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
9307# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9308 real(wp) :: eps
9309# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9310
9311# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9312 ! IGR Jets
9313# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9314 ! Arrays to stor position and radii of jets from input file
9315# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9316 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
9317# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9318 ! Variables to describe initial condition of jet
9319# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9320 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
9321# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9322 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
9323# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9324
9325# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9326 real(wp), dimension(0:n, 0:p) :: rcut_arr
9327# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9328 integer :: l, q, s ! Iterators for reading input files
9329# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9330 integer :: start, end ! Ints to keep track of position in file
9331# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9332 character(len=1000) :: line ! String to store line in ile
9333# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9334 character(len=25) :: value ! String to store value in line
9335# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9336 integer :: NJet ! Number of jets
9337# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9338
9339# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9340 eps = 1e-9_wp
9341# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9342
9343# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9344 if (patch_icpp(patch_id)%hcid == 303) then
9345# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9346 eps_smooth = 3._wp
9347# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9348 open (unit=10, file="njet.txt", status="old", action="read")
9349# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9350 read (10, *) njet
9351# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9352 close (10)
9353# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9354
9355# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9356 allocate (y_th_arr(0:njet - 1))
9357# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9358 allocate (z_th_arr(0:njet - 1))
9359# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9360 allocate (r_th_arr(0:njet - 1))
9361# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9362
9363# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9364 open (unit=10, file="jets.csv", status="old", action="read")
9365# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9366 do q = 0, njet - 1
9367# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9368 read (10, '(A)') line ! Read a full line as a string
9369# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9370 start = 1
9371# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9372
9373# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9374 do l = 0, 2
9375# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9376 end = index(line(start:), ',') ! Find the next comma
9377# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9378 if (end == 0) then
9379# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9380 value = trim(adjustl(line(start:))) ! Last value in the line
9381# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9382 else
9383# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9384 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
9385# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9386 start = start + end ! Move to next value
9387# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9388 end if
9389# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9390 if (l == 0) then
9391# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9392 read (value, *) y_th_arr(q) ! Convert string to numeric value
9393# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9394 elseif (l == 1) then
9395# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9396 read (value, *) z_th_arr(q)
9397# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9398 else
9399# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9400 read (value, *) r_th_arr(q)
9401# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9402 end if
9403# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9404 end do
9405# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9406 end do
9407# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9408 close (10)
9409# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9410
9411# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9412 do q = 0, p
9413# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9414 do l = 0, n
9415# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9416 rcut = 0._wp
9417# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9418 do s = 0, njet - 1
9419# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9420 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
9421# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9422 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
9423# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9424 end do
9425# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9426 rcut_arr(l, q) = rcut
9427# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9428 end do
9429# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9430 end do
9431# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9432 end if
9433# 839 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9434
9435
9436 ! Transferring the centroid information of the line to be swept
9437 x_centroid = patch_icpp(patch_id)%x_centroid
9438 y_centroid = patch_icpp(patch_id)%y_centroid
9439 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
9440 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
9441
9442 ! Obtaining coefficients of the equation describing the sweep line
9443 a = patch_icpp(patch_id)%normal(1)
9444 b = patch_icpp(patch_id)%normal(2)
9445 c = -a*x_centroid - b*y_centroid
9446
9447 ! Initializing the pseudo volume fraction value to 1. The value will
9448 ! be modified as the patch is laid out on the grid, but only in the
9449 ! case that smoothing of the sweep line patch's boundary is enabled.
9450 eta = 1._wp
9451
9452 ! Checking whether the region swept by the line covers a particular
9453 ! cell in the domain and verifying whether the current patch has the
9454 ! permission to write to that cell. If both queries check out, the
9455 ! primitive variables of the current patch are written to this cell.
9456 do j = 0, n
9457 do i = 0, m
9458
9459 if (patch_icpp(patch_id)%smoothen) then
9460 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy) &
9461 *(a*x_cc(i) + b*y_cc(j) + c) &
9462 /sqrt(a**2 + b**2))
9463 end if
9464
9465 if ((a*x_cc(i) + b*y_cc(j) + c >= 0._wp &
9466 .and. &
9467 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
9468 .or. &
9469 patch_id_fp(i, j, 0) == smooth_patch_id) &
9470 then
9471 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
9472 eta, q_prim_vf, patch_id_fp)
9473
9474
9475 if (patch_icpp(patch_id)%hcid /= dflt_int) then
9476
9477# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9478 select case (patch_icpp(patch_id)%hcid)
9479# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9480 case (300) ! Rayleigh-Taylor instability
9481# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9482 rhoh = 3._wp
9483# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9484 rhol = 1._wp
9485# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9486 pref = 1.e5_wp
9487# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9488 pint = pref
9489# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9490 h = 0.7_wp
9491# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9492 lam = 0.2_wp
9493# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9494 wl = 2._wp*pi/lam
9495# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9496 amp = 0.025_wp/wl
9497# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9498
9499# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9500 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
9501# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9502
9503# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9504 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
9505# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9506
9507# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9508 if (alph < eps) alph = eps
9509# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9510 if (alph > 1._wp - eps) alph = 1._wp - eps
9511# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9512
9513# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9514 if (y_cc(j) > inth) then
9515# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9516 q_prim_vf(advxb)%sf(i, j, k) = alph
9517# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9518 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
9519# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9520 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
9521# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9522 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
9523# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9524 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
9525# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9526 else
9527# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9528 q_prim_vf(advxb)%sf(i, j, k) = alph
9529# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9530 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
9531# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9532 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
9533# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9534 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
9535# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9536 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
9537# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9538 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
9539# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9540 end if
9541# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9542
9543# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9544 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
9545# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9546 h = 0.0_wp
9547# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9548 lam = 1.0_wp
9549# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9550 amp = patch_icpp(patch_id)%a(2)
9551# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9552 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
9553# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9554 if (x_cc(i) > inth) then
9555# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9556 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
9557# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9558 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
9559# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9560 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
9561# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9562 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
9563# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9564 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
9565# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9566 end if
9567# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9568
9569# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9570 case (302) ! 3D Jet with IGR
9571# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9572 ux_th = 10*sqrt(1.4*0.4)
9573# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9574 ux_am = 0.0*sqrt(1.4)
9575# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9576 p_th = 2.0_wp
9577# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9578 p_am = 1.0_wp
9579# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9580 rho_th = 1._wp
9581# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9582 rho_am = 1._wp
9583# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9584 y_th = 0.0_wp
9585# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9586 z_th = 0.0_wp
9587# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9588 r_th = 1._wp
9589# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9590 eps_smooth = 1._wp
9591# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9592 eps = 1e-6
9593# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9594
9595# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9596 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
9597# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9598 rcut = f_cut_on(r - r_th, eps_smooth)
9599# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9600 xcut = f_cut_on(x_cc(i), eps_smooth)
9601# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9602
9603# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9604 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9605# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9606 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
9607# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9608 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
9609# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9610
9611# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9612 if (num_fluids == 1) then
9613# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9614 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9615# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9616 else
9617# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9618 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9619# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9620 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
9621# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9622 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
9623# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9624 end if
9625# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9626
9627# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9628 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
9629# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9630
9631# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9632 case (303) ! 3D Multijet
9633# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9634
9635# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9636 eps_smooth = 3.0_wp
9637# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9638 ux_th = 10*sqrt(1.4*0.4)
9639# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9640 ux_am = 2.5*sqrt(1.4*0.4)
9641# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9642 p_th = 0.8_wp
9643# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9644 p_am = 0.4_wp
9645# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9646 rho_th = 1._wp
9647# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9648 rho_am = 1._wp
9649# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9650 eps = 1e-6
9651# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9652
9653# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9654 rcut = rcut_arr(j, k)
9655# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9656 xcut = f_cut_on(x_cc(i), eps_smooth)
9657# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9658
9659# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9660 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
9661# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9662 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
9663# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9664 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
9665# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9666
9667# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9668 if (num_fluids == 1) then
9669# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9670 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
9671# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9672 else
9673# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9674 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
9675# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9676 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
9677# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9678 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
9679# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9680 end if
9681# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9682
9683# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9684 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
9685# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9686
9687# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9688 case (370)
9689# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9690 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
9691# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9692
9693# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9694 if (.not. files_loaded) then
9695# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9696 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
9697# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9698 do f = 1, max_files
9699# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9700 write (file_num_str, '(I0)') f
9701# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9702 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
9703# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9704 end do
9705# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9706
9707# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9708 ! Common file reading setup
9709# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9710 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9711# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9712 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
9713# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9714
9715# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9716 select case (num_dims)
9717# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9718 case (1, 2) ! 1D and 2D cases are similar
9719# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9720 ! Count lines
9721# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9722 line_count = 0
9723# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9724 do
9725# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9726 read (unit2, *, iostat=ios2) dummy_x, dummy_y
9727# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9728 if (ios2 /= 0) exit
9729# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9730 line_count = line_count + 1
9731# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9732 end do
9733# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9734 close (unit2)
9735# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9736
9737# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9738 xrows = line_count
9739# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9740 yrows = 1
9741# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9742 index_x = 0
9743# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9744 if (num_dims == 2) index_x = i
9745# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9746#ifdef MFC_DEBUG
9747# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9748 block
9749# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9750 use iso_fortran_env, only: output_unit
9751# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9752
9753# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9754 print *, 'm_icpp_patches.fpp:881: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
9755# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9756
9757# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9758 call flush (output_unit)
9759# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9760 end block
9761# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9762#endif
9763# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9764 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
9765# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9766
9767# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9768
9769# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9770
9771# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9772#if defined(MFC_OpenACC)
9773# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9774!$acc enter data create(x_coords, stored_values)
9775# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9776#elif defined(MFC_OpenMP)
9777# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9778!$omp target enter data map(always,alloc:x_coords, stored_values)
9779# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9780#endif
9781# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9782
9783# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9784 ! Read data from all files
9785# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9786 do f = 1, max_files
9787# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9788 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9789# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9790 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
9791# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9792
9793# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9794 do iter = 1, xrows
9795# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9796 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
9797# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9798 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
9799# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9800 end do
9801# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9802 close (unit)
9803# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9804 end do
9805# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9806
9807# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9808 ! Calculate offsets
9809# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9810 domain_xstart = x_coords(1)
9811# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9812 x_step = x_cc(1) - x_cc(0)
9813# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9814 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
9815# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9816 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
9817# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9818 global_offset_x = nint(abs(delta_x)/x_step)
9819# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9820
9821# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9822 case (3) ! 3D case - determine grid structure
9823# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9824 ! Find yRows by counting rows with same x
9825# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9826 read (unit2, *, iostat=ios2) x0, y0, dummy_z
9827# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9828 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
9829# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9830
9831# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9832 yrows = 1
9833# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9834 do
9835# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9836 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9837# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9838 if (ios2 /= 0) exit
9839# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9840 if (dummy_x == x0 .and. dummy_y /= y0) then
9841# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9842 yrows = yrows + 1
9843# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9844 else
9845# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9846 exit
9847# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9848 end if
9849# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9850 end do
9851# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9852 close (unit2)
9853# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9854
9855# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9856 ! Count total rows
9857# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9858 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
9859# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9860 nrows = 0
9861# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9862 do
9863# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9864 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
9865# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9866 if (ios2 /= 0) exit
9867# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9868 nrows = nrows + 1
9869# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9870 end do
9871# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9872 close (unit2)
9873# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9874
9875# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9876 xrows = nrows/yrows
9877# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9878#ifdef MFC_DEBUG
9879# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9880 block
9881# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9882 use iso_fortran_env, only: output_unit
9883# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9884
9885# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9886 print *, 'm_icpp_patches.fpp:881: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
9887# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9888
9889# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9890 call flush (output_unit)
9891# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9892 end block
9893# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9894#endif
9895# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9896 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
9897# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9898
9899# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9900
9901# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9902
9903# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9904
9905# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9906#if defined(MFC_OpenACC)
9907# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9908!$acc enter data create(x_coords, y_coords, stored_values)
9909# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9910#elif defined(MFC_OpenMP)
9911# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9912!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
9913# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9914#endif
9915# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9916 index_x = i
9917# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9918 index_y = j
9919# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9920
9921# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9922 ! Read all files
9923# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9924 do f = 1, max_files
9925# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9926 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
9927# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9928 if (ios /= 0) then
9929# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9930 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
9931# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9932 cycle
9933# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9934 end if
9935# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9936
9937# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9938 iter = 0
9939# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9940 do iix = 1, xrows
9941# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9942 do iiy = 1, yrows
9943# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9944 iter = iter + 1
9945# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9946 if (f == 1) then
9947# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9948 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
9949# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9950 else
9951# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9952 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
9953# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9954 end if
9955# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9956 if (ios /= 0) call s_mpi_abort("Error reading data")
9957# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9958 end do
9959# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9960 end do
9961# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9962 close (unit)
9963# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9964 end do
9965# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9966
9967# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9968 ! Calculate offsets
9969# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9970 x_step = x_cc(1) - x_cc(0)
9971# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9972 y_step = y_cc(1) - y_cc(0)
9973# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9974 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
9975# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9976 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
9977# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9978 global_offset_x = nint(abs(delta_x)/x_step)
9979# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9980 global_offset_y = nint(abs(delta_y)/y_step)
9981# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9982 end select
9983# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9984
9985# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9986 files_loaded = .true.
9987# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9988 end if
9989# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9990
9991# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9992 ! Data assignment
9993# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9994 select case (num_dims)
9995# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9996 case (1)
9997# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
9998 idx = i + 1 + global_offset_x
9999# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10000 do f = 1, sys_size
10001# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10002 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
10003# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10004 end do
10005# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10006
10007# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10008 case (2)
10009# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10010 idx = i + 1 + global_offset_x - index_x
10011# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10012 do f = 1, sys_size - 1
10013# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10014 jump = merge(1, 0, f >= momxe)
10015# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10016 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
10017# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10018 end do
10019# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10020 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
10021# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10022
10023# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10024 case (3)
10025# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10026 idx = i + 1 + global_offset_x - index_x
10027# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10028 idy = j + 1 + global_offset_y - index_y
10029# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10030 do f = 1, sys_size - 1
10031# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10032 jump = merge(1, 0, f >= momxe)
10033# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10034 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
10035# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10036 end do
10037# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10038 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
10039# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10040 end select
10041# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10042
10043# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10044 case (380)
10045# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10046 ! This is patch is hard-coded for test suite optimization used in the
10047# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10048 ! 3D_TaylorGreenVortex case:
10049# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10050 ! This analytic patch used geometry 9
10051# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10052 mach = 0.1
10053# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10054 if (patch_id == 1) then
10055# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10056 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)
10057# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10058 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)
10059# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10060 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)
10061# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10062 end if
10063# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10064
10065# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10066 case default
10067# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10068 call s_int_to_str(patch_id, istr)
10069# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10070 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
10071# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10072 end select
10073# 881 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10074
10075 end if
10076
10077 ! Updating the patch identities bookkeeping variable
10078 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
10079 end if
10080
10081 end do
10082 end do
10083 if (allocated(stored_values)) then
10084# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10085#ifdef MFC_DEBUG
10086# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10087 block
10088# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10089 use iso_fortran_env, only: output_unit
10090# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10091
10092# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10093 print *, 'm_icpp_patches.fpp:890: ', '@:DEALLOCATE(stored_values)'
10094# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10095
10096# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10097 call flush (output_unit)
10098# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10099 end block
10100# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10101#endif
10102# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10103
10104# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10105#if defined(MFC_OpenACC)
10106# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10107!$acc exit data delete(stored_values)
10108# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10109#elif defined(MFC_OpenMP)
10110# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10111!$omp target exit data map(release:stored_values)
10112# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10113#endif
10114# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10115 deallocate (stored_values)
10116# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10117#ifdef MFC_DEBUG
10118# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10119 block
10120# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10121 use iso_fortran_env, only: output_unit
10122# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10123
10124# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10125 print *, 'm_icpp_patches.fpp:890: ', '@:DEALLOCATE(x_coords)'
10126# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10127
10128# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10129 call flush (output_unit)
10130# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10131 end block
10132# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10133#endif
10134# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10135
10136# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10137#if defined(MFC_OpenACC)
10138# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10139!$acc exit data delete(x_coords)
10140# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10141#elif defined(MFC_OpenMP)
10142# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10143!$omp target exit data map(release:x_coords)
10144# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10145#endif
10146# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10147 deallocate (x_coords)
10148# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10149 end if
10150# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10151
10152# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10153 if (allocated(y_coords)) then
10154# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10155#ifdef MFC_DEBUG
10156# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10157 block
10158# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10159 use iso_fortran_env, only: output_unit
10160# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10161
10162# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10163 print *, 'm_icpp_patches.fpp:890: ', '@:DEALLOCATE(y_coords)'
10164# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10165
10166# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10167 call flush (output_unit)
10168# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10169 end block
10170# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10171#endif
10172# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10173
10174# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10175#if defined(MFC_OpenACC)
10176# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10177!$acc exit data delete(y_coords)
10178# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10179#elif defined(MFC_OpenMP)
10180# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10181!$omp target exit data map(release:y_coords)
10182# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10183#endif
10184# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10185 deallocate (y_coords)
10186# 890 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10187 end if
10188
10189 end subroutine s_icpp_sweep_line
10190
10191 !> The Taylor Green vortex is 2D decaying vortex that may be used,
10192 !! for example, to verify the effects of viscous attenuation.
10193 !! Geometry of the patch is well-defined when its centroid
10194 !! are provided.
10195 !! @param patch_id is the patch identifier
10196 !! @param patch_id_fp Array to track patch ids
10197 !! @param q_prim_vf Array of primitive variables
10198 subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
10199
10200 integer, intent(in) :: patch_id
10201#ifdef MFC_MIXED_PRECISION
10202 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
10203#else
10204 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
10205#endif
10206 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
10207
10208 integer :: i, j, k !< generic loop iterators
10209 real(wp) :: pi_inf, gamma, lit_gamma !< equation of state parameters
10210 real(wp) :: L0, U0 !< Taylor Green Vortex parameters
10211 integer :: xRows, yRows, nRows, iix, iiy, max_files
10212# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10213 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
10214# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10215 real(wp) :: x_len, x_step, y_len, y_step
10216# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10217 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
10218# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10219 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
10220# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10221 real(wp) :: delta_x, delta_y
10222# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10223 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
10224# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10225 character(len=200) :: errmsg
10226# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10227 real(wp), allocatable :: stored_values(:, :, :)
10228# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10229 real(wp), allocatable :: x_coords(:), y_coords(:)
10230# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10231 logical :: files_loaded = .false.
10232# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10233 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
10234# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10235 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
10236# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10237 character(len=20) :: file_num_str ! For storing the file number as a string
10238# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10239 character(len=20) :: zeros_part ! For the trailing zeros part
10240# 914 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10241 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
10242 ! Place any declaration of intermediate variables here
10243# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10244 real(wp) :: eps, eps_mhd, C_mhd
10245# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10246 real(wp) :: r, rmax, gam, umax, p0
10247# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10248 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, intL, alph
10249# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10250 real(wp) :: factor
10251# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10252 real(wp) :: r0, alpha, r2
10253# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10254 real(wp) :: sinA, cosA
10255# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10256
10257# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10258 real(wp) :: r_sq
10259# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10260
10261# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10262 ! # 207
10263# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10264 real(wp) :: sigma, gauss1, gauss2
10265# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10266 ! # 208
10267# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10268 real(wp) :: ei, d, fsm, alpha_air, alpha_sf6
10269# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10270
10271# 915 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10272 eps = 1.e-9_wp
10273
10274 pi_inf = pi_infs(1)
10275 gamma = gammas(1)
10276 lit_gamma = gs_min(1)
10277
10278 ! Transferring the patch's centroid and length information
10279 x_centroid = patch_icpp(patch_id)%x_centroid
10280 y_centroid = patch_icpp(patch_id)%y_centroid
10281 length_x = patch_icpp(patch_id)%length_x
10282 length_y = patch_icpp(patch_id)%length_y
10283
10284 ! Computing the beginning and the end x- and y-coordinates
10285 ! of the patch based on its centroid and lengths
10286 x_boundary%beg = x_centroid - 0.5_wp*length_x
10287 x_boundary%end = x_centroid + 0.5_wp*length_x
10288 y_boundary%beg = y_centroid - 0.5_wp*length_y
10289 y_boundary%end = y_centroid + 0.5_wp*length_y
10290
10291 ! Since the patch doesn't allow for its boundaries to be
10292 ! smoothed out, the pseudo volume fraction is set to 1 to
10293 ! ensure that only the current patch contributes to the fluid
10294 ! state in the cells that this patch covers.
10295 eta = 1._wp
10296 ! U0 is the characteristic velocity of the vortex
10297 u0 = patch_icpp(patch_id)%vel(1)
10298 ! L0 is the characteristic length of the vortex
10299 l0 = patch_icpp(patch_id)%vel(2)
10300 ! Checking whether the patch covers a particular cell in the
10301 ! domain and verifying whether the current patch has the
10302 ! permission to write to that cell. If both queries check out,
10303 ! the primitive variables of the current patch are assigned
10304 ! to this cell.
10305 do j = 0, n
10306 do i = 0, m
10307 if (x_boundary%beg <= x_cc(i) .and. &
10308 x_boundary%end >= x_cc(i) .and. &
10309 y_boundary%beg <= y_cc(j) .and. &
10310 y_boundary%end >= y_cc(j) .and. &
10311 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) then
10312
10313 call s_assign_patch_primitive_variables(patch_id, i, j, 0, &
10314 eta, q_prim_vf, patch_id_fp)
10315
10316
10317 if (patch_icpp(patch_id)%hcid /= dflt_int) then
10318
10319# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10320 select case (patch_icpp(patch_id)%hcid) ! 2D_hardcoded_ic example case
10321# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10322
10323# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10324 case (200)
10325# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10326 if (y_cc(j) <= (-x_cc(i)**3 + 1)**(1._wp/3._wp)) then
10327# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10328 ! Volume Fractions
10329# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10330 q_prim_vf(advxb)%sf(i, j, 0) = eps
10331# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10332 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - eps
10333# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10334 ! Denssities
10335# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10336 q_prim_vf(contxb)%sf(i, j, 0) = eps*1000._wp
10337# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10338 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - eps)*1._wp
10339# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10340 ! Pressure
10341# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10342 q_prim_vf(e_idx)%sf(i, j, 0) = 1000._wp
10343# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10344 end if
10345# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10346 case (202) ! Gresho vortex (Gouasmi et al 2022 JCP)
10347# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10348 r = ((x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10349# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10350 rmax = 0.2_wp
10351# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10352
10353# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10354 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10355# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10356 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10357# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10358 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10359# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10360
10361# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10362 if (r < rmax) then
10363# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10364 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10365# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10366 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10367# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10368 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10369# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10370 else if (r < 2*rmax) then
10371# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10372 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10373# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10374 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10375# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10376 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2/2._wp + 4*(1 - (r/rmax) + log(r/rmax)))
10377# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10378 else
10379# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10380 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
10381# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10382 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
10383# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10384 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*(-2 + 4*log(2._wp))
10385# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10386 end if
10387# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10388 case (203) ! Gresho vortex (Gouasmi et al 2022 JCP) with density correction
10389# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10390 r = ((x_cc(i) - 0.5_wp)**2._wp + (y_cc(j) - 0.5_wp)**2)**0.5_wp
10391# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10392 rmax = 0.2_wp
10393# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10394
10395# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10396 gam = 1._wp + 1._wp/fluid_pp(1)%gamma
10397# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10398 umax = 2*pi*rmax*patch_icpp(patch_id)%vel(2)
10399# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10400 p0 = umax**2*(1._wp/(gam*patch_icpp(patch_id)%vel(2)**2) - 0.5_wp)
10401# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10402
10403# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10404 if (r < rmax) then
10405# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10406 q_prim_vf(momxb)%sf(i, j, 0) = -(y_cc(j) - 0.5_wp)*umax/rmax
10407# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10408 q_prim_vf(momxe)%sf(i, j, 0) = (x_cc(i) - 0.5_wp)*umax/rmax
10409# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10410 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2*((r/rmax)**2._wp/2._wp)
10411# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10412 else if (r < 2*rmax) then
10413# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10414 q_prim_vf(momxb)%sf(i, j, 0) = -((y_cc(j) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10415# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10416 q_prim_vf(momxe)%sf(i, j, 0) = ((x_cc(i) - 0.5_wp)/r)*umax*(2._wp - r/rmax)
10417# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10418 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)))
10419# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10420 else
10421# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10422 q_prim_vf(momxb)%sf(i, j, 0) = 0._wp
10423# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10424 q_prim_vf(momxe)%sf(i, j, 0) = 0._wp
10425# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10426 q_prim_vf(e_idx)%sf(i, j, 0) = p0 + umax**2._wp*(-2._wp + 4*log(2._wp))
10427# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10428 end if
10429# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10430
10431# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10432 q_prim_vf(contxb)%sf(i, j, 0) = q_prim_vf(e_idx)%sf(i, j, 0)**(1._wp/gam)
10433# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10434 case (204) ! Rayleigh-Taylor instability
10435# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10436 rhoh = 3._wp
10437# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10438 rhol = 1._wp
10439# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10440 pref = 1.e5_wp
10441# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10442 pint = pref
10443# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10444 h = 0.7_wp
10445# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10446 lam = 0.2_wp
10447# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10448 wl = 2._wp*pi/lam
10449# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10450 amp = 0.05_wp/wl
10451# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10452
10453# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10454 inth = amp*sin(2._wp*pi*x_cc(i)/lam - pi/2._wp) + h
10455# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10456
10457# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10458 alph = 0.5_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
10459# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10460
10461# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10462 if (alph < eps) alph = eps
10463# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10464 if (alph > 1._wp - eps) alph = 1._wp - eps
10465# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10466
10467# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10468 if (y_cc(j) > inth) then
10469# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10470 q_prim_vf(advxb)%sf(i, j, 0) = alph
10471# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10472 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
10473# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10474 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
10475# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10476 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
10477# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10478 q_prim_vf(e_idx)%sf(i, j, 0) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
10479# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10480 else
10481# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10482 q_prim_vf(advxb)%sf(i, j, 0) = alph
10483# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10484 q_prim_vf(advxe)%sf(i, j, 0) = 1._wp - alph
10485# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10486 q_prim_vf(contxb)%sf(i, j, 0) = alph*rhoh
10487# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10488 q_prim_vf(contxe)%sf(i, j, 0) = (1._wp - alph)*rhol
10489# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10490 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
10491# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10492 q_prim_vf(e_idx)%sf(i, j, 0) = pint + rhol*9.81_wp*(inth - y_cc(j))
10493# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10494 end if
10495# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10496
10497# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10498 case (205) ! 2D lung wave interaction problem
10499# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10500 h = 0.0_wp !non dim origin y
10501# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10502 lam = 1.0_wp !non dim lambda
10503# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10504 amp = patch_icpp(patch_id)%a(2) !to be changed later! !non dim amplitude
10505# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10506
10507# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10508 inth = amp*sin(2*pi*x_cc(i)/lam - pi/2) + h
10509# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10510
10511# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10512 if (y_cc(j) > inth) then
10513# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10514 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10515# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10516 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10517# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10518 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
10519# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10520 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10521# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10522 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10523# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10524 end if
10525# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10526
10527# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10528 case (206) ! 2D lung wave interaction problem - horizontal domain
10529# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10530 h = 0.0_wp !non dim origin y
10531# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10532 lam = 1.0_wp !non dim lambda
10533# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10534 amp = patch_icpp(patch_id)%a(2)
10535# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10536
10537# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10538 intl = amp*sin(2*pi*y_cc(j)/lam - pi/2) + h
10539# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10540
10541# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10542 if (x_cc(i) > intl) then !this is the liquid
10543# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10544 q_prim_vf(contxb)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(1)
10545# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10546 q_prim_vf(contxe)%sf(i, j, 0) = patch_icpp(1)%alpha_rho(2)
10547# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10548 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(1)%pres
10549# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10550 q_prim_vf(advxb)%sf(i, j, 0) = patch_icpp(1)%alpha(1)
10551# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10552 q_prim_vf(advxe)%sf(i, j, 0) = patch_icpp(1)%alpha(2)
10553# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10554 end if
10555# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10556
10557# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10558 case (207) ! Kelvin Helmholtz Instability
10559# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10560 sigma = 0.05_wp/sqrt(2.0_wp)
10561# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10562 gauss1 = exp(-(y_cc(j) - 0.75_wp)**2/(2.0_wp*sigma**2))
10563# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10564 gauss2 = exp(-(y_cc(j) - 0.25_wp)**2/(2.0_wp*sigma**2))
10565# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10566 q_prim_vf(momxb + 1)%sf(i, j, 0) = &
10567# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10568 0.1_wp*sin(4.0_wp*pi*x_cc(i))*(gauss1 + gauss2)
10569# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10570
10571# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10572 case (208) ! Richtmeyer Meshkov Instability
10573# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10574 lam = 1.0_wp
10575# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10576 eps = 1.0e-6_wp
10577# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10578 ei = 5.0_wp
10579# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10580 ! Smoothening function to smooth out sharp discontinuity in the interface
10581# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10582 if (x_cc(i) <= 0.7_wp*lam) then
10583# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10584 d = x_cc(i) - lam*(0.4_wp - 0.1_wp*sin(2.0_wp*pi*(y_cc(j)/lam + 0.25_wp)))
10585# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10586 fsm = 0.5_wp*(1.0_wp + erf(d/(ei*sqrt(dx*dy))))
10587# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10588 alpha_air = eps + (1.0_wp - 2.0_wp*eps)*fsm
10589# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10590 alpha_sf6 = 1.0_wp - alpha_air
10591# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10592 q_prim_vf(contxb)%sf(i, j, 0) = alpha_sf6*5.04_wp
10593# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10594 q_prim_vf(contxe)%sf(i, j, 0) = alpha_air*1.0_wp
10595# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10596 q_prim_vf(advxb)%sf(i, j, 0) = alpha_sf6
10597# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10598 q_prim_vf(advxe)%sf(i, j, 0) = alpha_air
10599# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10600 end if
10601# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10602
10603# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10604 case (250) ! MHD Orszag-Tang vortex
10605# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10606 ! gamma = 5/3
10607# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10608 ! rho = 25/(36*pi)
10609# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10610 ! p = 5/(12*pi)
10611# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10612 ! v = (-sin(2*pi*y), sin(2*pi*x), 0)
10613# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10614 ! B = (-sin(2*pi*y)/sqrt(4*pi), sin(4*pi*x)/sqrt(4*pi), 0)
10615# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10616
10617# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10618 q_prim_vf(momxb)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))
10619# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10620 q_prim_vf(momxb + 1)%sf(i, j, 0) = sin(2._wp*pi*x_cc(i))
10621# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10622
10623# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10624 q_prim_vf(b_idx%beg)%sf(i, j, 0) = -sin(2._wp*pi*y_cc(j))/sqrt(4._wp*pi)
10625# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10626 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = sin(4._wp*pi*x_cc(i))/sqrt(4._wp*pi)
10627# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10628
10629# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10630 case (251) ! RMHD Cylindrical Blast Wave [Mignone, 2006: Section 4.3.1]
10631# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10632 if (x_cc(i)**2 + y_cc(j)**2 < 0.08_wp**2) then
10633# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10634 q_prim_vf(contxb)%sf(i, j, 0) = 0.01
10635# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10636 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0
10637# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10638 elseif (x_cc(i)**2 + y_cc(j)**2 <= 1._wp**2) then
10639# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10640 ! Linear interpolation between r=0.08 and r=1.0
10641# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10642 factor = (1.0_wp - sqrt(x_cc(i)**2 + y_cc(j)**2))/(1.0_wp - 0.08_wp)
10643# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10644 q_prim_vf(contxb)%sf(i, j, 0) = 0.01_wp*factor + 1.e-4_wp*(1.0_wp - factor)
10645# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10646 q_prim_vf(e_idx)%sf(i, j, 0) = 1.0_wp*factor + 3.e-5_wp*(1.0_wp - factor)
10647# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10648 else
10649# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10650 q_prim_vf(contxb)%sf(i, j, 0) = 1.e-4_wp
10651# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10652 q_prim_vf(e_idx)%sf(i, j, 0) = 3.e-5_wp
10653# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10654 end if
10655# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10656
10657# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10658 ! case 252 is for the 2D MHD Rotor problem
10659# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10660 case (252) ! 2D MHD Rotor Problem
10661# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10662 ! Ambient conditions are set in the JSON file.
10663# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10664 ! This case imposes the dense, rotating cylinder.
10665# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10666 !
10667# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10668 ! gamma = 1.4
10669# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10670 ! Ambient medium (r > 0.1):
10671# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10672 ! rho = 1, p = 1, v = 0, B = (1,0,0)
10673# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10674 ! Rotor (r <= 0.1):
10675# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10676 ! rho = 10, p = 1
10677# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10678 ! v has angular velocity w=20, giving v_tan=2 at r=0.1
10679# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10680
10681# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10682 ! Calculate distance squared from the center
10683# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10684 r_sq = (x_cc(i) - 0.5_wp)**2 + (y_cc(j) - 0.5_wp)**2
10685# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10686
10687# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10688 ! inner radius of 0.1
10689# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10690 if (r_sq <= 0.1**2) then
10691# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10692 ! -- Inside the rotor --
10693# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10694 ! Set density uniformly to 10
10695# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10696 q_prim_vf(contxb)%sf(i, j, 0) = 10._wp
10697# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10698
10699# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10700 ! Set vup constant rotation of rate v=2
10701# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10702 ! v_x = -omega * (y - y_c)
10703# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10704 ! v_y = omega * (x - x_c)
10705# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10706 q_prim_vf(momxb)%sf(i, j, 0) = -20._wp*(y_cc(j) - 0.5_wp)
10707# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10708 q_prim_vf(momxb + 1)%sf(i, j, 0) = 20._wp*(x_cc(i) - 0.5_wp)
10709# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10710
10711# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10712 ! taper width of 0.015
10713# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10714 else if (r_sq <= 0.115**2) then
10715# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10716 ! linearly smooth the function between r = 0.1 and 0.115
10717# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10718 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp + 9._wp*(0.115_wp - sqrt(r_sq))/(0.015_wp)
10719# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10720
10721# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10722 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)
10723# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10724 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)
10725# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10726 end if
10727# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10728
10729# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10730 case (253) ! MHD Smooth Magnetic Vortex
10731# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10732 ! Section 5.2 of
10733# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10734 ! Implicit hybridized discontinuous Galerkin methods for compressible magnetohydrodynamics
10735# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10736 ! C. Ciuca, P. Fernandez, A. Christophe, N.C. Nguyen, J. Peraire
10737# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10738
10739# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10740 ! velocity
10741# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10742 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))
10743# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10744 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))
10745# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10746
10747# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10748 ! magnetic field
10749# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10750 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)
10751# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10752 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)
10753# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10754
10755# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10756 ! pressure
10757# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10758 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)
10759# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10760
10761# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10762 case (260) ! Gaussian Divergence Pulse
10763# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10764 ! Bx(x) = 1 + C * erf((x-0.5)/σ)
10765# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10766 ! ⇒ ∂Bx/∂x = C * (2/√π) * exp[-((x-0.5)/σ)**2] * (1/σ)
10767# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10768 ! Choose C = ε * σ * √π / 2 ⇒ ∂Bx/∂x = ε * exp[-((x-0.5)/σ)**2]
10769# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10770 ! ψ is initialized to zero everywhere.
10771# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10772
10773# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10774 eps_mhd = patch_icpp(patch_id)%a(2)
10775# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10776 sigma = patch_icpp(patch_id)%a(3)
10777# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10778 c_mhd = eps_mhd*sigma*sqrt(pi)*0.5_wp
10779# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10780
10781# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10782 ! B-field
10783# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10784 q_prim_vf(b_idx%beg)%sf(i, j, 0) = 1._wp + c_mhd*erf((x_cc(i) - 0.5_wp)/sigma)
10785# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10786
10787# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10788 case (261) ! Blob
10789# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10790 r0 = 1._wp/sqrt(8._wp)
10791# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10792 r2 = x_cc(i)**2 + y_cc(j)**2
10793# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10794 r = sqrt(r2)
10795# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10796 alpha = r/r0
10797# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10798 if (alpha < 1) then
10799# 961 "/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/sqrt(4._wp*pi)*(alpha**8 - 2._wp*alpha**4 + 1._wp)
10801# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10802 ! 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)
10803# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10804 ! q_prim_vf(B_idx%beg)%sf(i,j,0) = 1._wp/(4._wp*pi) * (alpha**8 - 2._wp*alpha**4 + 1._wp)
10805# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10806 ! q_prim_vf(E_idx)%sf(i,j,0) = 6._wp - q_prim_vf(B_idx%beg)%sf(i,j,0)**2/2._wp
10807# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10808 end if
10809# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10810
10811# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10812 case (262) ! Tilted 2D MHD shock‐tube at α = arctan2 (≈63.4°)
10813# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10814 ! rotate by α = atan(2)
10815# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10816 alpha = atan(2._wp)
10817# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10818 cosa = cos(alpha)
10819# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10820 sina = sin(alpha)
10821# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10822 ! projection along shock normal
10823# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10824 r = x_cc(i)*cosa + y_cc(j)*sina
10825# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10826
10827# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10828 if (r <= 0.5_wp) then
10829# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10830 ! LEFT state: ρ=1, v∥=+10, v⊥=0, p=20, B∥=B⊥=5/√(4π)
10831# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10832 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
10833# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10834 q_prim_vf(momxb)%sf(i, j, 0) = 10._wp*cosa
10835# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10836 q_prim_vf(momxb + 1)%sf(i, j, 0) = 10._wp*sina
10837# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10838 q_prim_vf(e_idx)%sf(i, j, 0) = 20._wp
10839# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10840 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
10841# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10842 - (5._wp/sqrt(4._wp*pi))*sina
10843# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10844 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
10845# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10846 + (5._wp/sqrt(4._wp*pi))*cosa
10847# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10848 else
10849# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10850 ! RIGHT state: ρ=1, v∥=−10, v⊥=0, p=1, B∥=B⊥=5/√(4π)
10851# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10852 q_prim_vf(contxb)%sf(i, j, 0) = 1._wp
10853# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10854 q_prim_vf(momxb)%sf(i, j, 0) = -10._wp*cosa
10855# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10856 q_prim_vf(momxb + 1)%sf(i, j, 0) = -10._wp*sina
10857# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10858 q_prim_vf(e_idx)%sf(i, j, 0) = 1._wp
10859# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10860 q_prim_vf(b_idx%beg)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*cosa &
10861# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10862 - (5._wp/sqrt(4._wp*pi))*sina
10863# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10864 q_prim_vf(b_idx%beg + 1)%sf(i, j, 0) = (5._wp/sqrt(4._wp*pi))*sina &
10865# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10866 + (5._wp/sqrt(4._wp*pi))*cosa
10867# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10868 end if
10869# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10870 ! v^z and B^z remain zero by default
10871# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10872
10873# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10874 case (270)
10875# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10876 ! This hardcoded case extrudes a 1D profile to initialize a 2D simulation domain
10877# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10878
10879# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10880 if (.not. files_loaded) then
10881# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10882 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
10883# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10884 do f = 1, max_files
10885# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10886 write (file_num_str, '(I0)') f
10887# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10888 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
10889# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10890 end do
10891# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10892
10893# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10894 ! Common file reading setup
10895# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10896 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
10897# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10898 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
10899# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10900
10901# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10902 select case (num_dims)
10903# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10904 case (1, 2) ! 1D and 2D cases are similar
10905# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10906 ! Count lines
10907# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10908 line_count = 0
10909# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10910 do
10911# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10912 read (unit2, *, iostat=ios2) dummy_x, dummy_y
10913# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10914 if (ios2 /= 0) exit
10915# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10916 line_count = line_count + 1
10917# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10918 end do
10919# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10920 close (unit2)
10921# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10922
10923# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10924 xrows = line_count
10925# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10926 yrows = 1
10927# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10928 index_x = 0
10929# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10930 if (num_dims == 2) index_x = i
10931# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10932#ifdef MFC_DEBUG
10933# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10934 block
10935# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10936 use iso_fortran_env, only: output_unit
10937# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10938
10939# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10940 print *, 'm_icpp_patches.fpp:961: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
10941# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10942
10943# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10944 call flush (output_unit)
10945# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10946 end block
10947# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10948#endif
10949# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10950 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
10951# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10952
10953# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10954
10955# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10956
10957# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10958#if defined(MFC_OpenACC)
10959# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10960!$acc enter data create(x_coords, stored_values)
10961# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10962#elif defined(MFC_OpenMP)
10963# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10964!$omp target enter data map(always,alloc:x_coords, stored_values)
10965# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10966#endif
10967# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10968
10969# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10970 ! Read data from all files
10971# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10972 do f = 1, max_files
10973# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10974 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
10975# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10976 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
10977# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10978
10979# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10980 do iter = 1, xrows
10981# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10982 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
10983# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10984 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
10985# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10986 end do
10987# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10988 close (unit)
10989# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10990 end do
10991# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10992
10993# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10994 ! Calculate offsets
10995# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10996 domain_xstart = x_coords(1)
10997# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
10998 x_step = x_cc(1) - x_cc(0)
10999# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11000 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
11001# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11002 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
11003# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11004 global_offset_x = nint(abs(delta_x)/x_step)
11005# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11006
11007# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11008 case (3) ! 3D case - determine grid structure
11009# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11010 ! Find yRows by counting rows with same x
11011# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11012 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11013# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11014 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11015# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11016
11017# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11018 yrows = 1
11019# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11020 do
11021# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11022 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11023# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11024 if (ios2 /= 0) exit
11025# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11026 if (dummy_x == x0 .and. dummy_y /= y0) then
11027# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11028 yrows = yrows + 1
11029# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11030 else
11031# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11032 exit
11033# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11034 end if
11035# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11036 end do
11037# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11038 close (unit2)
11039# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11040
11041# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11042 ! Count total rows
11043# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11044 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11045# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11046 nrows = 0
11047# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11048 do
11049# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11050 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11051# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11052 if (ios2 /= 0) exit
11053# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11054 nrows = nrows + 1
11055# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11056 end do
11057# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11058 close (unit2)
11059# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11060
11061# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11062 xrows = nrows/yrows
11063# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11064#ifdef MFC_DEBUG
11065# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11066 block
11067# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11068 use iso_fortran_env, only: output_unit
11069# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11070
11071# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11072 print *, 'm_icpp_patches.fpp:961: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11073# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11074
11075# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11076 call flush (output_unit)
11077# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11078 end block
11079# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11080#endif
11081# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11082 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11083# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11084
11085# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11086
11087# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11088
11089# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11090
11091# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11092#if defined(MFC_OpenACC)
11093# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11094!$acc enter data create(x_coords, y_coords, stored_values)
11095# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11096#elif defined(MFC_OpenMP)
11097# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11098!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11099# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11100#endif
11101# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11102 index_x = i
11103# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11104 index_y = j
11105# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11106
11107# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11108 ! Read all files
11109# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11110 do f = 1, max_files
11111# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11112 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11113# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11114 if (ios /= 0) then
11115# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11116 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
11117# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11118 cycle
11119# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11120 end if
11121# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11122
11123# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11124 iter = 0
11125# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11126 do iix = 1, xrows
11127# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11128 do iiy = 1, yrows
11129# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11130 iter = iter + 1
11131# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11132 if (f == 1) then
11133# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11134 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11135# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11136 else
11137# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11138 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11139# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11140 end if
11141# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11142 if (ios /= 0) call s_mpi_abort("Error reading data")
11143# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11144 end do
11145# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11146 end do
11147# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11148 close (unit)
11149# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11150 end do
11151# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11152
11153# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11154 ! Calculate offsets
11155# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11156 x_step = x_cc(1) - x_cc(0)
11157# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11158 y_step = y_cc(1) - y_cc(0)
11159# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11160 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
11161# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11162 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
11163# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11164 global_offset_x = nint(abs(delta_x)/x_step)
11165# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11166 global_offset_y = nint(abs(delta_y)/y_step)
11167# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11168 end select
11169# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11170
11171# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11172 files_loaded = .true.
11173# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11174 end if
11175# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11176
11177# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11178 ! Data assignment
11179# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11180 select case (num_dims)
11181# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11182 case (1)
11183# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11184 idx = i + 1 + global_offset_x
11185# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11186 do f = 1, sys_size
11187# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11188 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11189# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11190 end do
11191# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11192
11193# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11194 case (2)
11195# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11196 idx = i + 1 + global_offset_x - index_x
11197# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11198 do f = 1, sys_size - 1
11199# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11200 jump = merge(1, 0, f >= momxe)
11201# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11202 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11203# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11204 end do
11205# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11206 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
11207# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11208
11209# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11210 case (3)
11211# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11212 idx = i + 1 + global_offset_x - index_x
11213# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11214 idy = j + 1 + global_offset_y - index_y
11215# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11216 do f = 1, sys_size - 1
11217# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11218 jump = merge(1, 0, f >= momxe)
11219# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11220 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11221# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11222 end do
11223# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11224 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
11225# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11226 end select
11227# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11228
11229# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11230 case (280)
11231# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11232 ! This is patch is hard-coded for test suite optimization used in the
11233# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11234 ! 2D_isentropicvortex case:
11235# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11236 ! This analytic patch uses geometry 2
11237# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11238 if (patch_id == 1) then
11239# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11240 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)
11241# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11242 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
11243# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11244 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))
11245# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11246 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))
11247# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11248 end if
11249# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11250
11251# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11252 case (281)
11253# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11254 ! This is patch is hard-coded for test suite optimization used in the
11255# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11256 ! 2D_acoustic_pulse case:
11257# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11258 ! This analytic patch uses geometry 2
11259# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11260 if (patch_id == 2) then
11261# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11262 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))
11263# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11264 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))
11265# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11266 end if
11267# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11268
11269# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11270 case (282)
11271# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11272 ! This is patch is hard-coded for test suite optimization used in the
11273# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11274 ! 2D_zero_circ_vortex case:
11275# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11276 ! This analytic patch uses geometry 2
11277# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11278 if (patch_id == 2) then
11279# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11280 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))
11281# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11282 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))
11283# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11284 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)))
11285# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11286 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)))
11287# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11288 end if
11289# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11290
11291# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11292 case default
11293# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11294 if (proc_rank == 0) then
11295# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11296 call s_int_to_str(patch_id, istr)
11297# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11298 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
11299# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11300 end if
11301# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11302
11303# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11304 end select
11305# 961 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11306
11307 end if
11308
11309 ! Updating the patch identities bookkeeping variable
11310 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, 0) = patch_id
11311
11312 ! Assign Parameters
11313 q_prim_vf(mom_idx%beg)%sf(i, j, 0) = u0*sin(x_cc(i)/l0)*cos(y_cc(j)/l0)
11314 q_prim_vf(mom_idx%end)%sf(i, j, 0) = -u0*cos(x_cc(i)/l0)*sin(y_cc(j)/l0)
11315 q_prim_vf(e_idx)%sf(i, j, 0) = patch_icpp(patch_id)%pres + (cos(2*x_cc(i))/l0 + &
11316 cos(2*y_cc(j))/l0)* &
11317 (q_prim_vf(1)%sf(i, j, 0)*u0*u0)/16
11318 end if
11319 end do
11320 end do
11321 if (allocated(stored_values)) then
11322# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11323#ifdef MFC_DEBUG
11324# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11325 block
11326# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11327 use iso_fortran_env, only: output_unit
11328# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11329
11330# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11331 print *, 'm_icpp_patches.fpp:976: ', '@:DEALLOCATE(stored_values)'
11332# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11333
11334# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11335 call flush (output_unit)
11336# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11337 end block
11338# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11339#endif
11340# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11341
11342# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11343#if defined(MFC_OpenACC)
11344# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11345!$acc exit data delete(stored_values)
11346# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11347#elif defined(MFC_OpenMP)
11348# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11349!$omp target exit data map(release:stored_values)
11350# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11351#endif
11352# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11353 deallocate (stored_values)
11354# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11355#ifdef MFC_DEBUG
11356# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11357 block
11358# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11359 use iso_fortran_env, only: output_unit
11360# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11361
11362# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11363 print *, 'm_icpp_patches.fpp:976: ', '@:DEALLOCATE(x_coords)'
11364# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11365
11366# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11367 call flush (output_unit)
11368# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11369 end block
11370# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11371#endif
11372# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11373
11374# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11375#if defined(MFC_OpenACC)
11376# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11377!$acc exit data delete(x_coords)
11378# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11379#elif defined(MFC_OpenMP)
11380# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11381!$omp target exit data map(release:x_coords)
11382# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11383#endif
11384# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11385 deallocate (x_coords)
11386# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11387 end if
11388# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11389
11390# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11391 if (allocated(y_coords)) then
11392# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11393#ifdef MFC_DEBUG
11394# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11395 block
11396# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11397 use iso_fortran_env, only: output_unit
11398# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11399
11400# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11401 print *, 'm_icpp_patches.fpp:976: ', '@:DEALLOCATE(y_coords)'
11402# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11403
11404# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11405 call flush (output_unit)
11406# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11407 end block
11408# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11409#endif
11410# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11411
11412# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11413#if defined(MFC_OpenACC)
11414# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11415!$acc exit data delete(y_coords)
11416# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11417#elif defined(MFC_OpenMP)
11418# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11419!$omp target exit data map(release:y_coords)
11420# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11421#endif
11422# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11423 deallocate (y_coords)
11424# 976 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11425 end if
11426
11427 end subroutine s_icpp_2d_taylorgreen_vortex
11428
11429 !> @brief Initializes a 1D bubble-pulse patch with analytical primitive variable profiles.
11430 !! @param patch_id is the patch identifier
11431 !! @param patch_id_fp Array to track patch ids
11432 !! @param q_prim_vf Array of primitive variables
11433 subroutine s_icpp_1d_bubble_pulse(patch_id, patch_id_fp, q_prim_vf)
11434 ! Description: This patch assigns the primitive variables as analytical
11435 ! functions such that the code can be verified.
11436
11437 ! Patch identifier
11438 integer, intent(in) :: patch_id
11439#ifdef MFC_MIXED_PRECISION
11440 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
11441#else
11442 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
11443#endif
11444 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
11445
11446 ! Generic loop iterators
11447 integer :: i, j, k
11448 ! Placeholders for the cell boundary values
11449 real(wp) :: pi_inf, gamma, lit_gamma
11450 integer :: xRows, yRows, nRows, iix, iiy, max_files
11451# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11452 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
11453# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11454 real(wp) :: x_len, x_step, y_len, y_step
11455# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11456 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
11457# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11458 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
11459# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11460 real(wp) :: delta_x, delta_y
11461# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11462 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
11463# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11464 character(len=200) :: errmsg
11465# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11466 real(wp), allocatable :: stored_values(:, :, :)
11467# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11468 real(wp), allocatable :: x_coords(:), y_coords(:)
11469# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11470 logical :: files_loaded = .false.
11471# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11472 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
11473# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11474 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
11475# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11476 character(len=20) :: file_num_str ! For storing the file number as a string
11477# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11478 character(len=20) :: zeros_part ! For the trailing zeros part
11479# 1001 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11480 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
11481 ! Place any declaration of intermediate variables here
11482# 1002 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11483 real(wp) :: x_mid_diffu, width_sq, profile_shape, temp, molar_mass_inv, y1, y2, y3, y4
11484
11485 pi_inf = pi_infs(1)
11486 gamma = gammas(1)
11487 lit_gamma = gs_min(1)
11488
11489 ! Transferring the patch's centroid and length information
11490 x_centroid = patch_icpp(patch_id)%x_centroid
11491 length_x = patch_icpp(patch_id)%length_x
11492
11493 ! Computing the beginning and the end x- and y-coordinates
11494 ! of the patch based on its centroid and lengths
11495 x_boundary%beg = x_centroid - 0.5_wp*length_x
11496 x_boundary%end = x_centroid + 0.5_wp*length_x
11497
11498 ! Since the patch doesn't allow for its boundaries to be
11499 ! smoothed out, the pseudo volume fraction is set to 1 to
11500 ! ensure that only the current patch contributes to the fluid
11501 ! state in the cells that this patch covers.
11502 eta = 1._wp
11503
11504 ! Checking whether the line segment covers a particular cell in the
11505 ! domain and verifying whether the current patch has the permission
11506 ! to write to that cell. If both queries check out, the primitive
11507 ! variables of the current patch are assigned to this cell.
11508 do i = 0, m
11509 if (x_boundary%beg <= x_cc(i) .and. &
11510 x_boundary%end >= x_cc(i) .and. &
11511 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, 0, 0))) then
11512
11513 call s_assign_patch_primitive_variables(patch_id, i, 0, 0, &
11514 eta, q_prim_vf, patch_id_fp)
11515
11516
11517 if (patch_icpp(patch_id)%hcid /= dflt_int) then
11518 select case (patch_icpp(patch_id)%hcid)
11519# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11520 case (150) ! 1D Smooth Alfven Case for MHD
11521# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11522 ! velocity
11523# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11524 q_prim_vf(momxb + 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11525# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11526 q_prim_vf(momxb + 2)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11527# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11528
11529# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11530 ! magnetic field
11531# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11532 q_prim_vf(b_idx%end - 1)%sf(i, 0, 0) = 0.1_wp*sin(2._wp*pi*x_cc(i))
11533# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11534 q_prim_vf(b_idx%end)%sf(i, 0, 0) = 0.1_wp*cos(2._wp*pi*x_cc(i))
11535# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11536
11537# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11538 case (170)
11539# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11540 ! This hardcoded case can be used to start a simulation with initial conditions given from a known 1D profile (e.g. Cantera, SDtoolbox)
11541# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11542
11543# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11544 if (.not. files_loaded) then
11545# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11546 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
11547# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11548 do f = 1, max_files
11549# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11550 write (file_num_str, '(I0)') f
11551# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11552 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
11553# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11554 end do
11555# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11556
11557# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11558 ! Common file reading setup
11559# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11560 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11561# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11562 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
11563# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11564
11565# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11566 select case (num_dims)
11567# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11568 case (1, 2) ! 1D and 2D cases are similar
11569# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11570 ! Count lines
11571# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11572 line_count = 0
11573# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11574 do
11575# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11576 read (unit2, *, iostat=ios2) dummy_x, dummy_y
11577# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11578 if (ios2 /= 0) exit
11579# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11580 line_count = line_count + 1
11581# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11582 end do
11583# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11584 close (unit2)
11585# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11586
11587# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11588 xrows = line_count
11589# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11590 yrows = 1
11591# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11592 index_x = 0
11593# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11594 if (num_dims == 2) index_x = i
11595# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11596#ifdef MFC_DEBUG
11597# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11598 block
11599# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11600 use iso_fortran_env, only: output_unit
11601# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11602
11603# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11604 print *, 'm_icpp_patches.fpp:1037: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
11605# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11606
11607# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11608 call flush (output_unit)
11609# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11610 end block
11611# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11612#endif
11613# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11614 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
11615# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11616
11617# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11618
11619# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11620
11621# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11622#if defined(MFC_OpenACC)
11623# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11624!$acc enter data create(x_coords, stored_values)
11625# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11626#elif defined(MFC_OpenMP)
11627# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11628!$omp target enter data map(always,alloc:x_coords, stored_values)
11629# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11630#endif
11631# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11632
11633# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11634 ! Read data from all files
11635# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11636 do f = 1, max_files
11637# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11638 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11639# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11640 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
11641# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11642
11643# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11644 do iter = 1, xrows
11645# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11646 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
11647# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11648 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
11649# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11650 end do
11651# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11652 close (unit)
11653# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11654 end do
11655# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11656
11657# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11658 ! Calculate offsets
11659# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11660 domain_xstart = x_coords(1)
11661# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11662 x_step = x_cc(1) - x_cc(0)
11663# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11664 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
11665# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11666 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
11667# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11668 global_offset_x = nint(abs(delta_x)/x_step)
11669# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11670
11671# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11672 case (3) ! 3D case - determine grid structure
11673# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11674 ! Find yRows by counting rows with same x
11675# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11676 read (unit2, *, iostat=ios2) x0, y0, dummy_z
11677# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11678 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
11679# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11680
11681# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11682 yrows = 1
11683# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11684 do
11685# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11686 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11687# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11688 if (ios2 /= 0) exit
11689# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11690 if (dummy_x == x0 .and. dummy_y /= y0) then
11691# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11692 yrows = yrows + 1
11693# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11694 else
11695# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11696 exit
11697# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11698 end if
11699# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11700 end do
11701# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11702 close (unit2)
11703# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11704
11705# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11706 ! Count total rows
11707# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11708 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
11709# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11710 nrows = 0
11711# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11712 do
11713# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11714 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
11715# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11716 if (ios2 /= 0) exit
11717# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11718 nrows = nrows + 1
11719# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11720 end do
11721# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11722 close (unit2)
11723# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11724
11725# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11726 xrows = nrows/yrows
11727# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11728#ifdef MFC_DEBUG
11729# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11730 block
11731# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11732 use iso_fortran_env, only: output_unit
11733# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11734
11735# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11736 print *, 'm_icpp_patches.fpp:1037: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
11737# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11738
11739# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11740 call flush (output_unit)
11741# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11742 end block
11743# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11744#endif
11745# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11746 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
11747# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11748
11749# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11750
11751# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11752
11753# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11754
11755# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11756#if defined(MFC_OpenACC)
11757# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11758!$acc enter data create(x_coords, y_coords, stored_values)
11759# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11760#elif defined(MFC_OpenMP)
11761# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11762!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
11763# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11764#endif
11765# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11766 index_x = i
11767# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11768 index_y = j
11769# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11770
11771# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11772 ! Read all files
11773# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11774 do f = 1, max_files
11775# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11776 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
11777# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11778 if (ios /= 0) then
11779# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11780 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
11781# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11782 cycle
11783# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11784 end if
11785# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11786
11787# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11788 iter = 0
11789# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11790 do iix = 1, xrows
11791# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11792 do iiy = 1, yrows
11793# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11794 iter = iter + 1
11795# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11796 if (f == 1) then
11797# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11798 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
11799# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11800 else
11801# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11802 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
11803# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11804 end if
11805# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11806 if (ios /= 0) call s_mpi_abort("Error reading data")
11807# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11808 end do
11809# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11810 end do
11811# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11812 close (unit)
11813# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11814 end do
11815# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11816
11817# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11818 ! Calculate offsets
11819# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11820 x_step = x_cc(1) - x_cc(0)
11821# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11822 y_step = y_cc(1) - y_cc(0)
11823# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11824 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
11825# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11826 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
11827# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11828 global_offset_x = nint(abs(delta_x)/x_step)
11829# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11830 global_offset_y = nint(abs(delta_y)/y_step)
11831# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11832 end select
11833# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11834
11835# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11836 files_loaded = .true.
11837# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11838 end if
11839# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11840
11841# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11842 ! Data assignment
11843# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11844 select case (num_dims)
11845# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11846 case (1)
11847# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11848 idx = i + 1 + global_offset_x
11849# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11850 do f = 1, sys_size
11851# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11852 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
11853# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11854 end do
11855# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11856
11857# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11858 case (2)
11859# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11860 idx = i + 1 + global_offset_x - index_x
11861# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11862 do f = 1, sys_size - 1
11863# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11864 jump = merge(1, 0, f >= momxe)
11865# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11866 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
11867# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11868 end do
11869# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11870 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
11871# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11872
11873# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11874 case (3)
11875# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11876 idx = i + 1 + global_offset_x - index_x
11877# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11878 idy = j + 1 + global_offset_y - index_y
11879# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11880 do f = 1, sys_size - 1
11881# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11882 jump = merge(1, 0, f >= momxe)
11883# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11884 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
11885# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11886 end do
11887# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11888 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
11889# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11890 end select
11891# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11892
11893# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11894 case (180)
11895# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11896 ! This is patch is hard-coded for test suite optimization used in the
11897# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11898 ! 1D_shuoser cases: "patch_icpp(2)%alpha_rho(1)": "1 + 0.2*sin(5*x)"
11899# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11900 if (patch_id == 2) then
11901# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11902 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.2*sin(5*x_cc(i))
11903# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11904 end if
11905# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11906
11907# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11908 case (181)
11909# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11910 ! This is patch is hard-coded for test suite optimization used in the
11911# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11912 ! 1D_titarevtorro cases: "patch_icpp(2)%alpha_rho(1)": "1 + 0.1*sin(20*x*pi)"
11913# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11914 q_prim_vf(contxb + 0)%sf(i, 0, 0) = 1 + 0.1*sin(20*x_cc(i)*pi)
11915# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11916
11917# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11918 case (182)
11919# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11920 ! This patch is a hard-coded for test suite optimization (multiple component diffusion)
11921# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11922 x_mid_diffu = 0.05_wp/2.0_wp
11923# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11924 width_sq = (2.5_wp*10.0_wp**(-3.0_wp))**2
11925# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11926 profile_shape = 1.0_wp - 0.5_wp*exp(-(x_cc(i) - x_mid_diffu)**2/width_sq)
11927# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11928 q_prim_vf(momxb)%sf(i, 0, 0) = 0.0_wp
11929# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11930 q_prim_vf(e_idx)%sf(i, 0, 0) = 1.01325_wp*(10.0_wp)**5
11931# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11932 q_prim_vf(advxb)%sf(i, 0, 0) = 1.0_wp
11933# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11934
11935# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11936 y1 = (0.195_wp - 0.142_wp)*profile_shape + 0.142_wp
11937# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11938 y2 = (0.0_wp - 0.1_wp)*profile_shape + 0.1_wp
11939# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11940 y3 = (0.214_wp - 0.0_wp)*profile_shape + 0.0_wp
11941# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11942 y4 = (0.591_wp - 0.758_wp)*profile_shape + 0.758_wp
11943# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11944
11945# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11946 q_prim_vf(chemxb)%sf(i, 0, 0) = y1
11947# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11948 q_prim_vf(chemxb + 1)%sf(i, 0, 0) = y2
11949# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11950 q_prim_vf(chemxb + 2)%sf(i, 0, 0) = y3
11951# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11952 q_prim_vf(chemxb + 3)%sf(i, 0, 0) = y4
11953# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11954
11955# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11956 temp = (320.0_wp - 1350.0_wp)*profile_shape + 1350.0_wp
11957# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11958
11959# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11960 molar_mass_inv = y1/31.998_wp + &
11961# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11962 y2/18.01508_wp + &
11963# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11964 y3/16.04256_wp + &
11965# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11966 y4/28.0134_wp
11967# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11968
11969# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11970 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)
11971# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11972
11973# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11974 case default
11975# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11976 call s_int_to_str(patch_id, istr)
11977# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11978 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
11979# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11980 end select
11981# 1037 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11982
11983 end if
11984
11985 end if
11986 end do
11987 if (allocated(stored_values)) then
11988# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11989#ifdef MFC_DEBUG
11990# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11991 block
11992# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11993 use iso_fortran_env, only: output_unit
11994# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11995
11996# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11997 print *, 'm_icpp_patches.fpp:1042: ', '@:DEALLOCATE(stored_values)'
11998# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
11999
12000# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12001 call flush (output_unit)
12002# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12003 end block
12004# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12005#endif
12006# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12007
12008# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12009#if defined(MFC_OpenACC)
12010# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12011!$acc exit data delete(stored_values)
12012# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12013#elif defined(MFC_OpenMP)
12014# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12015!$omp target exit data map(release:stored_values)
12016# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12017#endif
12018# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12019 deallocate (stored_values)
12020# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12021#ifdef MFC_DEBUG
12022# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12023 block
12024# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12025 use iso_fortran_env, only: output_unit
12026# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12027
12028# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12029 print *, 'm_icpp_patches.fpp:1042: ', '@:DEALLOCATE(x_coords)'
12030# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12031
12032# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12033 call flush (output_unit)
12034# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12035 end block
12036# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12037#endif
12038# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12039
12040# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12041#if defined(MFC_OpenACC)
12042# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12043!$acc exit data delete(x_coords)
12044# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12045#elif defined(MFC_OpenMP)
12046# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12047!$omp target exit data map(release:x_coords)
12048# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12049#endif
12050# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12051 deallocate (x_coords)
12052# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12053 end if
12054# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12055
12056# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12057 if (allocated(y_coords)) then
12058# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12059#ifdef MFC_DEBUG
12060# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12061 block
12062# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12063 use iso_fortran_env, only: output_unit
12064# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12065
12066# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12067 print *, 'm_icpp_patches.fpp:1042: ', '@:DEALLOCATE(y_coords)'
12068# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12069
12070# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12071 call flush (output_unit)
12072# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12073 end block
12074# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12075#endif
12076# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12077
12078# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12079#if defined(MFC_OpenACC)
12080# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12081!$acc exit data delete(y_coords)
12082# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12083#elif defined(MFC_OpenMP)
12084# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12085!$omp target exit data map(release:y_coords)
12086# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12087#endif
12088# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12089 deallocate (y_coords)
12090# 1042 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12091 end if
12092
12093 end subroutine s_icpp_1d_bubble_pulse
12094
12095 !> 2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid).
12096 !! Additive (modal_use_exp_form false): R = radius + sum_n [fourier_cos*cos(n*theta)+fourier_sin*sin(n*theta)];
12097 !! coefficients are absolute (same units as radius). R is clipped to max(R,0). If modal_clip_r_to_min, R = max(R, modal_r_min).
12098 !! Exponential (modal_use_exp_form true): R = radius*exp(sum); coefficients are relative (dimensionless).
12099 subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
12100 integer, intent(in) :: patch_id
12101#ifdef MFC_MIXED_PRECISION
12102 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12103#else
12104 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12105#endif
12106 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12107
12108 real(wp) :: r, theta, R_boundary, sum_series
12109 integer :: i, j, nn
12110
12111 x_centroid = patch_icpp(patch_id)%x_centroid
12112 y_centroid = patch_icpp(patch_id)%y_centroid
12113 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12114 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12115 eta = 1._wp
12116
12117 do j = 0, n
12118 do i = 0, m
12119 r = sqrt((x_cc(i) - x_centroid)**2 + (y_cc(j) - y_centroid)**2)
12120 if (r < small_radius) then
12121 theta = 0._wp
12122 else
12123 theta = atan2(y_cc(j) - y_centroid, x_cc(i) - x_centroid)
12124 end if
12125 sum_series = 0._wp
12126 do nn = 1, max_2d_fourier_modes
12127 sum_series = sum_series + patch_icpp(patch_id)%fourier_cos(nn)*cos(real(nn, wp)*theta) &
12128 + patch_icpp(patch_id)%fourier_sin(nn)*sin(real(nn, wp)*theta)
12129 end do
12130 if (patch_icpp(patch_id)%modal_use_exp_form) then
12131 r_boundary = patch_icpp(patch_id)%radius*exp(sum_series)
12132 else
12133 r_boundary = patch_icpp(patch_id)%radius + sum_series
12134 r_boundary = max(r_boundary, 0._wp)
12135 if (patch_icpp(patch_id)%modal_clip_r_to_min) then
12136 r_boundary = max(r_boundary, patch_icpp(patch_id)%modal_r_min)
12137 end if
12138 end if
12139 if (patch_icpp(patch_id)%smoothen) then
12140 eta = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy)*(r_boundary - r))
12141 end if
12142 if ((r <= r_boundary .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, 0))) &
12143 .or. patch_id_fp(i, j, 0) == smooth_patch_id) then
12144 call s_assign_patch_primitive_variables(patch_id, i, j, 0, eta, q_prim_vf, patch_id_fp)
12145 end if
12146 end do
12147 end do
12148 end subroutine s_icpp_2d_modal
12149
12150 !> 3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,phi).
12151 !! theta = acos(z/r), phi = atan2(y,x) relative to centroid.
12152 subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
12153 integer, intent(in) :: patch_id
12154#ifdef MFC_MIXED_PRECISION
12155 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12156#else
12157 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12158#endif
12159 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12160
12161 real(wp) :: dx_loc, dy_loc, dz_loc, r, theta, phi, R_surface, eta_local
12162 integer :: i, j, k, ll, mm
12163
12164 x_centroid = patch_icpp(patch_id)%x_centroid
12165 y_centroid = patch_icpp(patch_id)%y_centroid
12166 z_centroid = patch_icpp(patch_id)%z_centroid
12167 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12168 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12169 eta_local = 1._wp
12170
12171 do k = 0, p
12172 do j = 0, n
12173 do i = 0, m
12174 if (grid_geometry == 3) then
12175 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12176 dx_loc = x_cc(i) - x_centroid
12177 dy_loc = cart_y - y_centroid
12178 dz_loc = cart_z - z_centroid
12179 else
12180 dx_loc = x_cc(i) - x_centroid
12181 dy_loc = y_cc(j) - y_centroid
12182 dz_loc = z_cc(k) - z_centroid
12183 end if
12184 r = sqrt(dx_loc**2 + dy_loc**2 + dz_loc**2)
12185 if (r < small_radius) then
12186 theta = 0._wp
12187 phi = 0._wp
12188 else
12189 theta = acos(min(1._wp, max(-1._wp, dz_loc/r)))
12190 phi = atan2(dy_loc, dx_loc)
12191 end if
12192 r_surface = patch_icpp(patch_id)%radius
12193 do ll = 0, max_sph_harm_degree
12194 do mm = -ll, ll
12195 if (patch_icpp(patch_id)%sph_har_coeff(ll, mm) == 0._wp) cycle
12196 r_surface = r_surface + patch_icpp(patch_id)%sph_har_coeff(ll, mm)*real_ylm(theta, phi, ll, mm)
12197 end do
12198 end do
12199 if (patch_icpp(patch_id)%smoothen) then
12200 eta_local = 0.5_wp + 0.5_wp*tanh(smooth_coeff/min(dx, dy, dz)*(r_surface - r))
12201 end if
12202 if ((r <= r_surface .and. patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) &
12203 .or. patch_id_fp(i, j, k) == smooth_patch_id) then
12204 call s_assign_patch_primitive_variables(patch_id, i, j, k, eta_local, q_prim_vf, patch_id_fp)
12205 end if
12206 end do
12207 end do
12208 end do
12209 end subroutine s_icpp_3d_spherical_harmonic
12210
12211 !> The spherical patch is a 3D geometry that may be used,
12212 !! for example, in creating a bubble or a droplet. The patch
12213 !! geometry is well-defined when its centroid and radius are
12214 !! provided. Please note that the spherical patch DOES allow
12215 !! for the smoothing of its boundary.
12216 !! @param patch_id is the patch identifier
12217 !! @param patch_id_fp Array to track patch ids
12218 !! @param q_prim_vf Array of primitive variables
12219 subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
12220
12221 integer, intent(in) :: patch_id
12222#ifdef MFC_MIXED_PRECISION
12223 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12224#else
12225 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
12226#endif
12227 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
12228
12229 ! Generic loop iterators
12230 integer :: i, j, k
12231 real(wp) :: radius
12232 integer :: xRows, yRows, nRows, iix, iiy, max_files
12233# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12234 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
12235# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12236 real(wp) :: x_len, x_step, y_len, y_step
12237# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12238 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
12239# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12240 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
12241# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12242 real(wp) :: delta_x, delta_y
12243# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12244 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
12245# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12246 character(len=200) :: errmsg
12247# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12248 real(wp), allocatable :: stored_values(:, :, :)
12249# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12250 real(wp), allocatable :: x_coords(:), y_coords(:)
12251# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12252 logical :: files_loaded = .false.
12253# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12254 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
12255# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12256 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
12257# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12258 character(len=20) :: file_num_str ! For storing the file number as a string
12259# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12260 character(len=20) :: zeros_part ! For the trailing zeros part
12261# 1183 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12262 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
12263 ! Place any declaration of intermediate variables here
12264# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12265 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
12266# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12267 real(wp) :: eps
12268# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12269
12270# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12271 ! IGR Jets
12272# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12273 ! Arrays to stor position and radii of jets from input file
12274# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12275 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
12276# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12277 ! Variables to describe initial condition of jet
12278# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12279 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
12280# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12281 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
12282# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12283
12284# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12285 real(wp), dimension(0:n, 0:p) :: rcut_arr
12286# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12287 integer :: l, q, s ! Iterators for reading input files
12288# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12289 integer :: start, end ! Ints to keep track of position in file
12290# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12291 character(len=1000) :: line ! String to store line in ile
12292# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12293 character(len=25) :: value ! String to store value in line
12294# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12295 integer :: NJet ! Number of jets
12296# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12297
12298# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12299 eps = 1e-9_wp
12300# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12301
12302# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12303 if (patch_icpp(patch_id)%hcid == 303) then
12304# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12305 eps_smooth = 3._wp
12306# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12307 open (unit=10, file="njet.txt", status="old", action="read")
12308# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12309 read (10, *) njet
12310# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12311 close (10)
12312# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12313
12314# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12315 allocate (y_th_arr(0:njet - 1))
12316# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12317 allocate (z_th_arr(0:njet - 1))
12318# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12319 allocate (r_th_arr(0:njet - 1))
12320# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12321
12322# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12323 open (unit=10, file="jets.csv", status="old", action="read")
12324# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12325 do q = 0, njet - 1
12326# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12327 read (10, '(A)') line ! Read a full line as a string
12328# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12329 start = 1
12330# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12331
12332# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12333 do l = 0, 2
12334# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12335 end = index(line(start:), ',') ! Find the next comma
12336# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12337 if (end == 0) then
12338# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12339 value = trim(adjustl(line(start:))) ! Last value in the line
12340# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12341 else
12342# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12343 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
12344# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12345 start = start + end ! Move to next value
12346# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12347 end if
12348# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12349 if (l == 0) then
12350# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12351 read (value, *) y_th_arr(q) ! Convert string to numeric value
12352# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12353 elseif (l == 1) then
12354# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12355 read (value, *) z_th_arr(q)
12356# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12357 else
12358# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12359 read (value, *) r_th_arr(q)
12360# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12361 end if
12362# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12363 end do
12364# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12365 end do
12366# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12367 close (10)
12368# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12369
12370# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12371 do q = 0, p
12372# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12373 do l = 0, n
12374# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12375 rcut = 0._wp
12376# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12377 do s = 0, njet - 1
12378# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12379 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
12380# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12381 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
12382# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12383 end do
12384# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12385 rcut_arr(l, q) = rcut
12386# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12387 end do
12388# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12389 end do
12390# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12391 end if
12392# 1184 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12393
12394
12395 !! Variables to initialize the pressure field that corresponds to the
12396 !! bubble-collapse test case found in Tiwari et al. (2013)
12397
12398 ! Transferring spherical patch's radius, centroid, smoothing patch
12399 ! identity and smoothing coefficient information
12400 x_centroid = patch_icpp(patch_id)%x_centroid
12401 y_centroid = patch_icpp(patch_id)%y_centroid
12402 z_centroid = patch_icpp(patch_id)%z_centroid
12403 radius = patch_icpp(patch_id)%radius
12404 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
12405 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
12406
12407 ! Initializing the pseudo volume fraction value to 1. The value will
12408 ! be modified as the patch is laid out on the grid, but only in the
12409 ! case that smoothing of the spherical patch's boundary is enabled.
12410 eta = 1._wp
12411
12412 ! Checking whether the sphere covers a particular cell in the domain
12413 ! and verifying whether the current patch has permission to write to
12414 ! that cell. If both queries check out, the primitive variables of
12415 ! the current patch are assigned to this cell.
12416 do k = 0, p
12417 do j = 0, n
12418 do i = 0, m
12419
12420 if (grid_geometry == 3) then
12421 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
12422 else
12423 cart_y = y_cc(j)
12424 cart_z = z_cc(k)
12425 end if
12426
12427 if (patch_icpp(patch_id)%smoothen) then
12428 eta = tanh(smooth_coeff/min(dx, dy, dz)* &
12429 (sqrt((x_cc(i) - x_centroid)**2 &
12430 + (cart_y - y_centroid)**2 &
12431 + (cart_z - z_centroid)**2) &
12432 - radius))*(-0.5_wp) + 0.5_wp
12433 end if
12434
12435 if ((((x_cc(i) - x_centroid)**2 &
12436 + (cart_y - y_centroid)**2 &
12437 + (cart_z - z_centroid)**2 <= radius**2) .and. &
12438 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. &
12439 patch_id_fp(i, j, k) == smooth_patch_id) then
12440
12441 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
12442 eta, q_prim_vf, patch_id_fp)
12443
12444
12445 if (patch_icpp(patch_id)%hcid /= dflt_int) then
12446
12447# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12448 select case (patch_icpp(patch_id)%hcid)
12449# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12450 case (300) ! Rayleigh-Taylor instability
12451# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12452 rhoh = 3._wp
12453# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12454 rhol = 1._wp
12455# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12456 pref = 1.e5_wp
12457# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12458 pint = pref
12459# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12460 h = 0.7_wp
12461# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12462 lam = 0.2_wp
12463# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12464 wl = 2._wp*pi/lam
12465# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12466 amp = 0.025_wp/wl
12467# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12468
12469# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12470 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
12471# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12472
12473# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12474 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
12475# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12476
12477# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12478 if (alph < eps) alph = eps
12479# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12480 if (alph > 1._wp - eps) alph = 1._wp - eps
12481# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12482
12483# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12484 if (y_cc(j) > inth) then
12485# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12486 q_prim_vf(advxb)%sf(i, j, k) = alph
12487# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12488 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
12489# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12490 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
12491# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12492 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
12493# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12494 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
12495# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12496 else
12497# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12498 q_prim_vf(advxb)%sf(i, j, k) = alph
12499# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12500 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
12501# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12502 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
12503# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12504 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
12505# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12506 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
12507# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12508 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
12509# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12510 end if
12511# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12512
12513# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12514 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
12515# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12516 h = 0.0_wp
12517# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12518 lam = 1.0_wp
12519# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12520 amp = patch_icpp(patch_id)%a(2)
12521# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12522 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
12523# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12524 if (x_cc(i) > inth) then
12525# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12526 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
12527# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12528 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
12529# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12530 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
12531# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12532 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
12533# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12534 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
12535# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12536 end if
12537# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12538
12539# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12540 case (302) ! 3D Jet with IGR
12541# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12542 ux_th = 10*sqrt(1.4*0.4)
12543# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12544 ux_am = 0.0*sqrt(1.4)
12545# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12546 p_th = 2.0_wp
12547# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12548 p_am = 1.0_wp
12549# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12550 rho_th = 1._wp
12551# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12552 rho_am = 1._wp
12553# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12554 y_th = 0.0_wp
12555# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12556 z_th = 0.0_wp
12557# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12558 r_th = 1._wp
12559# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12560 eps_smooth = 1._wp
12561# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12562 eps = 1e-6
12563# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12564
12565# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12566 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
12567# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12568 rcut = f_cut_on(r - r_th, eps_smooth)
12569# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12570 xcut = f_cut_on(x_cc(i), eps_smooth)
12571# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12572
12573# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12574 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12575# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12576 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
12577# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12578 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
12579# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12580
12581# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12582 if (num_fluids == 1) then
12583# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12584 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12585# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12586 else
12587# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12588 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12589# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12590 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
12591# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12592 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
12593# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12594 end if
12595# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12596
12597# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12598 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
12599# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12600
12601# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12602 case (303) ! 3D Multijet
12603# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12604
12605# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12606 eps_smooth = 3.0_wp
12607# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12608 ux_th = 10*sqrt(1.4*0.4)
12609# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12610 ux_am = 2.5*sqrt(1.4*0.4)
12611# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12612 p_th = 0.8_wp
12613# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12614 p_am = 0.4_wp
12615# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12616 rho_th = 1._wp
12617# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12618 rho_am = 1._wp
12619# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12620 eps = 1e-6
12621# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12622
12623# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12624 rcut = rcut_arr(j, k)
12625# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12626 xcut = f_cut_on(x_cc(i), eps_smooth)
12627# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12628
12629# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12630 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
12631# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12632 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
12633# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12634 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
12635# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12636
12637# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12638 if (num_fluids == 1) then
12639# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12640 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
12641# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12642 else
12643# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12644 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
12645# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12646 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
12647# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12648 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
12649# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12650 end if
12651# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12652
12653# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12654 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
12655# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12656
12657# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12658 case (370)
12659# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12660 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
12661# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12662
12663# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12664 if (.not. files_loaded) then
12665# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12666 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
12667# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12668 do f = 1, max_files
12669# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12670 write (file_num_str, '(I0)') f
12671# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12672 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
12673# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12674 end do
12675# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12676
12677# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12678 ! Common file reading setup
12679# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12680 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12681# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12682 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
12683# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12684
12685# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12686 select case (num_dims)
12687# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12688 case (1, 2) ! 1D and 2D cases are similar
12689# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12690 ! Count lines
12691# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12692 line_count = 0
12693# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12694 do
12695# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12696 read (unit2, *, iostat=ios2) dummy_x, dummy_y
12697# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12698 if (ios2 /= 0) exit
12699# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12700 line_count = line_count + 1
12701# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12702 end do
12703# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12704 close (unit2)
12705# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12706
12707# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12708 xrows = line_count
12709# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12710 yrows = 1
12711# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12712 index_x = 0
12713# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12714 if (num_dims == 2) index_x = i
12715# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12716#ifdef MFC_DEBUG
12717# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12718 block
12719# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12720 use iso_fortran_env, only: output_unit
12721# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12722
12723# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12724 print *, 'm_icpp_patches.fpp:1237: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
12725# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12726
12727# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12728 call flush (output_unit)
12729# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12730 end block
12731# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12732#endif
12733# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12734 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
12735# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12736
12737# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12738
12739# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12740
12741# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12742#if defined(MFC_OpenACC)
12743# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12744!$acc enter data create(x_coords, stored_values)
12745# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12746#elif defined(MFC_OpenMP)
12747# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12748!$omp target enter data map(always,alloc:x_coords, stored_values)
12749# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12750#endif
12751# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12752
12753# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12754 ! Read data from all files
12755# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12756 do f = 1, max_files
12757# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12758 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12759# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12760 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
12761# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12762
12763# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12764 do iter = 1, xrows
12765# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12766 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
12767# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12768 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
12769# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12770 end do
12771# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12772 close (unit)
12773# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12774 end do
12775# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12776
12777# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12778 ! Calculate offsets
12779# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12780 domain_xstart = x_coords(1)
12781# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12782 x_step = x_cc(1) - x_cc(0)
12783# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12784 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
12785# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12786 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
12787# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12788 global_offset_x = nint(abs(delta_x)/x_step)
12789# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12790
12791# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12792 case (3) ! 3D case - determine grid structure
12793# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12794 ! Find yRows by counting rows with same x
12795# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12796 read (unit2, *, iostat=ios2) x0, y0, dummy_z
12797# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12798 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
12799# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12800
12801# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12802 yrows = 1
12803# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12804 do
12805# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12806 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12807# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12808 if (ios2 /= 0) exit
12809# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12810 if (dummy_x == x0 .and. dummy_y /= y0) then
12811# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12812 yrows = yrows + 1
12813# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12814 else
12815# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12816 exit
12817# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12818 end if
12819# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12820 end do
12821# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12822 close (unit2)
12823# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12824
12825# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12826 ! Count total rows
12827# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12828 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
12829# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12830 nrows = 0
12831# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12832 do
12833# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12834 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
12835# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12836 if (ios2 /= 0) exit
12837# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12838 nrows = nrows + 1
12839# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12840 end do
12841# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12842 close (unit2)
12843# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12844
12845# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12846 xrows = nrows/yrows
12847# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12848#ifdef MFC_DEBUG
12849# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12850 block
12851# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12852 use iso_fortran_env, only: output_unit
12853# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12854
12855# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12856 print *, 'm_icpp_patches.fpp:1237: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
12857# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12858
12859# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12860 call flush (output_unit)
12861# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12862 end block
12863# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12864#endif
12865# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12866 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
12867# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12868
12869# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12870
12871# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12872
12873# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12874
12875# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12876#if defined(MFC_OpenACC)
12877# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12878!$acc enter data create(x_coords, y_coords, stored_values)
12879# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12880#elif defined(MFC_OpenMP)
12881# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12882!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
12883# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12884#endif
12885# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12886 index_x = i
12887# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12888 index_y = j
12889# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12890
12891# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12892 ! Read all files
12893# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12894 do f = 1, max_files
12895# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12896 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
12897# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12898 if (ios /= 0) then
12899# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12900 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
12901# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12902 cycle
12903# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12904 end if
12905# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12906
12907# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12908 iter = 0
12909# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12910 do iix = 1, xrows
12911# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12912 do iiy = 1, yrows
12913# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12914 iter = iter + 1
12915# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12916 if (f == 1) then
12917# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12918 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
12919# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12920 else
12921# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12922 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
12923# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12924 end if
12925# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12926 if (ios /= 0) call s_mpi_abort("Error reading data")
12927# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12928 end do
12929# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12930 end do
12931# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12932 close (unit)
12933# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12934 end do
12935# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12936
12937# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12938 ! Calculate offsets
12939# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12940 x_step = x_cc(1) - x_cc(0)
12941# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12942 y_step = y_cc(1) - y_cc(0)
12943# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12944 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
12945# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12946 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
12947# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12948 global_offset_x = nint(abs(delta_x)/x_step)
12949# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12950 global_offset_y = nint(abs(delta_y)/y_step)
12951# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12952 end select
12953# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12954
12955# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12956 files_loaded = .true.
12957# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12958 end if
12959# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12960
12961# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12962 ! Data assignment
12963# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12964 select case (num_dims)
12965# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12966 case (1)
12967# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12968 idx = i + 1 + global_offset_x
12969# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12970 do f = 1, sys_size
12971# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12972 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
12973# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12974 end do
12975# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12976
12977# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12978 case (2)
12979# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12980 idx = i + 1 + global_offset_x - index_x
12981# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12982 do f = 1, sys_size - 1
12983# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12984 jump = merge(1, 0, f >= momxe)
12985# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12986 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
12987# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12988 end do
12989# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12990 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
12991# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12992
12993# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12994 case (3)
12995# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12996 idx = i + 1 + global_offset_x - index_x
12997# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
12998 idy = j + 1 + global_offset_y - index_y
12999# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13000 do f = 1, sys_size - 1
13001# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13002 jump = merge(1, 0, f >= momxe)
13003# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13004 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13005# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13006 end do
13007# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13008 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
13009# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13010 end select
13011# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13012
13013# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13014 case (380)
13015# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13016 ! This is patch is hard-coded for test suite optimization used in the
13017# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13018 ! 3D_TaylorGreenVortex case:
13019# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13020 ! This analytic patch used geometry 9
13021# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13022 mach = 0.1
13023# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13024 if (patch_id == 1) then
13025# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13026 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)
13027# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13028 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)
13029# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13030 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)
13031# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13032 end if
13033# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13034
13035# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13036 case default
13037# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13038 call s_int_to_str(patch_id, istr)
13039# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13040 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
13041# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13042 end select
13043# 1237 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13044
13045 end if
13046
13047 end if
13048 end do
13049 end do
13050 end do
13051 if (allocated(stored_values)) then
13052# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13053#ifdef MFC_DEBUG
13054# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13055 block
13056# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13057 use iso_fortran_env, only: output_unit
13058# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13059
13060# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13061 print *, 'm_icpp_patches.fpp:1244: ', '@:DEALLOCATE(stored_values)'
13062# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13063
13064# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13065 call flush (output_unit)
13066# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13067 end block
13068# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13069#endif
13070# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13071
13072# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13073#if defined(MFC_OpenACC)
13074# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13075!$acc exit data delete(stored_values)
13076# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13077#elif defined(MFC_OpenMP)
13078# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13079!$omp target exit data map(release:stored_values)
13080# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13081#endif
13082# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13083 deallocate (stored_values)
13084# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13085#ifdef MFC_DEBUG
13086# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13087 block
13088# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13089 use iso_fortran_env, only: output_unit
13090# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13091
13092# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13093 print *, 'm_icpp_patches.fpp:1244: ', '@:DEALLOCATE(x_coords)'
13094# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13095
13096# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13097 call flush (output_unit)
13098# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13099 end block
13100# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13101#endif
13102# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13103
13104# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13105#if defined(MFC_OpenACC)
13106# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13107!$acc exit data delete(x_coords)
13108# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13109#elif defined(MFC_OpenMP)
13110# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13111!$omp target exit data map(release:x_coords)
13112# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13113#endif
13114# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13115 deallocate (x_coords)
13116# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13117 end if
13118# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13119
13120# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13121 if (allocated(y_coords)) then
13122# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13123#ifdef MFC_DEBUG
13124# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13125 block
13126# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13127 use iso_fortran_env, only: output_unit
13128# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13129
13130# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13131 print *, 'm_icpp_patches.fpp:1244: ', '@:DEALLOCATE(y_coords)'
13132# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13133
13134# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13135 call flush (output_unit)
13136# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13137 end block
13138# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13139#endif
13140# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13141
13142# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13143#if defined(MFC_OpenACC)
13144# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13145!$acc exit data delete(y_coords)
13146# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13147#elif defined(MFC_OpenMP)
13148# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13149!$omp target exit data map(release:y_coords)
13150# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13151#endif
13152# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13153 deallocate (y_coords)
13154# 1244 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13155 end if
13156
13157 end subroutine s_icpp_sphere
13158
13159 !> The cuboidal patch is a 3D geometry that may be used, for
13160 !! example, in creating a solid boundary, or pre-/post-shock
13161 !! region, which is aligned with the axes of the Cartesian
13162 !! coordinate system. The geometry of such a patch is well-
13163 !! defined when its centroid and lengths in the x-, y- and
13164 !! z-coordinate directions are provided. Please notice that
13165 !! the cuboidal patch DOES NOT allow for the smearing of its
13166 !! boundaries.
13167 !! @param patch_id is the patch identifier
13168 !! @param patch_id_fp Array to track patch ids
13169 !! @param q_prim_vf Array of primitive variables
13170 subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
13171
13172 integer, intent(in) :: patch_id
13173#ifdef MFC_MIXED_PRECISION
13174 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
13175#else
13176 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
13177#endif
13178 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
13179
13180 integer :: i, j, k !< Generic loop iterators
13181 integer :: xRows, yRows, nRows, iix, iiy, max_files
13182# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13183 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
13184# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13185 real(wp) :: x_len, x_step, y_len, y_step
13186# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13187 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
13188# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13189 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
13190# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13191 real(wp) :: delta_x, delta_y
13192# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13193 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
13194# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13195 character(len=200) :: errmsg
13196# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13197 real(wp), allocatable :: stored_values(:, :, :)
13198# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13199 real(wp), allocatable :: x_coords(:), y_coords(:)
13200# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13201 logical :: files_loaded = .false.
13202# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13203 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
13204# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13205 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
13206# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13207 character(len=20) :: file_num_str ! For storing the file number as a string
13208# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13209 character(len=20) :: zeros_part ! For the trailing zeros part
13210# 1270 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13211 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
13212 ! Place any declaration of intermediate variables here
13213# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13214 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
13215# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13216 real(wp) :: eps
13217# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13218
13219# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13220 ! IGR Jets
13221# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13222 ! Arrays to stor position and radii of jets from input file
13223# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13224 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
13225# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13226 ! Variables to describe initial condition of jet
13227# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13228 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
13229# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13230 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
13231# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13232
13233# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13234 real(wp), dimension(0:n, 0:p) :: rcut_arr
13235# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13236 integer :: l, q, s ! Iterators for reading input files
13237# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13238 integer :: start, end ! Ints to keep track of position in file
13239# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13240 character(len=1000) :: line ! String to store line in ile
13241# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13242 character(len=25) :: value ! String to store value in line
13243# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13244 integer :: NJet ! Number of jets
13245# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13246
13247# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13248 eps = 1e-9_wp
13249# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13250
13251# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13252 if (patch_icpp(patch_id)%hcid == 303) then
13253# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13254 eps_smooth = 3._wp
13255# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13256 open (unit=10, file="njet.txt", status="old", action="read")
13257# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13258 read (10, *) njet
13259# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13260 close (10)
13261# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13262
13263# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13264 allocate (y_th_arr(0:njet - 1))
13265# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13266 allocate (z_th_arr(0:njet - 1))
13267# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13268 allocate (r_th_arr(0:njet - 1))
13269# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13270
13271# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13272 open (unit=10, file="jets.csv", status="old", action="read")
13273# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13274 do q = 0, njet - 1
13275# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13276 read (10, '(A)') line ! Read a full line as a string
13277# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13278 start = 1
13279# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13280
13281# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13282 do l = 0, 2
13283# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13284 end = index(line(start:), ',') ! Find the next comma
13285# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13286 if (end == 0) then
13287# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13288 value = trim(adjustl(line(start:))) ! Last value in the line
13289# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13290 else
13291# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13292 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
13293# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13294 start = start + end ! Move to next value
13295# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13296 end if
13297# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13298 if (l == 0) then
13299# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13300 read (value, *) y_th_arr(q) ! Convert string to numeric value
13301# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13302 elseif (l == 1) then
13303# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13304 read (value, *) z_th_arr(q)
13305# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13306 else
13307# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13308 read (value, *) r_th_arr(q)
13309# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13310 end if
13311# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13312 end do
13313# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13314 end do
13315# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13316 close (10)
13317# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13318
13319# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13320 do q = 0, p
13321# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13322 do l = 0, n
13323# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13324 rcut = 0._wp
13325# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13326 do s = 0, njet - 1
13327# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13328 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
13329# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13330 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
13331# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13332 end do
13333# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13334 rcut_arr(l, q) = rcut
13335# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13336 end do
13337# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13338 end do
13339# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13340 end if
13341# 1271 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13342
13343
13344 ! Transferring the cuboid's centroid and length information
13345 x_centroid = patch_icpp(patch_id)%x_centroid
13346 y_centroid = patch_icpp(patch_id)%y_centroid
13347 z_centroid = patch_icpp(patch_id)%z_centroid
13348 length_x = patch_icpp(patch_id)%length_x
13349 length_y = patch_icpp(patch_id)%length_y
13350 length_z = patch_icpp(patch_id)%length_z
13351
13352 ! Computing the beginning and the end x-, y- and z-coordinates of
13353 ! the cuboid based on its centroid and lengths
13354 x_boundary%beg = x_centroid - 0.5_wp*length_x
13355 x_boundary%end = x_centroid + 0.5_wp*length_x
13356 y_boundary%beg = y_centroid - 0.5_wp*length_y
13357 y_boundary%end = y_centroid + 0.5_wp*length_y
13358 z_boundary%beg = z_centroid - 0.5_wp*length_z
13359 z_boundary%end = z_centroid + 0.5_wp*length_z
13360
13361 ! Since the cuboidal patch does not allow for its boundaries to get
13362 ! smoothed out, the pseudo volume fraction is set to 1 to make sure
13363 ! that only the current patch contributes to the fluid state in the
13364 ! cells that this patch covers.
13365 eta = 1._wp
13366
13367 ! Checking whether the cuboid covers a particular cell in the domain
13368 ! and verifying whether the current patch has permission to write to
13369 ! to that cell. If both queries check out, the primitive variables
13370 ! of the current patch are assigned to this cell.
13371 do k = 0, p
13372 do j = 0, n
13373 do i = 0, m
13374
13375 if (grid_geometry == 3) then
13376 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
13377 else
13378 cart_y = y_cc(j)
13379 cart_z = z_cc(k)
13380 end if
13381
13382 if (x_boundary%beg <= x_cc(i) .and. &
13383 x_boundary%end >= x_cc(i) .and. &
13384 y_boundary%beg <= cart_y .and. &
13385 y_boundary%end >= cart_y .and. &
13386 z_boundary%beg <= cart_z .and. &
13387 z_boundary%end >= cart_z) then
13388
13389 if (patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) then
13390
13391 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
13392 eta, q_prim_vf, patch_id_fp)
13393
13394
13395 if (patch_icpp(patch_id)%hcid /= dflt_int) then
13396
13397# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13398 select case (patch_icpp(patch_id)%hcid)
13399# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13400 case (300) ! Rayleigh-Taylor instability
13401# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13402 rhoh = 3._wp
13403# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13404 rhol = 1._wp
13405# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13406 pref = 1.e5_wp
13407# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13408 pint = pref
13409# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13410 h = 0.7_wp
13411# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13412 lam = 0.2_wp
13413# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13414 wl = 2._wp*pi/lam
13415# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13416 amp = 0.025_wp/wl
13417# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13418
13419# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13420 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
13421# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13422
13423# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13424 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
13425# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13426
13427# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13428 if (alph < eps) alph = eps
13429# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13430 if (alph > 1._wp - eps) alph = 1._wp - eps
13431# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13432
13433# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13434 if (y_cc(j) > inth) then
13435# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13436 q_prim_vf(advxb)%sf(i, j, k) = alph
13437# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13438 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
13439# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13440 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
13441# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13442 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
13443# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13444 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
13445# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13446 else
13447# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13448 q_prim_vf(advxb)%sf(i, j, k) = alph
13449# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13450 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
13451# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13452 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
13453# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13454 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
13455# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13456 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
13457# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13458 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
13459# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13460 end if
13461# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13462
13463# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13464 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
13465# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13466 h = 0.0_wp
13467# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13468 lam = 1.0_wp
13469# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13470 amp = patch_icpp(patch_id)%a(2)
13471# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13472 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
13473# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13474 if (x_cc(i) > inth) then
13475# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13476 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
13477# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13478 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
13479# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13480 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
13481# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13482 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
13483# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13484 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
13485# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13486 end if
13487# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13488
13489# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13490 case (302) ! 3D Jet with IGR
13491# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13492 ux_th = 10*sqrt(1.4*0.4)
13493# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13494 ux_am = 0.0*sqrt(1.4)
13495# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13496 p_th = 2.0_wp
13497# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13498 p_am = 1.0_wp
13499# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13500 rho_th = 1._wp
13501# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13502 rho_am = 1._wp
13503# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13504 y_th = 0.0_wp
13505# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13506 z_th = 0.0_wp
13507# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13508 r_th = 1._wp
13509# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13510 eps_smooth = 1._wp
13511# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13512 eps = 1e-6
13513# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13514
13515# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13516 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
13517# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13518 rcut = f_cut_on(r - r_th, eps_smooth)
13519# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13520 xcut = f_cut_on(x_cc(i), eps_smooth)
13521# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13522
13523# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13524 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13525# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13526 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
13527# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13528 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
13529# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13530
13531# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13532 if (num_fluids == 1) then
13533# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13534 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13535# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13536 else
13537# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13538 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13539# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13540 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
13541# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13542 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
13543# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13544 end if
13545# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13546
13547# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13548 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
13549# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13550
13551# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13552 case (303) ! 3D Multijet
13553# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13554
13555# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13556 eps_smooth = 3.0_wp
13557# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13558 ux_th = 10*sqrt(1.4*0.4)
13559# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13560 ux_am = 2.5*sqrt(1.4*0.4)
13561# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13562 p_th = 0.8_wp
13563# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13564 p_am = 0.4_wp
13565# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13566 rho_th = 1._wp
13567# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13568 rho_am = 1._wp
13569# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13570 eps = 1e-6
13571# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13572
13573# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13574 rcut = rcut_arr(j, k)
13575# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13576 xcut = f_cut_on(x_cc(i), eps_smooth)
13577# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13578
13579# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13580 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
13581# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13582 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
13583# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13584 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
13585# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13586
13587# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13588 if (num_fluids == 1) then
13589# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13590 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
13591# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13592 else
13593# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13594 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
13595# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13596 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
13597# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13598 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
13599# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13600 end if
13601# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13602
13603# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13604 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
13605# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13606
13607# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13608 case (370)
13609# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13610 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
13611# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13612
13613# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13614 if (.not. files_loaded) then
13615# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13616 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
13617# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13618 do f = 1, max_files
13619# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13620 write (file_num_str, '(I0)') f
13621# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13622 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
13623# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13624 end do
13625# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13626
13627# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13628 ! Common file reading setup
13629# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13630 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13631# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13632 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
13633# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13634
13635# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13636 select case (num_dims)
13637# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13638 case (1, 2) ! 1D and 2D cases are similar
13639# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13640 ! Count lines
13641# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13642 line_count = 0
13643# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13644 do
13645# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13646 read (unit2, *, iostat=ios2) dummy_x, dummy_y
13647# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13648 if (ios2 /= 0) exit
13649# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13650 line_count = line_count + 1
13651# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13652 end do
13653# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13654 close (unit2)
13655# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13656
13657# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13658 xrows = line_count
13659# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13660 yrows = 1
13661# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13662 index_x = 0
13663# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13664 if (num_dims == 2) index_x = i
13665# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13666#ifdef MFC_DEBUG
13667# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13668 block
13669# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13670 use iso_fortran_env, only: output_unit
13671# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13672
13673# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13674 print *, 'm_icpp_patches.fpp:1325: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
13675# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13676
13677# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13678 call flush (output_unit)
13679# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13680 end block
13681# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13682#endif
13683# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13684 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
13685# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13686
13687# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13688
13689# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13690
13691# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13692#if defined(MFC_OpenACC)
13693# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13694!$acc enter data create(x_coords, stored_values)
13695# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13696#elif defined(MFC_OpenMP)
13697# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13698!$omp target enter data map(always,alloc:x_coords, stored_values)
13699# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13700#endif
13701# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13702
13703# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13704 ! Read data from all files
13705# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13706 do f = 1, max_files
13707# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13708 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13709# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13710 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
13711# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13712
13713# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13714 do iter = 1, xrows
13715# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13716 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
13717# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13718 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
13719# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13720 end do
13721# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13722 close (unit)
13723# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13724 end do
13725# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13726
13727# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13728 ! Calculate offsets
13729# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13730 domain_xstart = x_coords(1)
13731# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13732 x_step = x_cc(1) - x_cc(0)
13733# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13734 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
13735# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13736 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
13737# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13738 global_offset_x = nint(abs(delta_x)/x_step)
13739# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13740
13741# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13742 case (3) ! 3D case - determine grid structure
13743# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13744 ! Find yRows by counting rows with same x
13745# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13746 read (unit2, *, iostat=ios2) x0, y0, dummy_z
13747# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13748 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
13749# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13750
13751# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13752 yrows = 1
13753# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13754 do
13755# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13756 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13757# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13758 if (ios2 /= 0) exit
13759# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13760 if (dummy_x == x0 .and. dummy_y /= y0) then
13761# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13762 yrows = yrows + 1
13763# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13764 else
13765# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13766 exit
13767# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13768 end if
13769# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13770 end do
13771# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13772 close (unit2)
13773# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13774
13775# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13776 ! Count total rows
13777# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13778 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
13779# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13780 nrows = 0
13781# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13782 do
13783# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13784 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
13785# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13786 if (ios2 /= 0) exit
13787# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13788 nrows = nrows + 1
13789# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13790 end do
13791# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13792 close (unit2)
13793# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13794
13795# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13796 xrows = nrows/yrows
13797# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13798#ifdef MFC_DEBUG
13799# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13800 block
13801# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13802 use iso_fortran_env, only: output_unit
13803# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13804
13805# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13806 print *, 'm_icpp_patches.fpp:1325: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
13807# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13808
13809# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13810 call flush (output_unit)
13811# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13812 end block
13813# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13814#endif
13815# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13816 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
13817# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13818
13819# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13820
13821# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13822
13823# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13824
13825# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13826#if defined(MFC_OpenACC)
13827# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13828!$acc enter data create(x_coords, y_coords, stored_values)
13829# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13830#elif defined(MFC_OpenMP)
13831# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13832!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
13833# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13834#endif
13835# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13836 index_x = i
13837# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13838 index_y = j
13839# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13840
13841# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13842 ! Read all files
13843# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13844 do f = 1, max_files
13845# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13846 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
13847# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13848 if (ios /= 0) then
13849# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13850 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
13851# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13852 cycle
13853# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13854 end if
13855# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13856
13857# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13858 iter = 0
13859# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13860 do iix = 1, xrows
13861# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13862 do iiy = 1, yrows
13863# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13864 iter = iter + 1
13865# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13866 if (f == 1) then
13867# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13868 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
13869# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13870 else
13871# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13872 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
13873# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13874 end if
13875# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13876 if (ios /= 0) call s_mpi_abort("Error reading data")
13877# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13878 end do
13879# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13880 end do
13881# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13882 close (unit)
13883# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13884 end do
13885# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13886
13887# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13888 ! Calculate offsets
13889# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13890 x_step = x_cc(1) - x_cc(0)
13891# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13892 y_step = y_cc(1) - y_cc(0)
13893# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13894 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
13895# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13896 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
13897# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13898 global_offset_x = nint(abs(delta_x)/x_step)
13899# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13900 global_offset_y = nint(abs(delta_y)/y_step)
13901# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13902 end select
13903# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13904
13905# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13906 files_loaded = .true.
13907# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13908 end if
13909# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13910
13911# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13912 ! Data assignment
13913# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13914 select case (num_dims)
13915# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13916 case (1)
13917# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13918 idx = i + 1 + global_offset_x
13919# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13920 do f = 1, sys_size
13921# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13922 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
13923# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13924 end do
13925# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13926
13927# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13928 case (2)
13929# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13930 idx = i + 1 + global_offset_x - index_x
13931# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13932 do f = 1, sys_size - 1
13933# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13934 jump = merge(1, 0, f >= momxe)
13935# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13936 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
13937# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13938 end do
13939# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13940 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
13941# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13942
13943# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13944 case (3)
13945# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13946 idx = i + 1 + global_offset_x - index_x
13947# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13948 idy = j + 1 + global_offset_y - index_y
13949# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13950 do f = 1, sys_size - 1
13951# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13952 jump = merge(1, 0, f >= momxe)
13953# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13954 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
13955# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13956 end do
13957# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13958 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
13959# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13960 end select
13961# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13962
13963# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13964 case (380)
13965# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13966 ! This is patch is hard-coded for test suite optimization used in the
13967# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13968 ! 3D_TaylorGreenVortex case:
13969# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13970 ! This analytic patch used geometry 9
13971# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13972 mach = 0.1
13973# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13974 if (patch_id == 1) then
13975# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13976 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)
13977# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13978 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)
13979# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13980 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)
13981# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13982 end if
13983# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13984
13985# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13986 case default
13987# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13988 call s_int_to_str(patch_id, istr)
13989# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13990 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
13991# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13992 end select
13993# 1325 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
13994
13995 end if
13996
13997 ! Updating the patch identities bookkeeping variable
13998 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
13999
14000 end if
14001 end if
14002 end do
14003 end do
14004 end do
14005 if (allocated(stored_values)) then
14006# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14007#ifdef MFC_DEBUG
14008# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14009 block
14010# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14011 use iso_fortran_env, only: output_unit
14012# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14013
14014# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14015 print *, 'm_icpp_patches.fpp:1336: ', '@:DEALLOCATE(stored_values)'
14016# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14017
14018# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14019 call flush (output_unit)
14020# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14021 end block
14022# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14023#endif
14024# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14025
14026# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14027#if defined(MFC_OpenACC)
14028# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14029!$acc exit data delete(stored_values)
14030# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14031#elif defined(MFC_OpenMP)
14032# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14033!$omp target exit data map(release:stored_values)
14034# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14035#endif
14036# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14037 deallocate (stored_values)
14038# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14039#ifdef MFC_DEBUG
14040# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14041 block
14042# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14043 use iso_fortran_env, only: output_unit
14044# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14045
14046# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14047 print *, 'm_icpp_patches.fpp:1336: ', '@:DEALLOCATE(x_coords)'
14048# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14049
14050# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14051 call flush (output_unit)
14052# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14053 end block
14054# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14055#endif
14056# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14057
14058# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14059#if defined(MFC_OpenACC)
14060# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14061!$acc exit data delete(x_coords)
14062# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14063#elif defined(MFC_OpenMP)
14064# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14065!$omp target exit data map(release:x_coords)
14066# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14067#endif
14068# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14069 deallocate (x_coords)
14070# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14071 end if
14072# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14073
14074# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14075 if (allocated(y_coords)) then
14076# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14077#ifdef MFC_DEBUG
14078# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14079 block
14080# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14081 use iso_fortran_env, only: output_unit
14082# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14083
14084# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14085 print *, 'm_icpp_patches.fpp:1336: ', '@:DEALLOCATE(y_coords)'
14086# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14087
14088# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14089 call flush (output_unit)
14090# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14091 end block
14092# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14093#endif
14094# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14095
14096# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14097#if defined(MFC_OpenACC)
14098# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14099!$acc exit data delete(y_coords)
14100# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14101#elif defined(MFC_OpenMP)
14102# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14103!$omp target exit data map(release:y_coords)
14104# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14105#endif
14106# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14107 deallocate (y_coords)
14108# 1336 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14109 end if
14110
14111 end subroutine s_icpp_cuboid
14112
14113 !> The cylindrical patch is a 3D geometry that may be used,
14114 !! for example, in setting up a cylindrical solid boundary
14115 !! confinement, like a blood vessel. The geometry of this
14116 !! patch is well-defined when the centroid, the radius and
14117 !! the length along the cylinder's axis, parallel to the x-,
14118 !! y- or z-coordinate direction, are provided. Please note
14119 !! that the cylindrical patch DOES allow for the smoothing
14120 !! of its lateral boundary.
14121 !! @param patch_id is the patch identifier
14122 !! @param patch_id_fp Array to track patch ids
14123 !! @param q_prim_vf Array of primitive variables
14124 subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
14125
14126 integer, intent(in) :: patch_id
14127#ifdef MFC_MIXED_PRECISION
14128 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
14129#else
14130 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
14131#endif
14132 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
14133
14134 integer :: i, j, k !< Generic loop iterators
14135 real(wp) :: radius
14136 integer :: xRows, yRows, nRows, iix, iiy, max_files
14137# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14138 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
14139# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14140 real(wp) :: x_len, x_step, y_len, y_step
14141# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14142 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
14143# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14144 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
14145# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14146 real(wp) :: delta_x, delta_y
14147# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14148 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
14149# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14150 character(len=200) :: errmsg
14151# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14152 real(wp), allocatable :: stored_values(:, :, :)
14153# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14154 real(wp), allocatable :: x_coords(:), y_coords(:)
14155# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14156 logical :: files_loaded = .false.
14157# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14158 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
14159# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14160 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
14161# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14162 character(len=20) :: file_num_str ! For storing the file number as a string
14163# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14164 character(len=20) :: zeros_part ! For the trailing zeros part
14165# 1363 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14166 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
14167 ! Place any declaration of intermediate variables here
14168# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14169 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
14170# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14171 real(wp) :: eps
14172# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14173
14174# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14175 ! IGR Jets
14176# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14177 ! Arrays to stor position and radii of jets from input file
14178# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14179 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
14180# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14181 ! Variables to describe initial condition of jet
14182# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14183 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
14184# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14185 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
14186# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14187
14188# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14189 real(wp), dimension(0:n, 0:p) :: rcut_arr
14190# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14191 integer :: l, q, s ! Iterators for reading input files
14192# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14193 integer :: start, end ! Ints to keep track of position in file
14194# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14195 character(len=1000) :: line ! String to store line in ile
14196# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14197 character(len=25) :: value ! String to store value in line
14198# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14199 integer :: NJet ! Number of jets
14200# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14201
14202# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14203 eps = 1e-9_wp
14204# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14205
14206# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14207 if (patch_icpp(patch_id)%hcid == 303) then
14208# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14209 eps_smooth = 3._wp
14210# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14211 open (unit=10, file="njet.txt", status="old", action="read")
14212# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14213 read (10, *) njet
14214# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14215 close (10)
14216# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14217
14218# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14219 allocate (y_th_arr(0:njet - 1))
14220# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14221 allocate (z_th_arr(0:njet - 1))
14222# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14223 allocate (r_th_arr(0:njet - 1))
14224# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14225
14226# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14227 open (unit=10, file="jets.csv", status="old", action="read")
14228# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14229 do q = 0, njet - 1
14230# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14231 read (10, '(A)') line ! Read a full line as a string
14232# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14233 start = 1
14234# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14235
14236# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14237 do l = 0, 2
14238# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14239 end = index(line(start:), ',') ! Find the next comma
14240# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14241 if (end == 0) then
14242# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14243 value = trim(adjustl(line(start:))) ! Last value in the line
14244# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14245 else
14246# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14247 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
14248# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14249 start = start + end ! Move to next value
14250# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14251 end if
14252# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14253 if (l == 0) then
14254# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14255 read (value, *) y_th_arr(q) ! Convert string to numeric value
14256# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14257 elseif (l == 1) then
14258# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14259 read (value, *) z_th_arr(q)
14260# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14261 else
14262# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14263 read (value, *) r_th_arr(q)
14264# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14265 end if
14266# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14267 end do
14268# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14269 end do
14270# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14271 close (10)
14272# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14273
14274# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14275 do q = 0, p
14276# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14277 do l = 0, n
14278# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14279 rcut = 0._wp
14280# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14281 do s = 0, njet - 1
14282# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14283 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
14284# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14285 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
14286# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14287 end do
14288# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14289 rcut_arr(l, q) = rcut
14290# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14291 end do
14292# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14293 end do
14294# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14295 end if
14296# 1364 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14297
14298
14299 ! Transferring the cylindrical patch's centroid, length, radius,
14300 ! smoothing patch identity and smoothing coefficient information
14301 x_centroid = patch_icpp(patch_id)%x_centroid
14302 y_centroid = patch_icpp(patch_id)%y_centroid
14303 z_centroid = patch_icpp(patch_id)%z_centroid
14304 length_x = patch_icpp(patch_id)%length_x
14305 length_y = patch_icpp(patch_id)%length_y
14306 length_z = patch_icpp(patch_id)%length_z
14307 radius = patch_icpp(patch_id)%radius
14308 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
14309 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
14310
14311 ! Computing the beginning and the end x-, y- and z-coordinates of
14312 ! the cylinder based on its centroid and lengths
14313 x_boundary%beg = x_centroid - 0.5_wp*length_x
14314 x_boundary%end = x_centroid + 0.5_wp*length_x
14315 y_boundary%beg = y_centroid - 0.5_wp*length_y
14316 y_boundary%end = y_centroid + 0.5_wp*length_y
14317 z_boundary%beg = z_centroid - 0.5_wp*length_z
14318 z_boundary%end = z_centroid + 0.5_wp*length_z
14319
14320 ! Initializing the pseudo volume fraction value to 1. The value will
14321 ! be modified as the patch is laid out on the grid, but only in the
14322 ! case that smearing of the cylindrical patch's boundary is enabled.
14323 eta = 1._wp
14324
14325 ! Checking whether the cylinder covers a particular cell in the
14326 ! domain and verifying whether the current patch has the permission
14327 ! to write to that cell. If both queries check out, the primitive
14328 ! variables of the current patch are assigned to this cell.
14329 do k = 0, p
14330 do j = 0, n
14331 do i = 0, m
14332
14333 if (grid_geometry == 3) then
14334 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
14335 else
14336 cart_y = y_cc(j)
14337 cart_z = z_cc(k)
14338 end if
14339
14340 if (patch_icpp(patch_id)%smoothen) then
14341 if (.not. f_is_default(length_x)) then
14342 eta = tanh(smooth_coeff/min(dy, dz)* &
14343 (sqrt((cart_y - y_centroid)**2 &
14344 + (cart_z - z_centroid)**2) &
14345 - radius))*(-0.5_wp) + 0.5_wp
14346 elseif (.not. f_is_default(length_y)) then
14347 eta = tanh(smooth_coeff/min(dx, dz)* &
14348 (sqrt((x_cc(i) - x_centroid)**2 &
14349 + (cart_z - z_centroid)**2) &
14350 - radius))*(-0.5_wp) + 0.5_wp
14351 else
14352 eta = tanh(smooth_coeff/min(dx, dy)* &
14353 (sqrt((x_cc(i) - x_centroid)**2 &
14354 + (cart_y - y_centroid)**2) &
14355 - radius))*(-0.5_wp) + 0.5_wp
14356 end if
14357 end if
14358
14359 if (((.not. f_is_default(length_x) .and. &
14360 (cart_y - y_centroid)**2 &
14361 + (cart_z - z_centroid)**2 <= radius**2 .and. &
14362 x_boundary%beg <= x_cc(i) .and. &
14363 x_boundary%end >= x_cc(i)) &
14364 .or. &
14365 (.not. f_is_default(length_y) .and. &
14366 (x_cc(i) - x_centroid)**2 &
14367 + (cart_z - z_centroid)**2 <= radius**2 .and. &
14368 y_boundary%beg <= cart_y .and. &
14369 y_boundary%end >= cart_y) &
14370 .or. &
14371 (.not. f_is_default(length_z) .and. &
14372 (x_cc(i) - x_centroid)**2 &
14373 + (cart_y - y_centroid)**2 <= radius**2 .and. &
14374 z_boundary%beg <= cart_z .and. &
14375 z_boundary%end >= cart_z) .and. &
14376 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) .or. &
14377 patch_id_fp(i, j, k) == smooth_patch_id) then
14378
14379 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
14380 eta, q_prim_vf, patch_id_fp)
14381
14382
14383 if (patch_icpp(patch_id)%hcid /= dflt_int) then
14384
14385# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14386 select case (patch_icpp(patch_id)%hcid)
14387# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14388 case (300) ! Rayleigh-Taylor instability
14389# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14390 rhoh = 3._wp
14391# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14392 rhol = 1._wp
14393# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14394 pref = 1.e5_wp
14395# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14396 pint = pref
14397# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14398 h = 0.7_wp
14399# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14400 lam = 0.2_wp
14401# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14402 wl = 2._wp*pi/lam
14403# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14404 amp = 0.025_wp/wl
14405# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14406
14407# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14408 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
14409# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14410
14411# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14412 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
14413# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14414
14415# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14416 if (alph < eps) alph = eps
14417# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14418 if (alph > 1._wp - eps) alph = 1._wp - eps
14419# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14420
14421# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14422 if (y_cc(j) > inth) then
14423# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14424 q_prim_vf(advxb)%sf(i, j, k) = alph
14425# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14426 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
14427# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14428 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
14429# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14430 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
14431# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14432 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
14433# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14434 else
14435# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14436 q_prim_vf(advxb)%sf(i, j, k) = alph
14437# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14438 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
14439# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14440 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
14441# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14442 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
14443# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14444 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
14445# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14446 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
14447# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14448 end if
14449# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14450
14451# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14452 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
14453# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14454 h = 0.0_wp
14455# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14456 lam = 1.0_wp
14457# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14458 amp = patch_icpp(patch_id)%a(2)
14459# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14460 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
14461# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14462 if (x_cc(i) > inth) then
14463# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14464 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
14465# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14466 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
14467# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14468 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
14469# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14470 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
14471# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14472 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
14473# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14474 end if
14475# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14476
14477# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14478 case (302) ! 3D Jet with IGR
14479# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14480 ux_th = 10*sqrt(1.4*0.4)
14481# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14482 ux_am = 0.0*sqrt(1.4)
14483# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14484 p_th = 2.0_wp
14485# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14486 p_am = 1.0_wp
14487# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14488 rho_th = 1._wp
14489# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14490 rho_am = 1._wp
14491# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14492 y_th = 0.0_wp
14493# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14494 z_th = 0.0_wp
14495# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14496 r_th = 1._wp
14497# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14498 eps_smooth = 1._wp
14499# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14500 eps = 1e-6
14501# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14502
14503# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14504 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
14505# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14506 rcut = f_cut_on(r - r_th, eps_smooth)
14507# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14508 xcut = f_cut_on(x_cc(i), eps_smooth)
14509# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14510
14511# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14512 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14513# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14514 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
14515# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14516 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
14517# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14518
14519# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14520 if (num_fluids == 1) then
14521# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14522 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14523# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14524 else
14525# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14526 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14527# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14528 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
14529# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14530 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
14531# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14532 end if
14533# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14534
14535# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14536 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
14537# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14538
14539# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14540 case (303) ! 3D Multijet
14541# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14542
14543# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14544 eps_smooth = 3.0_wp
14545# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14546 ux_th = 10*sqrt(1.4*0.4)
14547# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14548 ux_am = 2.5*sqrt(1.4*0.4)
14549# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14550 p_th = 0.8_wp
14551# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14552 p_am = 0.4_wp
14553# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14554 rho_th = 1._wp
14555# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14556 rho_am = 1._wp
14557# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14558 eps = 1e-6
14559# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14560
14561# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14562 rcut = rcut_arr(j, k)
14563# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14564 xcut = f_cut_on(x_cc(i), eps_smooth)
14565# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14566
14567# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14568 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
14569# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14570 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
14571# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14572 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
14573# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14574
14575# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14576 if (num_fluids == 1) then
14577# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14578 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
14579# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14580 else
14581# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14582 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
14583# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14584 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
14585# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14586 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
14587# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14588 end if
14589# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14590
14591# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14592 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
14593# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14594
14595# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14596 case (370)
14597# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14598 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
14599# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14600
14601# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14602 if (.not. files_loaded) then
14603# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14604 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
14605# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14606 do f = 1, max_files
14607# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14608 write (file_num_str, '(I0)') f
14609# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14610 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
14611# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14612 end do
14613# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14614
14615# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14616 ! Common file reading setup
14617# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14618 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14619# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14620 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
14621# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14622
14623# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14624 select case (num_dims)
14625# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14626 case (1, 2) ! 1D and 2D cases are similar
14627# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14628 ! Count lines
14629# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14630 line_count = 0
14631# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14632 do
14633# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14634 read (unit2, *, iostat=ios2) dummy_x, dummy_y
14635# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14636 if (ios2 /= 0) exit
14637# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14638 line_count = line_count + 1
14639# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14640 end do
14641# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14642 close (unit2)
14643# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14644
14645# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14646 xrows = line_count
14647# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14648 yrows = 1
14649# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14650 index_x = 0
14651# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14652 if (num_dims == 2) index_x = i
14653# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14654#ifdef MFC_DEBUG
14655# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14656 block
14657# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14658 use iso_fortran_env, only: output_unit
14659# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14660
14661# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14662 print *, 'm_icpp_patches.fpp:1451: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
14663# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14664
14665# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14666 call flush (output_unit)
14667# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14668 end block
14669# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14670#endif
14671# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14672 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
14673# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14674
14675# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14676
14677# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14678
14679# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14680#if defined(MFC_OpenACC)
14681# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14682!$acc enter data create(x_coords, stored_values)
14683# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14684#elif defined(MFC_OpenMP)
14685# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14686!$omp target enter data map(always,alloc:x_coords, stored_values)
14687# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14688#endif
14689# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14690
14691# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14692 ! Read data from all files
14693# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14694 do f = 1, max_files
14695# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14696 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14697# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14698 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
14699# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14700
14701# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14702 do iter = 1, xrows
14703# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14704 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
14705# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14706 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
14707# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14708 end do
14709# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14710 close (unit)
14711# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14712 end do
14713# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14714
14715# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14716 ! Calculate offsets
14717# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14718 domain_xstart = x_coords(1)
14719# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14720 x_step = x_cc(1) - x_cc(0)
14721# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14722 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
14723# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14724 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
14725# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14726 global_offset_x = nint(abs(delta_x)/x_step)
14727# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14728
14729# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14730 case (3) ! 3D case - determine grid structure
14731# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14732 ! Find yRows by counting rows with same x
14733# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14734 read (unit2, *, iostat=ios2) x0, y0, dummy_z
14735# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14736 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
14737# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14738
14739# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14740 yrows = 1
14741# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14742 do
14743# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14744 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14745# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14746 if (ios2 /= 0) exit
14747# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14748 if (dummy_x == x0 .and. dummy_y /= y0) then
14749# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14750 yrows = yrows + 1
14751# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14752 else
14753# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14754 exit
14755# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14756 end if
14757# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14758 end do
14759# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14760 close (unit2)
14761# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14762
14763# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14764 ! Count total rows
14765# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14766 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
14767# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14768 nrows = 0
14769# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14770 do
14771# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14772 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
14773# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14774 if (ios2 /= 0) exit
14775# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14776 nrows = nrows + 1
14777# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14778 end do
14779# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14780 close (unit2)
14781# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14782
14783# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14784 xrows = nrows/yrows
14785# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14786#ifdef MFC_DEBUG
14787# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14788 block
14789# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14790 use iso_fortran_env, only: output_unit
14791# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14792
14793# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14794 print *, 'm_icpp_patches.fpp:1451: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
14795# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14796
14797# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14798 call flush (output_unit)
14799# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14800 end block
14801# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14802#endif
14803# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14804 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
14805# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14806
14807# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14808
14809# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14810
14811# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14812
14813# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14814#if defined(MFC_OpenACC)
14815# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14816!$acc enter data create(x_coords, y_coords, stored_values)
14817# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14818#elif defined(MFC_OpenMP)
14819# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14820!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
14821# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14822#endif
14823# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14824 index_x = i
14825# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14826 index_y = j
14827# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14828
14829# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14830 ! Read all files
14831# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14832 do f = 1, max_files
14833# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14834 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
14835# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14836 if (ios /= 0) then
14837# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14838 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
14839# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14840 cycle
14841# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14842 end if
14843# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14844
14845# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14846 iter = 0
14847# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14848 do iix = 1, xrows
14849# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14850 do iiy = 1, yrows
14851# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14852 iter = iter + 1
14853# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14854 if (f == 1) then
14855# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14856 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
14857# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14858 else
14859# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14860 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
14861# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14862 end if
14863# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14864 if (ios /= 0) call s_mpi_abort("Error reading data")
14865# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14866 end do
14867# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14868 end do
14869# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14870 close (unit)
14871# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14872 end do
14873# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14874
14875# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14876 ! Calculate offsets
14877# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14878 x_step = x_cc(1) - x_cc(0)
14879# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14880 y_step = y_cc(1) - y_cc(0)
14881# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14882 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
14883# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14884 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
14885# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14886 global_offset_x = nint(abs(delta_x)/x_step)
14887# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14888 global_offset_y = nint(abs(delta_y)/y_step)
14889# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14890 end select
14891# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14892
14893# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14894 files_loaded = .true.
14895# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14896 end if
14897# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14898
14899# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14900 ! Data assignment
14901# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14902 select case (num_dims)
14903# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14904 case (1)
14905# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14906 idx = i + 1 + global_offset_x
14907# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14908 do f = 1, sys_size
14909# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14910 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
14911# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14912 end do
14913# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14914
14915# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14916 case (2)
14917# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14918 idx = i + 1 + global_offset_x - index_x
14919# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14920 do f = 1, sys_size - 1
14921# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14922 jump = merge(1, 0, f >= momxe)
14923# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14924 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
14925# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14926 end do
14927# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14928 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
14929# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14930
14931# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14932 case (3)
14933# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14934 idx = i + 1 + global_offset_x - index_x
14935# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14936 idy = j + 1 + global_offset_y - index_y
14937# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14938 do f = 1, sys_size - 1
14939# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14940 jump = merge(1, 0, f >= momxe)
14941# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14942 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
14943# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14944 end do
14945# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14946 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
14947# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14948 end select
14949# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14950
14951# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14952 case (380)
14953# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14954 ! This is patch is hard-coded for test suite optimization used in the
14955# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14956 ! 3D_TaylorGreenVortex case:
14957# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14958 ! This analytic patch used geometry 9
14959# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14960 mach = 0.1
14961# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14962 if (patch_id == 1) then
14963# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14964 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)
14965# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14966 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)
14967# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14968 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)
14969# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14970 end if
14971# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14972
14973# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14974 case default
14975# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14976 call s_int_to_str(patch_id, istr)
14977# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14978 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
14979# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14980 end select
14981# 1451 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14982
14983 end if
14984
14985 ! Updating the patch identities bookkeeping variable
14986 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
14987 end if
14988 end do
14989 end do
14990 end do
14991 if (allocated(stored_values)) then
14992# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14993#ifdef MFC_DEBUG
14994# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14995 block
14996# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14997 use iso_fortran_env, only: output_unit
14998# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
14999
15000# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15001 print *, 'm_icpp_patches.fpp:1460: ', '@:DEALLOCATE(stored_values)'
15002# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15003
15004# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15005 call flush (output_unit)
15006# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15007 end block
15008# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15009#endif
15010# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15011
15012# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15013#if defined(MFC_OpenACC)
15014# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15015!$acc exit data delete(stored_values)
15016# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15017#elif defined(MFC_OpenMP)
15018# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15019!$omp target exit data map(release:stored_values)
15020# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15021#endif
15022# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15023 deallocate (stored_values)
15024# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15025#ifdef MFC_DEBUG
15026# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15027 block
15028# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15029 use iso_fortran_env, only: output_unit
15030# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15031
15032# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15033 print *, 'm_icpp_patches.fpp:1460: ', '@:DEALLOCATE(x_coords)'
15034# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15035
15036# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15037 call flush (output_unit)
15038# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15039 end block
15040# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15041#endif
15042# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15043
15044# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15045#if defined(MFC_OpenACC)
15046# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15047!$acc exit data delete(x_coords)
15048# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15049#elif defined(MFC_OpenMP)
15050# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15051!$omp target exit data map(release:x_coords)
15052# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15053#endif
15054# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15055 deallocate (x_coords)
15056# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15057 end if
15058# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15059
15060# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15061 if (allocated(y_coords)) then
15062# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15063#ifdef MFC_DEBUG
15064# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15065 block
15066# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15067 use iso_fortran_env, only: output_unit
15068# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15069
15070# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15071 print *, 'm_icpp_patches.fpp:1460: ', '@:DEALLOCATE(y_coords)'
15072# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15073
15074# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15075 call flush (output_unit)
15076# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15077 end block
15078# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15079#endif
15080# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15081
15082# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15083#if defined(MFC_OpenACC)
15084# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15085!$acc exit data delete(y_coords)
15086# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15087#elif defined(MFC_OpenMP)
15088# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15089!$omp target exit data map(release:y_coords)
15090# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15091#endif
15092# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15093 deallocate (y_coords)
15094# 1460 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15095 end if
15096
15097 end subroutine s_icpp_cylinder
15098
15099 !> The swept plane patch is a 3D geometry that may be used,
15100 !! for example, in creating a solid boundary, or pre-/post-
15101 !! shock region, at an angle with respect to the axes of the
15102 !! Cartesian coordinate system. The geometry of the patch is
15103 !! well-defined when its centroid and normal vector, aimed
15104 !! in the sweep direction, are provided. Note that the sweep
15105 !! plane patch DOES allow the smoothing of its boundary.
15106 !! @param patch_id is the patch identifier
15107 !! @param patch_id_fp Array to track patch ids
15108 !! @param q_prim_vf Primitive variables
15109 subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
15110
15111 integer, intent(in) :: patch_id
15112#ifdef MFC_MIXED_PRECISION
15113 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
15114#else
15115 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
15116#endif
15117 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
15118
15119 integer :: i, j, k !< Generic loop iterators
15120 real(wp) :: a, b, c, d
15121 integer :: xRows, yRows, nRows, iix, iiy, max_files
15122# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15123 integer :: f, iter, ios, ios2, unit, unit2, idx, idy, index_x, index_y, jump, line_count, ycount
15124# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15125 real(wp) :: x_len, x_step, y_len, y_step
15126# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15127 real(wp) :: dummy_x, dummy_y, dummy_z, x0, y0
15128# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15129 integer :: global_offset_x, global_offset_y ! MPI subdomain offset
15130# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15131 real(wp) :: delta_x, delta_y
15132# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15133 character(len=100), dimension(sys_size) :: fileNames ! Arrays to store all data from files
15134# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15135 character(len=200) :: errmsg
15136# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15137 real(wp), allocatable :: stored_values(:, :, :)
15138# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15139 real(wp), allocatable :: x_coords(:), y_coords(:)
15140# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15141 logical :: files_loaded = .false.
15142# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15143 real(wp) :: domain_xstart, domain_xend, domain_ystart, domain_yend
15144# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15145 character(len=*), parameter :: init_dir = "/home/MFC/FilesDirectory" ! For example /home/MFC/examples/1D_Shock/D/
15146# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15147 character(len=20) :: file_num_str ! For storing the file number as a string
15148# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15149 character(len=20) :: zeros_part ! For the trailing zeros part
15150# 1486 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15151 character(len=6), parameter :: zeros_default = "000000" ! Default zeros (can be changed)
15152 ! Place any declaration of intermediate variables here
15153# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15154 real(wp) :: rhoH, rhoL, pRef, pInt, h, lam, wl, amp, intH, alph, Mach
15155# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15156 real(wp) :: eps
15157# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15158
15159# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15160 ! IGR Jets
15161# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15162 ! Arrays to stor position and radii of jets from input file
15163# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15164 real(wp), dimension(:), allocatable :: y_th_arr, z_th_arr, r_th_arr
15165# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15166 ! Variables to describe initial condition of jet
15167# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15168 real(wp) :: r, ux_th, ux_am, p_th, p_am, rho_th, rho_am, y_th, z_th, r_th, eps_smooth
15169# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15170 real(wp) :: rcut, xcut ! Intermediate variables for creating smooth initial condition
15171# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15172
15173# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15174 real(wp), dimension(0:n, 0:p) :: rcut_arr
15175# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15176 integer :: l, q, s ! Iterators for reading input files
15177# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15178 integer :: start, end ! Ints to keep track of position in file
15179# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15180 character(len=1000) :: line ! String to store line in ile
15181# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15182 character(len=25) :: value ! String to store value in line
15183# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15184 integer :: NJet ! Number of jets
15185# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15186
15187# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15188 eps = 1e-9_wp
15189# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15190
15191# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15192 if (patch_icpp(patch_id)%hcid == 303) then
15193# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15194 eps_smooth = 3._wp
15195# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15196 open (unit=10, file="njet.txt", status="old", action="read")
15197# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15198 read (10, *) njet
15199# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15200 close (10)
15201# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15202
15203# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15204 allocate (y_th_arr(0:njet - 1))
15205# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15206 allocate (z_th_arr(0:njet - 1))
15207# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15208 allocate (r_th_arr(0:njet - 1))
15209# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15210
15211# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15212 open (unit=10, file="jets.csv", status="old", action="read")
15213# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15214 do q = 0, njet - 1
15215# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15216 read (10, '(A)') line ! Read a full line as a string
15217# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15218 start = 1
15219# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15220
15221# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15222 do l = 0, 2
15223# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15224 end = index(line(start:), ',') ! Find the next comma
15225# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15226 if (end == 0) then
15227# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15228 value = trim(adjustl(line(start:))) ! Last value in the line
15229# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15230 else
15231# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15232 value = trim(adjustl(line(start:start + end - 2))) ! Extract substring
15233# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15234 start = start + end ! Move to next value
15235# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15236 end if
15237# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15238 if (l == 0) then
15239# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15240 read (value, *) y_th_arr(q) ! Convert string to numeric value
15241# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15242 elseif (l == 1) then
15243# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15244 read (value, *) z_th_arr(q)
15245# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15246 else
15247# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15248 read (value, *) r_th_arr(q)
15249# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15250 end if
15251# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15252 end do
15253# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15254 end do
15255# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15256 close (10)
15257# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15258
15259# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15260 do q = 0, p
15261# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15262 do l = 0, n
15263# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15264 rcut = 0._wp
15265# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15266 do s = 0, njet - 1
15267# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15268 r = sqrt((y_cc(l) - y_th_arr(s))**2._wp + (z_cc(q) - z_th_arr(s))**2._wp)
15269# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15270 rcut = rcut + f_cut_on(r - r_th_arr(s), eps_smooth)
15271# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15272 end do
15273# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15274 rcut_arr(l, q) = rcut
15275# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15276 end do
15277# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15278 end do
15279# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15280 end if
15281# 1487 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15282
15283
15284 ! Transferring the centroid information of the plane to be swept
15285 x_centroid = patch_icpp(patch_id)%x_centroid
15286 y_centroid = patch_icpp(patch_id)%y_centroid
15287 z_centroid = patch_icpp(patch_id)%z_centroid
15288 smooth_patch_id = patch_icpp(patch_id)%smooth_patch_id
15289 smooth_coeff = patch_icpp(patch_id)%smooth_coeff
15290
15291 ! Obtaining coefficients of the equation describing the sweep plane
15292 a = patch_icpp(patch_id)%normal(1)
15293 b = patch_icpp(patch_id)%normal(2)
15294 c = patch_icpp(patch_id)%normal(3)
15295 d = -a*x_centroid - b*y_centroid - c*z_centroid
15296
15297 ! Initializing the pseudo volume fraction value to 1. The value will
15298 ! be modified as the patch is laid out on the grid, but only in the
15299 ! case that smearing of the sweep plane patch's boundary is enabled.
15300 eta = 1._wp
15301
15302 ! Checking whether the region swept by the plane covers a particular
15303 ! cell in the domain and verifying whether the current patch has the
15304 ! permission to write to that cell. If both queries check out, the
15305 ! primitive variables of the current patch are written to this cell.
15306 do k = 0, p
15307 do j = 0, n
15308 do i = 0, m
15309
15310 if (grid_geometry == 3) then
15311 call s_convert_cylindrical_to_cartesian_coord(y_cc(j), z_cc(k))
15312 else
15313 cart_y = y_cc(j)
15314 cart_z = z_cc(k)
15315 end if
15316
15317 if (patch_icpp(patch_id)%smoothen) then
15318 eta = 5.e-1_wp + 5.e-1_wp*tanh(smooth_coeff/min(dx, dy, dz) &
15319 *(a*x_cc(i) + &
15320 b*cart_y + &
15321 c*cart_z + d) &
15322 /sqrt(a**2 + b**2 + c**2))
15323 end if
15324
15325 if ((a*x_cc(i) + b*cart_y + c*cart_z + d >= 0._wp &
15326 .and. &
15327 patch_icpp(patch_id)%alter_patch(patch_id_fp(i, j, k))) &
15328 .or. &
15329 patch_id_fp(i, j, k) == smooth_patch_id) &
15330 then
15331
15332 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
15333 eta, q_prim_vf, patch_id_fp)
15334
15335
15336 if (patch_icpp(patch_id)%hcid /= dflt_int) then
15337
15338# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15339 select case (patch_icpp(patch_id)%hcid)
15340# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15341 case (300) ! Rayleigh-Taylor instability
15342# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15343 rhoh = 3._wp
15344# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15345 rhol = 1._wp
15346# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15347 pref = 1.e5_wp
15348# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15349 pint = pref
15350# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15351 h = 0.7_wp
15352# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15353 lam = 0.2_wp
15354# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15355 wl = 2._wp*pi/lam
15356# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15357 amp = 0.025_wp/wl
15358# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15359
15360# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15361 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
15362# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15363
15364# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15365 alph = 5.e-1_wp*(1._wp + tanh((y_cc(j) - inth)/2.5e-3_wp))
15366# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15367
15368# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15369 if (alph < eps) alph = eps
15370# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15371 if (alph > 1._wp - eps) alph = 1._wp - eps
15372# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15373
15374# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15375 if (y_cc(j) > inth) then
15376# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15377 q_prim_vf(advxb)%sf(i, j, k) = alph
15378# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15379 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
15380# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15381 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
15382# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15383 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
15384# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15385 q_prim_vf(e_idx)%sf(i, j, k) = pref + rhoh*9.81_wp*(1.2_wp - y_cc(j))
15386# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15387 else
15388# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15389 q_prim_vf(advxb)%sf(i, j, k) = alph
15390# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15391 q_prim_vf(advxe)%sf(i, j, k) = 1._wp - alph
15392# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15393 q_prim_vf(contxb)%sf(i, j, k) = alph*rhoh
15394# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15395 q_prim_vf(contxe)%sf(i, j, k) = (1._wp - alph)*rhol
15396# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15397 pint = pref + rhoh*9.81_wp*(1.2_wp - inth)
15398# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15399 q_prim_vf(e_idx)%sf(i, j, k) = pint + rhol*9.81_wp*(inth - y_cc(j))
15400# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15401 end if
15402# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15403
15404# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15405 case (301) ! (3D lung geometry in X direction, |sin(*)+sin(*)|)
15406# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15407 h = 0.0_wp
15408# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15409 lam = 1.0_wp
15410# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15411 amp = patch_icpp(patch_id)%a(2)
15412# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15413 inth = amp*abs((sin(2*pi*y_cc(j)/lam - pi/2) + sin(2*pi*z_cc(k)/lam - pi/2)) + h)
15414# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15415 if (x_cc(i) > inth) then
15416# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15417 q_prim_vf(contxb)%sf(i, j, k) = patch_icpp(1)%alpha_rho(1)
15418# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15419 q_prim_vf(contxe)%sf(i, j, k) = patch_icpp(1)%alpha_rho(2)
15420# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15421 q_prim_vf(e_idx)%sf(i, j, k) = patch_icpp(1)%pres
15422# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15423 q_prim_vf(advxb)%sf(i, j, k) = patch_icpp(1)%alpha(1)
15424# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15425 q_prim_vf(advxe)%sf(i, j, k) = patch_icpp(1)%alpha(2)
15426# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15427 end if
15428# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15429
15430# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15431 case (302) ! 3D Jet with IGR
15432# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15433 ux_th = 10*sqrt(1.4*0.4)
15434# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15435 ux_am = 0.0*sqrt(1.4)
15436# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15437 p_th = 2.0_wp
15438# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15439 p_am = 1.0_wp
15440# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15441 rho_th = 1._wp
15442# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15443 rho_am = 1._wp
15444# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15445 y_th = 0.0_wp
15446# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15447 z_th = 0.0_wp
15448# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15449 r_th = 1._wp
15450# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15451 eps_smooth = 1._wp
15452# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15453 eps = 1e-6
15454# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15455
15456# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15457 r = sqrt((y_cc(j) - y_th)**2._wp + (z_cc(k) - z_th)**2._wp)
15458# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15459 rcut = f_cut_on(r - r_th, eps_smooth)
15460# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15461 xcut = f_cut_on(x_cc(i), eps_smooth)
15462# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15463
15464# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15465 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15466# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15467 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
15468# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15469 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
15470# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15471
15472# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15473 if (num_fluids == 1) then
15474# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15475 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15476# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15477 else
15478# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15479 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15480# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15481 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
15482# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15483 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
15484# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15485 end if
15486# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15487
15488# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15489 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
15490# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15491
15492# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15493 case (303) ! 3D Multijet
15494# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15495
15496# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15497 eps_smooth = 3.0_wp
15498# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15499 ux_th = 10*sqrt(1.4*0.4)
15500# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15501 ux_am = 2.5*sqrt(1.4*0.4)
15502# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15503 p_th = 0.8_wp
15504# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15505 p_am = 0.4_wp
15506# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15507 rho_th = 1._wp
15508# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15509 rho_am = 1._wp
15510# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15511 eps = 1e-6
15512# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15513
15514# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15515 rcut = rcut_arr(j, k)
15516# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15517 xcut = f_cut_on(x_cc(i), eps_smooth)
15518# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15519
15520# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15521 q_prim_vf(momxb)%sf(i, j, k) = ux_th*rcut*xcut + ux_am
15522# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15523 q_prim_vf(momxb + 1)%sf(i, j, k) = 0._wp
15524# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15525 q_prim_vf(momxe)%sf(i, j, k) = 0._wp
15526# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15527
15528# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15529 if (num_fluids == 1) then
15530# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15531 q_prim_vf(contxb)%sf(i, j, k) = (rho_th - rho_am)*rcut*xcut + rho_am
15532# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15533 else
15534# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15535 q_prim_vf(advxb)%sf(i, j, k) = (1._wp - 2._wp*eps)*rcut*xcut + eps
15536# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15537 q_prim_vf(contxb)%sf(i, j, k) = rho_th*q_prim_vf(advxb)%sf(i, j, k)
15538# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15539 q_prim_vf(contxe)%sf(i, j, k) = rho_am*(1._wp - q_prim_vf(advxb)%sf(i, j, k))
15540# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15541 end if
15542# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15543
15544# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15545 q_prim_vf(e_idx)%sf(i, j, k) = p_th*rcut*xcut + p_am
15546# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15547
15548# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15549 case (370)
15550# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15551 ! This hardcoded case extrudes a 2D profile to initialize a 3D simulation domain
15552# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15553
15554# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15555 if (.not. files_loaded) then
15556# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15557 max_files = merge(sys_size, sys_size - 1, num_dims == 1)
15558# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15559 do f = 1, max_files
15560# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15561 write (file_num_str, '(I0)') f
15562# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15563 filenames(f) = trim(init_dir)//"prim."//trim(file_num_str)//".00."//zeros_default//".dat"
15564# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15565 end do
15566# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15567
15568# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15569 ! Common file reading setup
15570# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15571 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15572# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15573 if (ios2 /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(1)))
15574# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15575
15576# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15577 select case (num_dims)
15578# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15579 case (1, 2) ! 1D and 2D cases are similar
15580# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15581 ! Count lines
15582# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15583 line_count = 0
15584# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15585 do
15586# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15587 read (unit2, *, iostat=ios2) dummy_x, dummy_y
15588# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15589 if (ios2 /= 0) exit
15590# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15591 line_count = line_count + 1
15592# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15593 end do
15594# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15595 close (unit2)
15596# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15597
15598# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15599 xrows = line_count
15600# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15601 yrows = 1
15602# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15603 index_x = 0
15604# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15605 if (num_dims == 2) index_x = i
15606# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15607#ifdef MFC_DEBUG
15608# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15609 block
15610# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15611 use iso_fortran_env, only: output_unit
15612# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15613
15614# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15615 print *, 'm_icpp_patches.fpp:1542: ', '@:ALLOCATE(x_coords(xRows), stored_values(xRows, 1, sys_size))'
15616# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15617
15618# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15619 call flush (output_unit)
15620# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15621 end block
15622# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15623#endif
15624# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15625 allocate (x_coords(xrows), stored_values(xrows, 1, sys_size))
15626# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15627
15628# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15629
15630# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15631
15632# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15633#if defined(MFC_OpenACC)
15634# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15635!$acc enter data create(x_coords, stored_values)
15636# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15637#elif defined(MFC_OpenMP)
15638# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15639!$omp target enter data map(always,alloc:x_coords, stored_values)
15640# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15641#endif
15642# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15643
15644# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15645 ! Read data from all files
15646# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15647 do f = 1, max_files
15648# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15649 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15650# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15651 if (ios /= 0) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
15652# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15653
15654# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15655 do iter = 1, xrows
15656# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15657 read (unit, *, iostat=ios) x_coords(iter), stored_values(iter, 1, f)
15658# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15659 if (ios /= 0) call s_mpi_abort("Error reading file: "//trim(filenames(f)))
15660# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15661 end do
15662# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15663 close (unit)
15664# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15665 end do
15666# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15667
15668# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15669 ! Calculate offsets
15670# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15671 domain_xstart = x_coords(1)
15672# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15673 x_step = x_cc(1) - x_cc(0)
15674# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15675 delta_x = merge(x_cc(0) - domain_xstart + x_step/2.0, &
15676# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15677 x_cc(index_x) - domain_xstart + x_step/2.0, num_dims == 1)
15678# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15679 global_offset_x = nint(abs(delta_x)/x_step)
15680# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15681
15682# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15683 case (3) ! 3D case - determine grid structure
15684# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15685 ! Find yRows by counting rows with same x
15686# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15687 read (unit2, *, iostat=ios2) x0, y0, dummy_z
15688# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15689 if (ios2 /= 0) call s_mpi_abort("Error reading first line")
15690# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15691
15692# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15693 yrows = 1
15694# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15695 do
15696# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15697 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15698# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15699 if (ios2 /= 0) exit
15700# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15701 if (dummy_x == x0 .and. dummy_y /= y0) then
15702# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15703 yrows = yrows + 1
15704# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15705 else
15706# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15707 exit
15708# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15709 end if
15710# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15711 end do
15712# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15713 close (unit2)
15714# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15715
15716# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15717 ! Count total rows
15718# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15719 open (newunit=unit2, file=trim(filenames(1)), status='old', action='read', iostat=ios2)
15720# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15721 nrows = 0
15722# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15723 do
15724# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15725 read (unit2, *, iostat=ios2) dummy_x, dummy_y, dummy_z
15726# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15727 if (ios2 /= 0) exit
15728# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15729 nrows = nrows + 1
15730# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15731 end do
15732# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15733 close (unit2)
15734# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15735
15736# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15737 xrows = nrows/yrows
15738# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15739#ifdef MFC_DEBUG
15740# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15741 block
15742# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15743 use iso_fortran_env, only: output_unit
15744# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15745
15746# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15747 print *, 'm_icpp_patches.fpp:1542: ', '@:ALLOCATE(x_coords(nrows), y_coords(nrows), stored_values(xRows, yRows, sys_size))'
15748# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15749
15750# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15751 call flush (output_unit)
15752# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15753 end block
15754# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15755#endif
15756# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15757 allocate (x_coords(nrows), y_coords(nrows), stored_values(xrows, yrows, sys_size))
15758# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15759
15760# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15761
15762# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15763
15764# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15765
15766# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15767#if defined(MFC_OpenACC)
15768# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15769!$acc enter data create(x_coords, y_coords, stored_values)
15770# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15771#elif defined(MFC_OpenMP)
15772# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15773!$omp target enter data map(always,alloc:x_coords, y_coords, stored_values)
15774# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15775#endif
15776# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15777 index_x = i
15778# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15779 index_y = j
15780# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15781
15782# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15783 ! Read all files
15784# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15785 do f = 1, max_files
15786# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15787 open (newunit=unit, file=trim(filenames(f)), status='old', action='read', iostat=ios)
15788# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15789 if (ios /= 0) then
15790# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15791 if (f == 1) call s_mpi_abort("Error opening file: "//trim(filenames(f)))
15792# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15793 cycle
15794# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15795 end if
15796# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15797
15798# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15799 iter = 0
15800# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15801 do iix = 1, xrows
15802# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15803 do iiy = 1, yrows
15804# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15805 iter = iter + 1
15806# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15807 if (f == 1) then
15808# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15809 read (unit, *, iostat=ios) x_coords(iter), y_coords(iter), stored_values(iix, iiy, f)
15810# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15811 else
15812# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15813 read (unit, *, iostat=ios) dummy_x, dummy_y, stored_values(iix, iiy, f)
15814# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15815 end if
15816# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15817 if (ios /= 0) call s_mpi_abort("Error reading data")
15818# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15819 end do
15820# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15821 end do
15822# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15823 close (unit)
15824# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15825 end do
15826# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15827
15828# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15829 ! Calculate offsets
15830# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15831 x_step = x_cc(1) - x_cc(0)
15832# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15833 y_step = y_cc(1) - y_cc(0)
15834# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15835 delta_x = x_cc(index_x) - x_coords(1) + x_step/2.0_wp
15836# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15837 delta_y = y_cc(index_y) - y_coords(1) + y_step/2.0_wp
15838# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15839 global_offset_x = nint(abs(delta_x)/x_step)
15840# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15841 global_offset_y = nint(abs(delta_y)/y_step)
15842# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15843 end select
15844# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15845
15846# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15847 files_loaded = .true.
15848# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15849 end if
15850# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15851
15852# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15853 ! Data assignment
15854# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15855 select case (num_dims)
15856# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15857 case (1)
15858# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15859 idx = i + 1 + global_offset_x
15860# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15861 do f = 1, sys_size
15862# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15863 q_prim_vf(f)%sf(i, 0, 0) = stored_values(idx, 1, f)
15864# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15865 end do
15866# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15867
15868# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15869 case (2)
15870# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15871 idx = i + 1 + global_offset_x - index_x
15872# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15873 do f = 1, sys_size - 1
15874# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15875 jump = merge(1, 0, f >= momxe)
15876# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15877 q_prim_vf(f + jump)%sf(i, j, 0) = stored_values(idx, 1, f)
15878# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15879 end do
15880# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15881 q_prim_vf(momxe)%sf(i, j, 0) = 0.0_wp
15882# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15883
15884# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15885 case (3)
15886# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15887 idx = i + 1 + global_offset_x - index_x
15888# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15889 idy = j + 1 + global_offset_y - index_y
15890# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15891 do f = 1, sys_size - 1
15892# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15893 jump = merge(1, 0, f >= momxe)
15894# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15895 q_prim_vf(f + jump)%sf(i, j, k) = stored_values(idx, idy, f)
15896# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15897 end do
15898# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15899 q_prim_vf(momxe)%sf(i, j, k) = 0.0_wp
15900# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15901 end select
15902# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15903
15904# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15905 case (380)
15906# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15907 ! This is patch is hard-coded for test suite optimization used in the
15908# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15909 ! 3D_TaylorGreenVortex case:
15910# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15911 ! This analytic patch used geometry 9
15912# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15913 mach = 0.1
15914# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15915 if (patch_id == 1) then
15916# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15917 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)
15918# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15919 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)
15920# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15921 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)
15922# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15923 end if
15924# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15925
15926# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15927 case default
15928# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15929 call s_int_to_str(patch_id, istr)
15930# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15931 call s_mpi_abort("Invalid hcid specified for patch "//trim(istr))
15932# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15933 end select
15934# 1542 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15935
15936 end if
15937
15938 ! Updating the patch identities bookkeeping variable
15939 if (1._wp - eta < sgm_eps) patch_id_fp(i, j, k) = patch_id
15940 end if
15941
15942 end do
15943 end do
15944 end do
15945 if (allocated(stored_values)) then
15946# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15947#ifdef MFC_DEBUG
15948# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15949 block
15950# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15951 use iso_fortran_env, only: output_unit
15952# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15953
15954# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15955 print *, 'm_icpp_patches.fpp:1552: ', '@:DEALLOCATE(stored_values)'
15956# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15957
15958# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15959 call flush (output_unit)
15960# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15961 end block
15962# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15963#endif
15964# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15965
15966# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15967#if defined(MFC_OpenACC)
15968# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15969!$acc exit data delete(stored_values)
15970# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15971#elif defined(MFC_OpenMP)
15972# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15973!$omp target exit data map(release:stored_values)
15974# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15975#endif
15976# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15977 deallocate (stored_values)
15978# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15979#ifdef MFC_DEBUG
15980# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15981 block
15982# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15983 use iso_fortran_env, only: output_unit
15984# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15985
15986# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15987 print *, 'm_icpp_patches.fpp:1552: ', '@:DEALLOCATE(x_coords)'
15988# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15989
15990# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15991 call flush (output_unit)
15992# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15993 end block
15994# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15995#endif
15996# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15997
15998# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
15999#if defined(MFC_OpenACC)
16000# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16001!$acc exit data delete(x_coords)
16002# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16003#elif defined(MFC_OpenMP)
16004# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16005!$omp target exit data map(release:x_coords)
16006# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16007#endif
16008# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16009 deallocate (x_coords)
16010# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16011 end if
16012# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16013
16014# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16015 if (allocated(y_coords)) then
16016# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16017#ifdef MFC_DEBUG
16018# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16019 block
16020# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16021 use iso_fortran_env, only: output_unit
16022# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16023
16024# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16025 print *, 'm_icpp_patches.fpp:1552: ', '@:DEALLOCATE(y_coords)'
16026# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16027
16028# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16029 call flush (output_unit)
16030# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16031 end block
16032# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16033#endif
16034# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16035
16036# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16037#if defined(MFC_OpenACC)
16038# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16039!$acc exit data delete(y_coords)
16040# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16041#elif defined(MFC_OpenMP)
16042# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16043!$omp target exit data map(release:y_coords)
16044# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16045#endif
16046# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16047 deallocate (y_coords)
16048# 1552 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16049 end if
16050
16051 end subroutine s_icpp_sweep_plane
16052
16053 !> The STL patch is a 2/3D geometry that is imported from an STL file.
16054 !! @param patch_id is the patch identifier
16055 !! @param patch_id_fp Array to track patch ids
16056 !! @param q_prim_vf Primitive variables
16057 subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
16058
16059 integer, intent(in) :: patch_id
16060#ifdef MFC_MIXED_PRECISION
16061 integer(kind=1), dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
16062#else
16063 integer, dimension(0:m, 0:n, 0:p), intent(inout) :: patch_id_fp
16064#endif
16065 type(scalar_field), dimension(1:sys_size), intent(inout) :: q_prim_vf
16066
16067 ! Variables for IBM+STL
16068 real(wp) :: normals(1:3) !< Boundary normal buffer
16069 integer :: boundary_vertex_count, boundary_edge_count, total_vertices !< Boundary vertex
16070 real(wp), allocatable, dimension(:, :, :) :: boundary_v !< Boundary vertex buffer
16071 real(wp) :: distance !< Levelset distance buffer
16072 logical :: interpolate !< Logical variable to determine whether or not the model should be interpolated
16073
16074 integer :: i, j, k !< Generic loop iterators
16075
16076 type(t_bbox) :: bbox, bbox_old
16077 type(t_model) :: model
16078 type(ic_model_parameters) :: params
16079
16080 real(wp), dimension(1:3) :: point, model_center
16081
16082 real(wp) :: grid_mm(1:3, 1:2)
16083
16084 integer :: cell_num
16085 integer :: ncells
16086
16087 real(wp), dimension(1:4, 1:4) :: transform, transform_n
16088
16089 if (proc_rank == 0) then
16090 print *, " * Reading model: "//trim(patch_icpp(patch_id)%model_filepath)
16091 end if
16092
16093 model = f_model_read(patch_icpp(patch_id)%model_filepath)
16094 params%scale(:) = patch_icpp(patch_id)%model_scale(:)
16095 params%translate(:) = patch_icpp(patch_id)%model_translate(:)
16096 params%rotate(:) = patch_icpp(patch_id)%model_rotate(:)
16097 params%spc = patch_icpp(patch_id)%model_spc
16098 params%threshold = patch_icpp(patch_id)%model_threshold
16099
16100 if (proc_rank == 0) then
16101 print *, " * Transforming model."
16102 end if
16103
16104 ! Get the model center before transforming the model
16105 bbox_old = f_create_bbox(model)
16106 model_center(1:3) = (bbox_old%min(1:3) + bbox_old%max(1:3))/2._wp
16107
16108 ! Compute the transform matrices for vertices and normals
16109 transform = f_create_transform_matrix(params, model_center)
16110 transform_n = f_create_transform_matrix(params)
16111
16112 call s_transform_model(model, transform, transform_n)
16113
16114 ! Recreate the bounding box after transformation
16115 bbox = f_create_bbox(model)
16116
16117 ! Show the number of vertices in the original STL model
16118 if (proc_rank == 0) then
16119 print *, ' * Number of input model vertices:', 3*model%ntrs
16120 end if
16121
16122 call s_check_boundary(model, boundary_v, boundary_vertex_count, boundary_edge_count)
16123
16124 ! Show the number of edges and boundary edges in 2D STL models
16125 if (proc_rank == 0 .and. p == 0) then
16126 print *, ' * Number of 2D model boundary edges:', boundary_edge_count
16127 end if
16128
16129 if (proc_rank == 0) then
16130 write (*, "(A, 3(2X, F20.10))") " > Model: Min:", bbox%min(1:3)
16131 write (*, "(A, 3(2X, F20.10))") " > Cen:", (bbox%min(1:3) + bbox%max(1:3))/2._wp
16132 write (*, "(A, 3(2X, F20.10))") " > Max:", bbox%max(1:3)
16133
16134 !call s_model_write("__out__.stl", model)
16135 !call s_model_write("__out__.obj", model)
16136
16137 grid_mm(1, :) = (/minval(x_cc) - 0.e5_wp*dx, maxval(x_cc) + 0.e5_wp*dx/)
16138 grid_mm(2, :) = (/minval(y_cc) - 0.e5_wp*dy, maxval(y_cc) + 0.e5_wp*dy/)
16139
16140 if (p > 0) then
16141 grid_mm(3, :) = (/minval(z_cc) - 0.e5_wp*dz, maxval(z_cc) + 0.e5_wp*dz/)
16142 else
16143 grid_mm(3, :) = (/0._wp, 0._wp/)
16144 end if
16145
16146 write (*, "(A, 3(2X, F20.10))") " > Domain: Min:", grid_mm(:, 1)
16147 write (*, "(A, 3(2X, F20.10))") " > Cen:", (grid_mm(:, 1) + grid_mm(:, 2))/2._wp
16148 write (*, "(A, 3(2X, F20.10))") " > Max:", grid_mm(:, 2)
16149 end if
16150
16151 ncells = (m + 1)*(n + 1)*(p + 1)
16152 do i = 0, m; do j = 0, n; do k = 0, p
16153
16154 cell_num = i*(n + 1)*(p + 1) + j*(p + 1) + (k + 1)
16155 if (proc_rank == 0 .and. mod(cell_num, ncells/100) == 0) then
16156 write (*, "(A, I3, A)", advance="no") &
16157 char(13)//" * Generating grid: ", &
16158 nint(100*real(cell_num)/ncells), "%"
16159 end if
16160
16161 point = (/x_cc(i), y_cc(j), 0._wp/)
16162 if (p > 0) then
16163 point(3) = z_cc(k)
16164 end if
16165
16166 if (grid_geometry == 3) then
16167 point = f_convert_cyl_to_cart(point)
16168 end if
16169
16170 eta = f_model_is_inside(model, point, (/dx, dy, dz/), patch_icpp(patch_id)%model_spc)
16171
16172 if (eta > patch_icpp(patch_id)%model_threshold) then
16173 eta = 1._wp
16174 else if (.not. patch_icpp(patch_id)%smoothen) then
16175 eta = 0._wp
16176 end if
16177
16178 call s_assign_patch_primitive_variables(patch_id, i, j, k, &
16179 eta, q_prim_vf, patch_id_fp)
16180
16181 ! Note: Should probably use *eta* to compute primitive variables
16182 ! if defining them analytically.
16183
16184 end do; end do; end do
16185
16186 if (proc_rank == 0) then
16187 print *, ""
16188 print *, " * Cleaning up."
16189 end if
16190
16191 call s_model_free(model)
16192
16193 end subroutine s_icpp_model
16194
16195 !> @brief Converts cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
16196 subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z)
16197
16198# 1700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16199#if MFC_OpenACC
16200# 1700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16201!$acc routine seq
16202# 1700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16203#elif MFC_OpenMP
16204# 1700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16205
16206# 1700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16207
16208# 1700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16209!$omp declare target device_type(any)
16210# 1700 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16211#endif
16212
16213 real(wp), intent(in) :: cyl_y, cyl_z
16214
16215 cart_y = cyl_y*sin(cyl_z)
16216 cart_z = cyl_y*cos(cyl_z)
16217
16218 end subroutine s_convert_cylindrical_to_cartesian_coord
16219
16220 !> @brief Returns a 3D Cartesian coordinate vector from a cylindrical (x, r, theta) input vector.
16221 function f_convert_cyl_to_cart(cyl) result(cart)
16222
16223
16224# 1712 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16225#if MFC_OpenACC
16226# 1712 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16227!$acc routine seq
16228# 1712 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16229#elif MFC_OpenMP
16230# 1712 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16231
16232# 1712 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16233
16234# 1712 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16235!$omp declare target device_type(any)
16236# 1712 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16237#endif
16238
16239 real(wp), dimension(1:3), intent(in) :: cyl
16240 real(wp), dimension(1:3) :: cart
16241
16242 cart = (/cyl(1), &
16243 cyl(2)*sin(cyl(3)), &
16244 cyl(2)*cos(cyl(3))/)
16245
16246 end function f_convert_cyl_to_cart
16247
16248 !> @brief Computes the spherical azimuthal angle from cylindrical (x, r) coordinates.
16249 subroutine s_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y)
16250
16251# 1725 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16252#if MFC_OpenACC
16253# 1725 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16254!$acc routine seq
16255# 1725 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16256#elif MFC_OpenMP
16257# 1725 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16258
16259# 1725 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16260
16261# 1725 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16262!$omp declare target device_type(any)
16263# 1725 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16264#endif
16265
16266 real(wp), intent(IN) :: cyl_x, cyl_y
16267
16268 sph_phi = atan(cyl_y/cyl_x)
16269
16270 end subroutine s_convert_cylindrical_to_spherical_coord
16271
16272 !> Archimedes spiral function
16273 !! @param myth Angle
16274 !! @param offset Thickness
16275 !! @param a Starting position
16276 elemental function f_r(myth, offset, a)
16277
16278
16279# 1739 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16280#if MFC_OpenACC
16281# 1739 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16282!$acc routine seq
16283# 1739 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16284#elif MFC_OpenMP
16285# 1739 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16286
16287# 1739 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16288
16289# 1739 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16290!$omp declare target device_type(any)
16291# 1739 "/home/runner/work/MFC/MFC/src/pre_process/m_icpp_patches.fpp"
16292#endif
16293 real(wp), intent(in) :: myth, offset, a
16294 real(wp) :: b
16295 real(wp) :: f_r
16296
16297 !r(th) = a + b*th
16298
16299 b = 2._wp*a/(2._wp*pi)
16300 f_r = a + b*myth + offset
16301 end function f_r
16302
16303end module m_icpp_patches
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1182
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1182
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1182
m_assign_variables
Assigns initial primitive variables to computational cells based on patch geometry.
Definition m_assign_variables.fpp.f90:305
m_assign_variables::s_assign_patch_primitive_variables
procedure(s_assign_patch_xxxxx_primitive_variables), pointer, public s_assign_patch_primitive_variables
Definition m_assign_variables.fpp.f90:323
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::small_radius
real(wp), parameter small_radius
Radius cutoff to avoid division by zero for 3D spherical harmonic patch (geometry 14).
Definition m_constants.fpp.f90:19
m_constants::dflt_int
integer, parameter dflt_int
Default integer value.
Definition m_constants.fpp.f90:24
m_constants::max_2d_fourier_modes
integer, parameter max_2d_fourier_modes
Max Fourier mode index for 2D modal patch (geometry 13).
Definition m_constants.fpp.f90:30
m_constants::max_sph_harm_degree
integer, parameter max_sph_harm_degree
Max degree L for 3D spherical harmonic patch (geometry 14).
Definition m_constants.fpp.f90:31
m_constants::pi
real(wp), parameter pi
Pi.
Definition m_constants.fpp.f90:17
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:294
m_global_parameters
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_global_parameters::proc_rank
integer proc_rank
Rank of the local processor.
Definition m_global_parameters.fpp.f90:45
m_global_parameters::sys_size
integer sys_size
Number of unknowns in the system of equations.
Definition m_global_parameters.fpp.f90:97
m_global_parameters::num_patches
integer num_patches
Number of patches composing initial condition.
Definition m_global_parameters.fpp.f90:205
m_global_parameters::b_idx
type(int_bounds_info) b_idx
Indexes of first and last magnetic field eqns.
Definition m_global_parameters.fpp.f90:128
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:59
m_global_parameters::x_cc
real(wp), dimension(:), allocatable x_cc
Definition m_global_parameters.fpp.f90:65
m_global_parameters::patch_icpp
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...
Definition m_global_parameters.fpp.f90:207
m_global_parameters::p
integer p
Definition m_global_parameters.fpp.f90:50
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:49
m_global_parameters::m
integer m
Definition m_global_parameters.fpp.f90:48
m_global_parameters::momxb
integer momxb
Definition m_global_parameters.fpp.f90:287
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:294
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:305
m_icpp_patches
Allocate memory and read initial condition data for IC extrusion.
Definition m_icpp_patches.fpp.f90:364
m_icpp_patches::s_icpp_ellipse
subroutine s_icpp_ellipse(patch_id, patch_id_fp, q_prim_vf)
The elliptical patch is a 2D geometry. The geometry of the patch is well-defined when its centroid an...
Definition m_icpp_patches.fpp.f90:5838
m_icpp_patches::cart_y
real(wp) cart_y
Definition m_icpp_patches.fpp.f90:406
m_icpp_patches::y_centroid
real(wp) y_centroid
Definition m_icpp_patches.fpp.f90:390
m_icpp_patches::length_x
real(wp) length_x
Definition m_icpp_patches.fpp.f90:391
m_icpp_patches::x_centroid
real(wp) x_centroid
Definition m_icpp_patches.fpp.f90:390
m_icpp_patches::f_convert_cyl_to_cart
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.
Definition m_icpp_patches.fpp.f90:16222
m_icpp_patches::s_icpp_circle
subroutine s_icpp_circle(patch_id, patch_id_fp, q_prim_vf)
The circular patch is a 2D geometry that may be used, for example, in creating a bubble or a droplet....
Definition m_icpp_patches.fpp.f90:2450
m_icpp_patches::s_icpp_2d_taylorgreen_vortex
subroutine s_icpp_2d_taylorgreen_vortex(patch_id, patch_id_fp, q_prim_vf)
The Taylor Green vortex is 2D decaying vortex that may be used, for example, to verify the effects of...
Definition m_icpp_patches.fpp.f90:10199
m_icpp_patches::s_icpp_cuboid
subroutine s_icpp_cuboid(patch_id, patch_id_fp, q_prim_vf)
The cuboidal patch is a 3D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:13171
m_icpp_patches::s_icpp_varcircle
subroutine s_icpp_varcircle(patch_id, patch_id_fp, q_prim_vf)
The varcircle patch is a 2D geometry that may be used . It generatres an annulus.
Definition m_icpp_patches.fpp.f90:3677
m_icpp_patches::s_icpp_2d_modal
subroutine s_icpp_2d_modal(patch_id, patch_id_fp, q_prim_vf)
2D modal (Fourier) patch. theta = atan2(y - y_centroid, x - x_centroid). Additive (modal_use_exp_form...
Definition m_icpp_patches.fpp.f90:12100
m_icpp_patches::cart_z
real(wp) cart_z
Definition m_icpp_patches.fpp.f90:406
m_icpp_patches::s_convert_cylindrical_to_spherical_coord
subroutine s_convert_cylindrical_to_spherical_coord(cyl_x, cyl_y)
Computes the spherical azimuthal angle from cylindrical (x, r) coordinates.
Definition m_icpp_patches.fpp.f90:16250
m_icpp_patches::length_z
real(wp) length_z
Definition m_icpp_patches.fpp.f90:391
m_icpp_patches::istr
character(len=5) istr
Definition m_icpp_patches.fpp.f90:417
m_icpp_patches::s_icpp_sweep_plane
subroutine s_icpp_sweep_plane(patch_id, patch_id_fp, q_prim_vf)
The swept plane patch is a 3D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:15110
m_icpp_patches::s_icpp_rectangle
subroutine s_icpp_rectangle(patch_id, patch_id_fp, q_prim_vf)
The rectangular patch is a 2D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:8023
m_icpp_patches::sph_phi
real(wp) sph_phi
Variables to be used to hold cell locations in Cartesian coordinates if 3D simulation is using cylind...
Definition m_icpp_patches.fpp.f90:407
m_icpp_patches::s_apply_icpp_patches
impure subroutine, public s_apply_icpp_patches(patch_id_fp, q_prim_vf)
Dispatches each initial condition patch to its geometry-specific initialization routine.
Definition m_icpp_patches.fpp.f90:423
m_icpp_patches::smooth_coeff
real(wp) smooth_coeff
These variables are analogous in both meaning and use to the similarly named components in the ic_pat...
Definition m_icpp_patches.fpp.f90:394
m_icpp_patches::s_icpp_line_segment
subroutine s_icpp_line_segment(patch_id, patch_id_fp, q_prim_vf)
The line segment patch is a 1D geometry that may be used, for example, in creating a Riemann problem....
Definition m_icpp_patches.fpp.f90:549
m_icpp_patches::y_boundary
type(bounds_info) y_boundary
Definition m_icpp_patches.fpp.f90:411
m_icpp_patches::s_icpp_sphere
subroutine s_icpp_sphere(patch_id, patch_id_fp, q_prim_vf)
The spherical patch is a 3D geometry that may be used, for example, in creating a bubble or a droplet...
Definition m_icpp_patches.fpp.f90:12220
m_icpp_patches::eta
real(wp) eta
In the case that smoothing of patch boundaries is enabled and the boundary between two adjacent patch...
Definition m_icpp_patches.fpp.f90:400
m_icpp_patches::cart_x
real(wp) cart_x
Definition m_icpp_patches.fpp.f90:406
m_icpp_patches::s_icpp_1d_bubble_pulse
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.
Definition m_icpp_patches.fpp.f90:11434
m_icpp_patches::s_icpp_3d_spherical_harmonic
subroutine s_icpp_3d_spherical_harmonic(patch_id, patch_id_fp, q_prim_vf)
3D spherical harmonic patch. Surface r = radius + sum_lm sph_har_coeff(l,m)*Y_lm(theta,...
Definition m_icpp_patches.fpp.f90:12153
m_icpp_patches::length_y
real(wp) length_y
Definition m_icpp_patches.fpp.f90:391
m_icpp_patches::s_icpp_model
subroutine s_icpp_model(patch_id, patch_id_fp, q_prim_vf)
The STL patch is a 2/3D geometry that is imported from an STL file.
Definition m_icpp_patches.fpp.f90:16058
m_icpp_patches::s_convert_cylindrical_to_cartesian_coord
subroutine s_convert_cylindrical_to_cartesian_coord(cyl_y, cyl_z)
Converts cylindrical (r, theta) coordinates to Cartesian (y, z) module variables.
Definition m_icpp_patches.fpp.f90:16197
m_icpp_patches::f_r
elemental real(wp) function f_r(myth, offset, a)
Archimedes spiral function.
Definition m_icpp_patches.fpp.f90:16277
m_icpp_patches::z_centroid
real(wp) z_centroid
Definition m_icpp_patches.fpp.f90:390
m_icpp_patches::x_boundary
type(bounds_info) x_boundary
Definition m_icpp_patches.fpp.f90:411
m_icpp_patches::smooth_patch_id
integer smooth_patch_id
Definition m_icpp_patches.fpp.f90:393
m_icpp_patches::z_boundary
type(bounds_info) z_boundary
These variables combine the centroid and length parameters associated with a particular patch to yiel...
Definition m_icpp_patches.fpp.f90:411
m_icpp_patches::s_icpp_sweep_line
subroutine s_icpp_sweep_line(patch_id, patch_id_fp, q_prim_vf)
The swept line patch is a 2D geometry that may be used, for example, in creating a solid boundary,...
Definition m_icpp_patches.fpp.f90:9262
m_icpp_patches::s_icpp_ellipsoid
subroutine s_icpp_ellipsoid(patch_id, patch_id_fp, q_prim_vf)
The ellipsoidal patch is a 3D geometry. The geometry of the patch is well-defined when its centroid a...
Definition m_icpp_patches.fpp.f90:7066
m_icpp_patches::s_icpp_cylinder
subroutine s_icpp_cylinder(patch_id, patch_id_fp, q_prim_vf)
The cylindrical patch is a 3D geometry that may be used, for example, in setting up a cylindrical sol...
Definition m_icpp_patches.fpp.f90:14125
m_icpp_patches::s_icpp_spiral
impure subroutine s_icpp_spiral(patch_id, patch_id_fp, q_prim_vf)
The spiral patch is a 2D geometry that may be used, The geometry of the patch is well-defined when it...
Definition m_icpp_patches.fpp.f90:1223
m_icpp_patches::s_icpp_3dvarcircle
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.
Definition m_icpp_patches.fpp.f90:4898
m_model
Binary STL file reader and processor for immersed boundary geometry.
Definition m_model.fpp.f90:295
m_mpi_common
MPI communication layer: domain decomposition, halo exchange, reductions, and parallel I/O setup.
Definition m_mpi_common.fpp.f90:305
m_mpi_common::s_mpi_abort
impure subroutine s_mpi_abort(prnt, code)
The subroutine terminates the MPI execution environment.
Definition m_mpi_common.fpp.f90:971
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:305
m_variables_conversion::gammas
real(wp), dimension(:), allocatable, public gammas
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::gs_min
real(wp), dimension(:), allocatable, public gs_min
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::pi_infs
real(wp), dimension(:), allocatable, public pi_infs
Definition m_variables_conversion.fpp.f90:344
m_derived_types::bounds_info
Derived type adding beginning (beg) and end bounds info as attributes.
Definition m_derived_types.fpp.f90:411
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:309