MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_check_patches.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
2!>
3!! @file
4!! @brief Contains module m_check_patches
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
7# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
8# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
9# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
10# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
11# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
12# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
13# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
14
15# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
17# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
21! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
22! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
23# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
25# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
26
27# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
61! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
62! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
63# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
65# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
66
67# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75
76# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
77
78# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79
80# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85! New line at end of file is required for FYPP
86# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
87
88# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164! New line at end of file is required for FYPP
165# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
166# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
167# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
168# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
180! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
181! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
182# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
184# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
185
186# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188
189# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
190
191# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
192
193# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
194
195# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
196
197# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
198
199# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204! New line at end of file is required for FYPP
205# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
206
207# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262! New line at end of file is required for FYPP
263# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
264
265! GPU parallel region (scalar reductions, maxval/minval)
266# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! GPU parallel loop over threads (most common GPU macro)
269# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Required closing for GPU_PARALLEL_LOOP
272# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Mark routine for device compilation
275# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Declare device-resident data
278# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Inner loop within a GPU parallel region
281# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Scoped GPU data region
284# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Host code with device pointers (for MPI with GPU buffers)
287# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Allocate device memory (unscoped)
290# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Free device memory
293# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Atomic operation on device
296# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! End atomic capture block
299# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Copy data between host and device
302# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Synchronization barrier
305# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Import GPU library module (openacc or omp_lib)
308# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! Emit code only for AMD compiler
311# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Emit code for non-Cray compilers
314# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Emit code only for Cray compiler
317# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Emit code for non-NVIDIA compilers
320# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324! New line at end of file is required for FYPP
325# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
326
327# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
330! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
331! example see misc/nvidia_uvm/bind.sh.
332# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
333
334! Allocate and create GPU device memory
335# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
336
337! Free GPU device memory and deallocate
338# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340! Cray-specific GPU pointer setup for vector fields
341# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
342
343! Cray-specific GPU pointer setup for scalar fields
344# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Cray-specific GPU pointer setup for acoustic source spatials
347# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
352! New line at end of file is required for FYPP
353# 6 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp" 2
354
355!> @brief Validates geometry parameters and constraints for initial condition patches
356
357# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
358# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
359# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
360# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
361# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
362# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
363# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
364# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
365
366# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
367# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
368# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
369
370# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
371# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
372! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
373! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
374# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
375# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
376# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
377
378# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
379# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
380
381# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
382
383# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
384
385# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
386
387# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
388
389# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
390
391# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
392
393# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
394
395# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
396! New line at end of file is required for FYPP
397# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
398# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
399# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
400# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
401# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
402# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
403# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
404# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
405
406# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
407# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
408# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
409
410# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
411# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
412! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
413! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
414# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
415# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
416# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
417
418# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
419# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
420
421# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
422
423# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
424
425# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
426
427# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
428
429# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
430
431# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
432
433# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
434
435# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
436! New line at end of file is required for FYPP
437# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
438
439# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
440# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
441# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
442# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
443# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
444
445# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
446
447# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
448
449# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
450
451# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
452
453# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
454
455# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
456
457# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
458
459# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
460
461# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
462
463# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
464
465# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
466
467# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
468
469# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
470
471# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
472
473# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
474
475# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
476
477# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
478
479# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
480
481# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
482
483# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
484
485# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
486
487# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
488
489# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
490# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
491
492# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
493
494# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
495
496# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
497
498# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
499
500# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
501
502# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
503
504# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
505
506# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
507
508# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
509
510# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
511
512# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
513
514# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
515! New line at end of file is required for FYPP
516# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
517# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
518# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
519# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
520# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
521# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
522# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
523# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
524
525# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
526# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
527# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
528
529# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
530# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
531! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
532! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
533# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
534# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
535# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
536
537# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
538# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
539
540# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
541
542# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
543
544# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
545
546# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
547
548# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
549
550# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
551
552# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
553
554# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
555! New line at end of file is required for FYPP
556# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
557
558# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
559
560# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
561
562# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
563
564# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
565
566# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
567
568# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
569
570# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
571
572# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
573
574# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
575
576# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
577
578# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
579
580# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
581
582# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
583
584# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
585
586# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
587
588# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
589
590# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
591
592# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
593
594# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
595
596# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
597
598# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
599
600# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
601
602# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
603
604# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
605
606# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
607
608# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
609
610# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
611
612# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
613! New line at end of file is required for FYPP
614# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
615
616! GPU parallel region (scalar reductions, maxval/minval)
617# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
618
619! GPU parallel loop over threads (most common GPU macro)
620# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
621
622! Required closing for GPU_PARALLEL_LOOP
623# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
624
625! Mark routine for device compilation
626# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
627
628! Declare device-resident data
629# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
630
631! Inner loop within a GPU parallel region
632# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
633
634! Scoped GPU data region
635# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
636
637! Host code with device pointers (for MPI with GPU buffers)
638# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
639
640! Allocate device memory (unscoped)
641# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
642
643! Free device memory
644# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
645
646! Atomic operation on device
647# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
648
649! End atomic capture block
650# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
651
652! Copy data between host and device
653# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
654
655! Synchronization barrier
656# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
657
658! Import GPU library module (openacc or omp_lib)
659# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
660
661! Emit code only for AMD compiler
662# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
663
664! Emit code for non-Cray compilers
665# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
666
667! Emit code only for Cray compiler
668# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
669
670! Emit code for non-NVIDIA compilers
671# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
672
673# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
674# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
675! New line at end of file is required for FYPP
676# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
677
678# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
679
680! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
681! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
682! example see misc/nvidia_uvm/bind.sh.
683# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
684
685! Allocate and create GPU device memory
686# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
687
688! Free GPU device memory and deallocate
689# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
690
691! Cray-specific GPU pointer setup for vector fields
692# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
693
694! Cray-specific GPU pointer setup for scalar fields
695# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
696
697! Cray-specific GPU pointer setup for acoustic source spatials
698# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
699
700# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
701
702# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
703! New line at end of file is required for FYPP
704# 10 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp" 2
705
706module m_check_patches
707
708 ! Dependencies
709 use m_derived_types
710 use m_global_parameters
711 use m_mpi_proxy
712 use m_data_output
713#ifdef MFC_MPI
714 use mpi !< message passing interface (mpi) module
715#endif
716
717 use m_compile_specific
718 use m_helper_basic
719 use m_helper
720 use m_constants, only: model_eqns_gamma_law, model_eqns_5eq
721
722 implicit none
723
724 private; public :: s_check_patches
725
726 character(len=10) :: istr
727
728contains
729
730 !> Validate the geometry parameters of all active and inactive initial condition patches.
731 impure subroutine s_check_patches
732
733 integer :: i
734 character(len=10) :: num_patches_str
735
736 call s_int_to_str(num_patches, num_patches_str)
737
738 do i = 1, num_patches_max
739 if (i <= num_patches) then
740 call s_int_to_str(i, istr)
741 if (patch_icpp(i)%geometry == 6) then
742# 46 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
743 call s_prohibit_abort("patch_icpp(i)%geometry == 6", "Invalid patch geometry number. " // "patch_icpp(" // trim(istr) // ")%geometry is deprecated.")
744# 46 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
745 end if
746# 48 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
747 if (patch_icpp(i)%geometry == 7) then
748# 48 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
749 call s_prohibit_abort("patch_icpp(i)%geometry == 7", "Invalid patch geometry number. " // "patch_icpp(" // trim(istr) // ")%geometry is deprecated.")
750# 48 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
751 end if
752# 50 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
753 if (patch_icpp(i)%geometry == 15) then
754# 50 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
755 call s_prohibit_abort("patch_icpp(i)%geometry == 15", "Invalid patch geometry number. " // "patch_icpp(" // trim(istr) // ")%geometry is deprecated.")
756# 50 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
757 end if
758# 52 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
759 if (patch_icpp(i)%geometry == dflt_int) then
760# 52 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
761 call s_prohibit_abort("patch_icpp(i)%geometry == dflt_int", "Invalid patch geometry number. " // "patch_icpp(" // trim(istr) // ")%geometry must be set.")
762# 52 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
763 end if
764# 54 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
765
766 ! Constraints on the geometric initial condition patch parameters
767 if (patch_icpp(i)%geometry == 1) then
768 call s_check_line_segment_patch_geometry(i)
769 else if (patch_icpp(i)%geometry == 2) then
770 call s_check_circle_patch_geometry(i)
771 else if (patch_icpp(i)%geometry == 3) then
772 call s_check_rectangle_patch_geometry(i)
773 else if (patch_icpp(i)%geometry == 4) then
774 call s_check_line_sweep_patch_geometry(i)
775 else if (patch_icpp(i)%geometry == 5) then
776 call s_check_ellipse_patch_geometry(i)
777 else if (patch_icpp(i)%geometry == 8) then
778 call s_check_sphere_patch_geometry(i)
779 else if (patch_icpp(i)%geometry == 9) then
780 call s_check_cuboid_patch_geometry(i)
781 else if (patch_icpp(i)%geometry == 10) then
782 call s_check_cylinder_patch_geometry(i)
783 else if (patch_icpp(i)%geometry == 11) then
784 call s_check_plane_sweep_patch_geometry(i)
785 else if (patch_icpp(i)%geometry == 12) then
786 call s_check_ellipsoid_patch_geometry(i)
787 else if (patch_icpp(i)%geometry == 13) then
788 call s_check_2d_modal_patch_geometry(i)
789 else if (patch_icpp(i)%geometry == 14) then
790 call s_check_3d_spherical_harmonic_patch_geometry(i)
791 else if (patch_icpp(i)%geometry == 20) then
792 call s_check_2d_taylorgreen_vortex_patch_geometry(i)
793 else if (patch_icpp(i)%geometry == 21) then
794 call s_check_model_geometry(i)
795 else
796 call s_prohibit_abort("Invalid patch geometry number", &
797 & "patch_icpp(" // trim(istr) // ")%geometry " // "must be between 1 and 21")
798 end if
799 else
800 if (patch_icpp(i)%geometry /= dflt_int) then
801# 89 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
802 call s_prohibit_abort("patch_icpp(i)%geometry /= dflt_int", "Inactive patch defined. " // "patch_icpp(" // trim(istr) // ")%geometry not be set for inactive patches. " // "Patch " // trim(istr) // " is inactive as the number of patches is " // trim(num_patches_str))
803# 89 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
804 end if
805# 93 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
806 call s_check_inactive_patch_geometry(i)
807 end if
808 end do
809
810 ! Constraints on overwrite rights initial condition patch parameters
811 do i = 1, num_patches
812 if (i <= num_patches) then
813 call s_check_active_patch_alteration_rights(i)
814 else
815 call s_check_inactive_patch_alteration_rights(i)
816 end if
817 end do
818
819 ! Constraints on smoothing initial condition patch parameters
820 do i = 1, num_patches
821 if (i > 1 .and. (patch_icpp(i)%geometry == 2 .or. patch_icpp(i)%geometry == 3 .or. patch_icpp(i)%geometry == 4 &
822 & .or. patch_icpp(i)%geometry == 5 .or. patch_icpp(i)%geometry == 8 .or. patch_icpp(i)%geometry == 9 &
823 & .or. patch_icpp(i)%geometry == 10 .or. patch_icpp(i)%geometry == 11 .or. patch_icpp(i)%geometry == 12 &
824 & .or. patch_icpp(i)%geometry == 13 .or. patch_icpp(i)%geometry == 14)) then
825 call s_check_supported_patch_smoothing(i)
826 else
827 call s_check_unsupported_patch_smoothing(i)
828 end if
829 end do
830
831 ! Constraints on flow variables initial condition patch parameters
832 do i = 1, num_patches
833 if (i <= num_patches) then
834 call s_check_active_patch_primitive_variables(i)
835 else
836 call s_check_inactive_patch_primitive_variables(i)
837 end if
838 end do
839
840 end subroutine s_check_patches
841
842 !> Check the line segment patch input
843 impure subroutine s_check_line_segment_patch_geometry(patch_id)
844
845 integer, intent(in) :: patch_id
846
847 call s_int_to_str(patch_id, istr)
848
849 if (n > 0) then
850# 136 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
851 call s_prohibit_abort("n > 0", "Line segment patch "//trim(istr)//": n must be zero")
852# 136 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
853 end if
854# 137 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
855 if (patch_icpp(patch_id)%length_x <= 0._wp) then
856# 137 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
857 call s_prohibit_abort("patch_icpp(patch_id)%length_x <= 0._wp", "Line segment patch " // trim(istr) // ": length_x must be greater than zero")
858# 137 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
859 end if
860# 139 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
861 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
862# 139 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
863 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Line segment patch "//trim(istr)//": x_centroid must be set")
864# 139 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
865 end if
866# 140 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
867 if (cyl_coord) then
868# 140 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
869 call s_prohibit_abort("cyl_coord", "Line segment patch "//trim(istr)//": cyl_coord is not supported")
870# 140 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
871 end if
872# 141 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
873
874 end subroutine s_check_line_segment_patch_geometry
875
876 !> Check the circle patch input
877 impure subroutine s_check_circle_patch_geometry(patch_id)
878
879 integer, intent(in) :: patch_id
880
881 call s_int_to_str(patch_id, istr)
882
883 if (n == 0) then
884# 151 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
885 call s_prohibit_abort("n == 0", "Circle patch "//trim(istr)//": n must be zero")
886# 151 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
887 end if
888# 152 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
889 if (p > 0) then
890# 152 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
891 call s_prohibit_abort("p > 0", "Circle patch "//trim(istr)//": p must be greater than zero")
892# 152 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
893 end if
894# 153 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
895 if (patch_icpp(patch_id)%radius <= 0._wp) then
896# 153 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
897 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "Circle patch "//trim(istr)//": radius must be greater than zero")
898# 153 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
899 end if
900# 154 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
901 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
902# 154 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
903 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Circle patch "//trim(istr)//": x_centroid must be set")
904# 154 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
905 end if
906# 155 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
907 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
908# 155 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
909 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Circle patch "//trim(istr)//": y_centroid must be set")
910# 155 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
911 end if
912# 156 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
913
914 end subroutine s_check_circle_patch_geometry
915
916 !> Check the rectangle patch input
917 impure subroutine s_check_rectangle_patch_geometry(patch_id)
918
919 integer, intent(in) :: patch_id
920
921 call s_int_to_str(patch_id, istr)
922
923 if (n == 0) then
924# 166 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
925 call s_prohibit_abort("n == 0", "Rectangle patch "//trim(istr)//": n must be greater than zero")
926# 166 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
927 end if
928# 167 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
929 if (p > 0) then
930# 167 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
931 call s_prohibit_abort("p > 0", "Rectangle patch "//trim(istr)//": p must be zero")
932# 167 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
933 end if
934# 168 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
935 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
936# 168 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
937 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Rectangle patch "//trim(istr)//": x_centroid must be set")
938# 168 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
939 end if
940# 169 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
941 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
942# 169 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
943 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Rectangle patch "//trim(istr)//": y_centroid must be set")
944# 169 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
945 end if
946# 170 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
947 if (patch_icpp(patch_id)%length_x <= 0._wp) then
948# 170 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
949 call s_prohibit_abort("patch_icpp(patch_id)%length_x <= 0._wp", "Rectangle patch "//trim(istr)//": length_x must be greater than zero")
950# 170 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
951 end if
952# 171 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
953 if (patch_icpp(patch_id)%length_y <= 0._wp) then
954# 171 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
955 call s_prohibit_abort("patch_icpp(patch_id)%length_y <= 0._wp", "Rectangle patch "//trim(istr)//": length_y must be greater than zero")
956# 171 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
957 end if
958# 172 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
959
960 end subroutine s_check_rectangle_patch_geometry
961
962 !> Check the line sweep patch input
963 impure subroutine s_check_line_sweep_patch_geometry(patch_id)
964
965 integer, intent(in) :: patch_id
966
967 call s_int_to_str(patch_id, istr)
968
969 if (n == 0) then
970# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
971 call s_prohibit_abort("n == 0", "Line sweep patch "//trim(istr)//": n must be greater than zero")
972# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
973 end if
974# 183 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
975 if (p > 0) then
976# 183 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
977 call s_prohibit_abort("p > 0", "Line sweep patch "//trim(istr)//": p must be zero")
978# 183 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
979 end if
980# 184 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
981 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
982# 184 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
983 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Line sweep patch "//trim(istr)//": x_centroid must be set")
984# 184 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
985 end if
986# 185 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
987 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
988# 185 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
989 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Line sweep patch "//trim(istr)//": y_centroid must be set")
990# 185 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
991 end if
992# 186 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
993 if (f_is_default(patch_icpp(patch_id)%normal(1))) then
994# 186 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
995 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(1))", "Line sweep patch "//trim(istr)//": normal(1) must be set")
996# 186 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
997 end if
998# 187 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
999 if (f_is_default(patch_icpp(patch_id)%normal(2))) then
1000# 187 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1001 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(2))", "Line sweep patch "//trim(istr)//": normal(2) must be set")
1002# 187 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1003 end if
1004# 188 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1005 if (.not. f_is_default(patch_icpp(patch_id)%normal(3))) then
1006# 188 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1007 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%normal(3))", "Line sweep patch " // trim(istr) // ": normal(3) must not be set")
1008# 188 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1009 end if
1010# 190 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1011
1012 end subroutine s_check_line_sweep_patch_geometry
1013
1014 !> Check the ellipse patch input
1015 impure subroutine s_check_ellipse_patch_geometry(patch_id)
1016
1017 integer, intent(in) :: patch_id
1018
1019 call s_int_to_str(patch_id, istr)
1020
1021 if (n == 0) then
1022# 200 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1023 call s_prohibit_abort("n == 0", "Ellipse patch "//trim(istr)//": n must be greater than zero")
1024# 200 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1025 end if
1026# 201 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1027 if (p > 0) then
1028# 201 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1029 call s_prohibit_abort("p > 0", "Ellipse patch "//trim(istr)//": p must be zero")
1030# 201 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1031 end if
1032# 202 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1033 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1034# 202 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1035 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Ellipse patch "//trim(istr)//": x_centroid must be set")
1036# 202 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1037 end if
1038# 203 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1039 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1040# 203 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1041 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Ellipse patch "//trim(istr)//": y_centroid must be set")
1042# 203 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1043 end if
1044# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1045 if (patch_icpp(patch_id)%radii(1) <= 0._wp) then
1046# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1047 call s_prohibit_abort("patch_icpp(patch_id)%radii(1) <= 0._wp", "Ellipse patch "//trim(istr)//": radii(1) must be greater than zero")
1048# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1049 end if
1050# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1051 if (patch_icpp(patch_id)%radii(2) <= 0._wp) then
1052# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1053 call s_prohibit_abort("patch_icpp(patch_id)%radii(2) <= 0._wp", "Ellipse patch "//trim(istr)//": radii(2) must be greater than zero")
1054# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1055 end if
1056# 206 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1057 if (.not. f_is_default(patch_icpp(patch_id)%radii(3))) then
1058# 206 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1059 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radii(3))", "Ellipse patch "//trim(istr)//": radii(3) must not be set")
1060# 206 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1061 end if
1062# 207 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1063
1064 end subroutine s_check_ellipse_patch_geometry
1065
1066 !> Check the model patch input
1067 impure subroutine s_check_2d_taylorgreen_vortex_patch_geometry(patch_id)
1068
1069 integer, intent(in) :: patch_id
1070
1071 call s_int_to_str(patch_id, istr)
1072
1073 if (n == 0) then
1074# 217 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1075 call s_prohibit_abort("n == 0", "Taylor Green vortex patch "//trim(istr)//": n must be greater than zero")
1076# 217 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1077 end if
1078# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1079 if (p > 0) then
1080# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1081 call s_prohibit_abort("p > 0", "Taylor Green vortex patch "//trim(istr)//": p must be zero")
1082# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1083 end if
1084# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1085 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1086# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1087 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Taylor Green vortex patch " // trim(istr) // ": x_centroid must be set")
1088# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1089 end if
1090# 221 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1091 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1092# 221 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1093 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Taylor Green vortex patch " // trim(istr) // ": y_centroid must be set")
1094# 221 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1095 end if
1096# 223 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1097 if (patch_icpp(patch_id)%length_x <= 0._wp) then
1098# 223 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1099 call s_prohibit_abort("patch_icpp(patch_id)%length_x <= 0._wp", "Taylor Green vortex patch " // trim(istr) // ": length_x must be greater than zero")
1100# 223 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1101 end if
1102# 225 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1103 if (patch_icpp(patch_id)%length_y <= 0._wp) then
1104# 225 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1105 call s_prohibit_abort("patch_icpp(patch_id)%length_y <= 0._wp", "Taylor Green vortex patch " // trim(istr) // ": length_y must be greater than zero")
1106# 225 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1107 end if
1108# 227 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1109 if (patch_icpp(patch_id)%vel(2) <= 0._wp) then
1110# 227 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1111 call s_prohibit_abort("patch_icpp(patch_id)%vel(2) <= 0._wp", "Taylor Green vortex patch " // trim(istr) // ": vel(2) must be greater than zero")
1112# 227 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1113 end if
1114# 229 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1115
1116 end subroutine s_check_2d_taylorgreen_vortex_patch_geometry
1117
1118 !> Check the model patch input
1119 impure subroutine s_check_sphere_patch_geometry(patch_id)
1120
1121 integer, intent(in) :: patch_id
1122
1123 call s_int_to_str(patch_id, istr)
1124
1125 if (p == 0) then
1126# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1127 call s_prohibit_abort("p == 0", "Sphere patch "//trim(istr)//": p must be greater than zero")
1128# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1129 end if
1130# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1131 if (patch_icpp(patch_id)%radius <= 0._wp) then
1132# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1133 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "Sphere patch "//trim(istr)//": radius must be greater than zero")
1134# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1135 end if
1136# 241 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1137 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1138# 241 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1139 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Sphere patch "//trim(istr)//": x_centroid must be set")
1140# 241 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1141 end if
1142# 242 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1143 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1144# 242 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1145 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Sphere patch "//trim(istr)//": y_centroid must be set")
1146# 242 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1147 end if
1148# 243 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1149 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1150# 243 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1151 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Sphere patch "//trim(istr)//": z_centroid must be set")
1152# 243 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1153 end if
1154# 244 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1155
1156 end subroutine s_check_sphere_patch_geometry
1157
1158 !> Validate geometry parameters for a 2D modal (Fourier) patch
1159 impure subroutine s_check_2d_modal_patch_geometry(patch_id)
1160
1161 integer, intent(in) :: patch_id
1162
1163 call s_int_to_str(patch_id, istr)
1164
1165 if (n == 0) then
1166# 254 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1167 call s_prohibit_abort("n == 0", "2D modal patch "//trim(istr)//": n must be greater than zero")
1168# 254 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1169 end if
1170# 255 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1171 if (p > 0) then
1172# 255 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1173 call s_prohibit_abort("p > 0", "2D modal patch "//trim(istr)//": p must be zero")
1174# 255 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1175 end if
1176# 256 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1177 if (patch_icpp(patch_id)%radius <= 0._wp) then
1178# 256 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1179 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "2D modal patch "//trim(istr)//": radius must be greater than zero")
1180# 256 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1181 end if
1182# 257 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1183 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1184# 257 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1185 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "2D modal patch "//trim(istr)//": x_centroid must be set")
1186# 257 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1187 end if
1188# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1189 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1190# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1191 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "2D modal patch "//trim(istr)//": y_centroid must be set")
1192# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1193 end if
1194# 259 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1195
1196 end subroutine s_check_2d_modal_patch_geometry
1197
1198 !> Validate geometry parameters for a 3D spherical harmonic patch
1199 impure subroutine s_check_3d_spherical_harmonic_patch_geometry(patch_id)
1200
1201 integer, intent(in) :: patch_id
1202
1203 call s_int_to_str(patch_id, istr)
1204
1205 if (p == 0) then
1206# 269 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1207 call s_prohibit_abort("p == 0", "Spherical harmonic patch "//trim(istr)//": p must be greater than zero")
1208# 269 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1209 end if
1210# 270 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1211 if (patch_icpp(patch_id)%radius <= 0._wp) then
1212# 270 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1213 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "Spherical harmonic patch " // trim(istr) // ": radius must be greater than zero")
1214# 270 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1215 end if
1216# 272 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1217 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1218# 272 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1219 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Spherical harmonic patch " // trim(istr) // ": x_centroid must be set")
1220# 272 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1221 end if
1222# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1223 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1224# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1225 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Spherical harmonic patch " // trim(istr) // ": y_centroid must be set")
1226# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1227 end if
1228# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1229 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1230# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1231 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Spherical harmonic patch " // trim(istr) // ": z_centroid must be set")
1232# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1233 end if
1234# 278 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1235
1236 end subroutine s_check_3d_spherical_harmonic_patch_geometry
1237
1238 !> Check the model patch input
1239 impure subroutine s_check_cuboid_patch_geometry(patch_id)
1240
1241 ! Patch identifier
1242 integer, intent(in) :: patch_id
1243
1244 call s_int_to_str(patch_id, istr)
1245
1246 if (p == 0) then
1247# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1248 call s_prohibit_abort("p == 0", "Cuboid patch "//trim(istr)//": p must be greater than zero")
1249# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1250 end if
1251# 290 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1252 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1253# 290 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1254 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Cuboid patch "//trim(istr)//": x_centroid must be set")
1255# 290 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1256 end if
1257# 291 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1258 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1259# 291 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1260 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Cuboid patch "//trim(istr)//": y_centroid must be set")
1261# 291 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1262 end if
1263# 292 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1264 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1265# 292 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1266 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Cuboid patch "//trim(istr)//": z_centroid must be set")
1267# 292 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1268 end if
1269# 293 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1270 if (patch_icpp(patch_id)%length_x <= 0._wp) then
1271# 293 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1272 call s_prohibit_abort("patch_icpp(patch_id)%length_x <= 0._wp", "Cuboid patch "//trim(istr)//": length_x must be greater than zero")
1273# 293 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1274 end if
1275# 294 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1276 if (patch_icpp(patch_id)%length_y <= 0._wp) then
1277# 294 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1278 call s_prohibit_abort("patch_icpp(patch_id)%length_y <= 0._wp", "Cuboid patch "//trim(istr)//": length_y must be greater than zero")
1279# 294 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1280 end if
1281# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1282 if (patch_icpp(patch_id)%length_z <= 0._wp) then
1283# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1284 call s_prohibit_abort("patch_icpp(patch_id)%length_z <= 0._wp", "Cuboid patch "//trim(istr)//": length_z must be greater than zero")
1285# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1286 end if
1287# 296 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1288
1289 end subroutine s_check_cuboid_patch_geometry
1290
1291 !> Check the model patch input
1292 impure subroutine s_check_cylinder_patch_geometry(patch_id)
1293
1294 ! Patch identifier
1295 integer, intent(in) :: patch_id
1296
1297 call s_int_to_str(patch_id, istr)
1298
1299 if (p == 0) then
1300# 307 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1301 call s_prohibit_abort("p == 0", "Cylinder patch "//trim(istr)//": p must be greater than zero")
1302# 307 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1303 end if
1304# 308 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1305 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1306# 308 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1307 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Cylinder patch "//trim(istr)//": x_centroid must be set")
1308# 308 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1309 end if
1310# 309 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1311 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1312# 309 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1313 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Cylinder patch "//trim(istr)//": y_centroid must be set")
1314# 309 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1315 end if
1316# 310 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1317 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1318# 310 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1319 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Cylinder patch "//trim(istr)//": z_centroid must be set")
1320# 310 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1321 end if
1322# 311 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1323 if (patch_icpp(patch_id)%radius <= 0._wp) then
1324# 311 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1325 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "Cylinder patch "//trim(istr)//": radius must be greater than zero")
1326# 311 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1327 end if
1328# 312 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1329
1330 ! Check if exactly one length is defined
1331 if (count([patch_icpp(patch_id)%length_x > 0._wp, patch_icpp(patch_id)%length_y > 0._wp, patch_icpp(patch_id)%length_z > 0._wp]) /= 1) then
1332# 314 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1333 call s_prohibit_abort("count([patch_icpp(patch_id)%length_x > 0._wp, patch_icpp(patch_id)%length_y > 0._wp, patch_icpp(patch_id)%length_z > 0._wp]) /= 1", "Cylinder patch " // trim(istr) // ": Exactly one of length_x, length_y, or length_z must be defined and positive")
1334# 314 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1335 end if
1336# 318 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1337
1338 ! Ensure the defined length is positive
1339 if ((.not. f_is_default(patch_icpp(patch_id)%length_x) .and. patch_icpp(patch_id)%length_x <= 0._wp) .or. (.not. f_is_default(patch_icpp(patch_id)%length_y) .and. patch_icpp(patch_id)%length_y <= 0._wp) .or. (.not. f_is_default(patch_icpp(patch_id)%length_z) .and. patch_icpp(patch_id)%length_z <= 0._wp)) then
1340# 320 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1341 call s_prohibit_abort(.not..and..or..not..and..or..not..and."( f_is_default(patch_icpp(patch_id)%length_x) patch_icpp(patch_id)%length_x <= 0._wp) ( f_is_default(patch_icpp(patch_id)%length_y) patch_icpp(patch_id)%length_y <= 0._wp) ( f_is_default(patch_icpp(patch_id)%length_z) patch_icpp(patch_id)%length_z <= 0._wp)", "Cylinder patch " // trim(istr) // ": The defined length_{} must be greater than zero")
1342# 320 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1343 end if
1344# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1345
1346 end subroutine s_check_cylinder_patch_geometry
1347
1348 !> Check the model patch input
1349 impure subroutine s_check_plane_sweep_patch_geometry(patch_id)
1350
1351 ! Patch identifier
1352 integer, intent(in) :: patch_id
1353
1354 call s_int_to_str(patch_id, istr)
1355
1356 if (p == 0) then
1357# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1358 call s_prohibit_abort("p == 0", "Plane sweep patch "//trim(istr)//": p must be greater than zero")
1359# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1360 end if
1361# 336 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1362 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1363# 336 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1364 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Plane sweep patch "//trim(istr)//": x_centroid must be set")
1365# 336 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1366 end if
1367# 337 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1368 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1369# 337 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1370 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Plane sweep patch "//trim(istr)//": y_centroid must be set")
1371# 337 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1372 end if
1373# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1374 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1375# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1376 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Plane sweep patch "//trim(istr)//": z_centroid must be set")
1377# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1378 end if
1379# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1380 if (f_is_default(patch_icpp(patch_id)%normal(1))) then
1381# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1382 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(1))", "Plane sweep patch "//trim(istr)//": normal(1) must be set")
1383# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1384 end if
1385# 340 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1386 if (f_is_default(patch_icpp(patch_id)%normal(2))) then
1387# 340 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1388 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(2))", "Plane sweep patch "//trim(istr)//": normal(2) must be set")
1389# 340 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1390 end if
1391# 341 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1392 if (f_is_default(patch_icpp(patch_id)%normal(3))) then
1393# 341 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1394 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(3))", "Plane sweep patch "//trim(istr)//": normal(3) must be set")
1395# 341 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1396 end if
1397# 342 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1398
1399 end subroutine s_check_plane_sweep_patch_geometry
1400
1401 !> Check the model patch input
1402 impure subroutine s_check_ellipsoid_patch_geometry(patch_id)
1403
1404 integer, intent(in) :: patch_id
1405
1406 call s_int_to_str(patch_id, istr)
1407
1408 if (p == 0) then
1409# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1410 call s_prohibit_abort("p == 0", "Ellipsoid patch "//trim(istr)//": p must be greater than zero")
1411# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1412 end if
1413# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1414 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1415# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1416 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Ellipsoid patch "//trim(istr)//": x_centroid must be set")
1417# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1418 end if
1419# 354 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1420 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1421# 354 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1422 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Ellipsoid patch "//trim(istr)//": y_centroid must be set")
1423# 354 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1424 end if
1425# 355 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1426 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1427# 355 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1428 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Ellipsoid patch "//trim(istr)//": z_centroid must be set")
1429# 355 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1430 end if
1431# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1432 if (patch_icpp(patch_id)%radii(1) <= 0._wp) then
1433# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1434 call s_prohibit_abort("patch_icpp(patch_id)%radii(1) <= 0._wp", "Ellipsoid patch "//trim(istr)//": radii(1) must be greater than zero")
1435# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1436 end if
1437# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1438 if (patch_icpp(patch_id)%radii(2) <= 0._wp) then
1439# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1440 call s_prohibit_abort("patch_icpp(patch_id)%radii(2) <= 0._wp", "Ellipsoid patch "//trim(istr)//": radii(2) must be greater than zero")
1441# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1442 end if
1443# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1444 if (patch_icpp(patch_id)%radii(3) <= 0._wp) then
1445# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1446 call s_prohibit_abort("patch_icpp(patch_id)%radii(3) <= 0._wp", "Ellipsoid patch "//trim(istr)//": radii(3) must be greater than zero")
1447# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1448 end if
1449# 359 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1450
1451 end subroutine s_check_ellipsoid_patch_geometry
1452
1453 !> Verify that inactive patch geometry parameters remain at defaults
1454 impure subroutine s_check_inactive_patch_geometry(patch_id)
1455
1456 integer, intent(in) :: patch_id
1457
1458 call s_int_to_str(patch_id, istr)
1459
1460 if (.not. f_is_default(patch_icpp(patch_id)%x_centroid)) then
1461# 369 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1462 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%x_centroid)", "Inactive patch " // trim(istr) // ": x_centroid must not be set")
1463# 369 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1464 end if
1465# 371 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1466 if (.not. f_is_default(patch_icpp(patch_id)%y_centroid)) then
1467# 371 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1468 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%y_centroid)", "Inactive patch " // trim(istr) // ": y_centroid must not be set")
1469# 371 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1470 end if
1471# 373 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1472 if (.not. f_is_default(patch_icpp(patch_id)%z_centroid)) then
1473# 373 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1474 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%z_centroid)", "Inactive patch " // trim(istr) // ": z_centroid must not be set")
1475# 373 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1476 end if
1477# 375 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1478 if (.not. f_is_default(patch_icpp(patch_id)%length_x)) then
1479# 375 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1480 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%length_x)", "Inactive patch "//trim(istr)//": length_x must not be set")
1481# 375 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1482 end if
1483# 376 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1484 if (.not. f_is_default(patch_icpp(patch_id)%length_y)) then
1485# 376 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1486 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%length_y)", "Inactive patch "//trim(istr)//": length_y must not be set")
1487# 376 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1488 end if
1489# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1490 if (.not. f_is_default(patch_icpp(patch_id)%length_z)) then
1491# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1492 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%length_z)", "Inactive patch "//trim(istr)//": length_z must not be set")
1493# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1494 end if
1495# 378 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1496 if (.not. f_is_default(patch_icpp(patch_id)%radius)) then
1497# 378 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1498 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radius)", "Inactive patch "//trim(istr)//": radius must not be set")
1499# 378 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1500 end if
1501# 379 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1502 if (.not. f_is_default(patch_icpp(patch_id)%epsilon)) then
1503# 379 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1504 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%epsilon)", "Inactive patch "//trim(istr)//": epsilon must not be set")
1505# 379 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1506 end if
1507# 380 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1508 if (.not. f_is_default(patch_icpp(patch_id)%beta)) then
1509# 380 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1510 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%beta)", "Inactive patch "//trim(istr)//": beta must not be set")
1511# 380 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1512 end if
1513# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1514 if (.not. f_is_default(patch_icpp(patch_id)%normal(1))) then
1515# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1516 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%normal(1))", "Inactive patch "//trim(istr)//": normal(1) must not be set")
1517# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1518 end if
1519# 382 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1520 if (.not. f_is_default(patch_icpp(patch_id)%normal(2))) then
1521# 382 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1522 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%normal(2))", "Inactive patch "//trim(istr)//": normal(2) must not be set")
1523# 382 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1524 end if
1525# 383 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1526 if (.not. f_is_default(patch_icpp(patch_id)%normal(3))) then
1527# 383 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1528 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%normal(3))", "Inactive patch "//trim(istr)//": normal(3) must not be set")
1529# 383 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1530 end if
1531# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1532 if (.not. f_is_default(patch_icpp(patch_id)%radii(1))) then
1533# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1534 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radii(1))", "Inactive patch "//trim(istr)//": radii(1) must not be set")
1535# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1536 end if
1537# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1538 if (.not. f_is_default(patch_icpp(patch_id)%radii(2))) then
1539# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1540 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radii(2))", "Inactive patch "//trim(istr)//": radii(2) must not be set")
1541# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1542 end if
1543# 386 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1544 if (.not. f_is_default(patch_icpp(patch_id)%radii(3))) then
1545# 386 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1546 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radii(3))", "Inactive patch "//trim(istr)//": radii(3) must not be set")
1547# 386 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1548 end if
1549# 387 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1550
1551 end subroutine s_check_inactive_patch_geometry
1552
1553 !> Verify the active patch's right to overwrite the preceding patches
1554 impure subroutine s_check_active_patch_alteration_rights(patch_id)
1555
1556 integer, intent(in) :: patch_id
1557
1558 call s_int_to_str(patch_id, istr)
1559
1560 if (.not. patch_icpp(patch_id)%alter_patch(0)) then
1561# 397 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1562 call s_prohibit_abort(.not." patch_icpp(patch_id)%alter_patch(0)", "Patch "//trim(istr)//": alter_patch(0) must be true")
1563# 397 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1564 end if
1565# 398 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1566 if (any(patch_icpp(patch_id)%alter_patch(patch_id:))) then
1567# 398 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1568 call s_prohibit_abort("any(patch_icpp(patch_id)%alter_patch(patch_id:))", "Patch " // trim(istr) // ":alter_patch(i) must be false for i >= " // trim(istr) // ". Only preceding patches can be altered")
1569# 398 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1570 end if
1571# 401 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1572
1573 end subroutine s_check_active_patch_alteration_rights
1574
1575 !> Verify that inactive patches cannot overwrite other patches
1576 impure subroutine s_check_inactive_patch_alteration_rights(patch_id)
1577
1578 ! Patch identifier
1579 integer, intent(in) :: patch_id
1580
1581 call s_int_to_str(patch_id, istr)
1582
1583 if (.not. patch_icpp(patch_id)%alter_patch(0)) then
1584# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1585 call s_prohibit_abort(.not." patch_icpp(patch_id)%alter_patch(0)", "Inactive patch "//trim(istr)//": cannot have alter_patch(0) altered")
1586# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1587 end if
1588# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1589 if (any(patch_icpp(patch_id)%alter_patch(1:))) then
1590# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1591 call s_prohibit_abort("any(patch_icpp(patch_id)%alter_patch(1:))", "Inactive patch " // trim(istr) // ": cannot have any alter_patch(i) enabled")
1592# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1593 end if
1594# 415 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1595
1596 end subroutine s_check_inactive_patch_alteration_rights
1597
1598 !> Check the smoothing parameters
1599 impure subroutine s_check_supported_patch_smoothing(patch_id)
1600
1601 integer, intent(in) :: patch_id
1602
1603 call s_int_to_str(patch_id, istr)
1604
1605 if (patch_icpp(patch_id)%smoothen) then
1606 if (patch_icpp(patch_id)%smooth_patch_id >= patch_id) then
1607# 426 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1608 call s_prohibit_abort("patch_icpp(patch_id)%smooth_patch_id >= patch_id", "Smoothen enabled. Patch " // trim(istr) // ": smooth_patch_id must be less than patch_id")
1609# 426 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1610 end if
1611# 428 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1612 if (patch_icpp(patch_id)%smooth_patch_id == 0) then
1613# 428 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1614 call s_prohibit_abort("patch_icpp(patch_id)%smooth_patch_id == 0", "Smoothen enabled. Patch " // trim(istr) // ": smooth_patch_id must be greater than zero")
1615# 428 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1616 end if
1617# 430 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1618 if (patch_icpp(patch_id)%smooth_coeff <= 0._wp) then
1619# 430 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1620 call s_prohibit_abort("patch_icpp(patch_id)%smooth_coeff <= 0._wp", "Smoothen enabled. Patch " // trim(istr) // ": smooth_coeff must be greater than zero")
1621# 430 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1622 end if
1623# 432 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1624 else
1625 if (patch_icpp(patch_id)%smooth_patch_id /= patch_id) then
1626# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1627 call s_prohibit_abort("patch_icpp(patch_id)%smooth_patch_id /= patch_id", "Smoothen disabled. Patch " // trim(istr) // ": smooth_patch_id must be equal to patch_id")
1628# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1629 end if
1630# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1631 if (.not. f_is_default(patch_icpp(patch_id)%smooth_coeff)) then
1632# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1633 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%smooth_coeff)", "Smoothen disabled. Patch " // trim(istr) // ": smooth_coeff must not be set")
1634# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1635 end if
1636# 437 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1637 end if
1638
1639 end subroutine s_check_supported_patch_smoothing
1640
1641 !> Verify that inactive patches cannot be smoothed
1642 impure subroutine s_check_unsupported_patch_smoothing(patch_id)
1643
1644 ! Patch identifier
1645 integer, intent(in) :: patch_id
1646
1647 call s_int_to_str(patch_id, istr)
1648
1649 if (patch_icpp(patch_id)%smoothen) then
1650# 449 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1651 call s_prohibit_abort("patch_icpp(patch_id)%smoothen", "Inactive patch "//trim(istr)//": cannot have smoothen enabled")
1652# 449 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1653 end if
1654# 450 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1655 if (patch_icpp(patch_id)%smooth_patch_id /= patch_id) then
1656# 450 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1657 call s_prohibit_abort("patch_icpp(patch_id)%smooth_patch_id /= patch_id", "Inactive patch " // trim(istr) // ": smooth_patch_id must be equal to patch_id")
1658# 450 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1659 end if
1660# 452 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1661 if (.not. f_is_default(patch_icpp(patch_id)%smooth_coeff)) then
1662# 452 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1663 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%smooth_coeff)", "Inactive patch " // trim(istr) // ": smooth_coeff must not be set")
1664# 452 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1665 end if
1666# 454 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1667
1668 end subroutine s_check_unsupported_patch_smoothing
1669
1670 !> Check the primitive variables
1671 impure subroutine s_check_active_patch_primitive_variables(patch_id)
1672
1673 integer, intent(in) :: patch_id
1674 logical, dimension(3) :: is_set_b
1675
1676 call s_int_to_str(patch_id, istr)
1677
1678 if (f_is_default(patch_icpp(patch_id)%vel(1))) then
1679# 465 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1680 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%vel(1))", "Patch "//trim(istr)//": vel(1) must be set")
1681# 465 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1682 end if
1683# 466 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1684 if (n == 0 .and. (.not. f_is_default(patch_icpp(patch_id)%vel(2))) .and. (.not. f_approx_equal(patch_icpp(patch_id)%vel(2), 0._wp)) .and. (.not. mhd)) then
1685# 466 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1686 call s_prohibit_abort(.and..not..and..not..and..not."n == 0 ( f_is_default(patch_icpp(patch_id)%vel(2))) ( f_approx_equal(patch_icpp(patch_id)%vel(2), 0._wp)) ( mhd)", "Patch " // trim(istr) // ": vel(2) must not be set when n = 0")
1687# 466 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1688 end if
1689# 469 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1690 if (n > 0 .and. f_is_default(patch_icpp(patch_id)%vel(2))) then
1691# 469 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1692 call s_prohibit_abort(.and."n > 0 f_is_default(patch_icpp(patch_id)%vel(2))", "Patch "//trim(istr)//": vel(2) must be set when n > 0")
1693# 469 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1694 end if
1695# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1696 if (p == 0 .and. (.not. f_is_default(patch_icpp(patch_id)%vel(3))) .and. (.not. f_approx_equal(patch_icpp(patch_id)%vel(3), 0._wp)) .and. (.not. mhd)) then
1697# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1698 call s_prohibit_abort(.and..not..and..not..and..not."p == 0 ( f_is_default(patch_icpp(patch_id)%vel(3))) ( f_approx_equal(patch_icpp(patch_id)%vel(3), 0._wp)) ( mhd)", "Patch " // trim(istr) // ": vel(3) must not be set when p = 0")
1699# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1700 end if
1701# 473 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1702 if (p > 0 .and. f_is_default(patch_icpp(patch_id)%vel(3))) then
1703# 473 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1704 call s_prohibit_abort(.and."p > 0 f_is_default(patch_icpp(patch_id)%vel(3))", "Patch "//trim(istr)//": vel(3) must be set when p > 0")
1705# 473 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1706 end if
1707# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1708 if (mhd .and. (f_is_default(patch_icpp(patch_id)%vel(2)) .or. f_is_default(patch_icpp(patch_id)%vel(3)))) then
1709# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1710 call s_prohibit_abort(.and..or."mhd (f_is_default(patch_icpp(patch_id)%vel(2)) f_is_default(patch_icpp(patch_id)%vel(3)))", "Patch " // trim(istr) // ": All velocities (vel(1:3)) must be set when mhd = true")
1711# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1712 end if
1713# 476 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1714 if (model_eqns == model_eqns_gamma_law .and. patch_icpp(patch_id)%rho <= 0._wp) then
1715# 476 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1716 call s_prohibit_abort(.and."model_eqns == model_eqns_gamma_law patch_icpp(patch_id)%rho <= 0._wp", "Patch " // trim(istr) // ": rho must be greater than zero when model_eqns = 1")
1717# 476 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1718 end if
1719# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1720 if (model_eqns == model_eqns_gamma_law .and. patch_icpp(patch_id)%gamma <= 0._wp) then
1721# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1722 call s_prohibit_abort(.and."model_eqns == model_eqns_gamma_law patch_icpp(patch_id)%gamma <= 0._wp", "Patch " // trim(istr) // ": gamma must be greater than zero when model_eqns = 1")
1723# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1724 end if
1725# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1726 if (model_eqns == model_eqns_gamma_law .and. patch_icpp(patch_id)%pi_inf < 0._wp) then
1727# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1728 call s_prohibit_abort(.and."model_eqns == model_eqns_gamma_law patch_icpp(patch_id)%pi_inf < 0._wp", "Patch " // trim(istr) // ": pi_inf must be greater than or equal to zero when model_eqns = 1")
1729# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1730 end if
1731# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1732 if (patch_icpp(patch_id)%geometry == 5 .and. patch_icpp(patch_id)%pi_inf > 0) then
1733# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1734 call s_prohibit_abort(.and."patch_icpp(patch_id)%geometry == 5 patch_icpp(patch_id)%pi_inf > 0", "Patch " // trim(istr) // ": pi_inf must be less than or equal to zero when geometry = 5")
1735# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1736 end if
1737# 484 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1738 if (model_eqns == model_eqns_5eq .and. any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0._wp)) then
1739# 484 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1740 call s_prohibit_abort(.and."model_eqns == model_eqns_5eq any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0._wp)", "Patch " // trim(istr) // ": alpha_rho(1:num_fluids) must be greater than or equal to zero when model_eqns = 2")
1741# 484 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1742 end if
1743# 487 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1744
1745 is_set_b(1) = .not. f_is_default(patch_icpp(patch_id)%Bx)
1746 is_set_b(2) = .not. f_is_default(patch_icpp(patch_id)%By)
1747 is_set_b(3) = .not. f_is_default(patch_icpp(patch_id)%Bz)
1748
1749 if (.not. mhd .and. any(is_set_b)) then
1750# 492 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1751 call s_prohibit_abort(.not..and." mhd any(is_set_B)", "Bx, By, and Bz must not be set if MHD is not enabled")
1752# 492 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1753 end if
1754# 493 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1755 if (mhd .and. n == 0 .and. is_set_b(1)) then
1756# 493 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1757 call s_prohibit_abort(.and..and."mhd n == 0 is_set_B(1)", "Bx must not be set in 1D MHD simulations")
1758# 493 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1759 end if
1760# 494 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1761 if (mhd .and. n > 0 .and. .not. is_set_b(1)) then
1762# 494 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1763 call s_prohibit_abort(.and..and..not."mhd n > 0 is_set_B(1)", "Bx must be set in 2D/3D MHD simulations")
1764# 494 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1765 end if
1766# 495 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1767 if (mhd .and. .not. (is_set_b(2) .and. is_set_b(3))) then
1768# 495 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1769 call s_prohibit_abort(.and..not..and."mhd (is_set_B(2) is_set_B(3))", "By and Bz must be set in all MHD simulations")
1770# 495 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1771 end if
1772# 496 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1773
1774 if (model_eqns == model_eqns_5eq .and. num_fluids < num_fluids_max) then
1775 if (.not. f_all_default(patch_icpp(patch_id)%alpha_rho(num_fluids + 1:))) then
1776# 498 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1777 call s_prohibit_abort(.not." f_all_default(patch_icpp(patch_id)%alpha_rho(num_fluids + 1:))", "Patch " // trim(istr) // ": alpha_rho(i) must not be set for i > num_fluids")
1778# 498 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1779 end if
1780# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1781 if (.not. f_all_default(patch_icpp(patch_id)%alpha(num_fluids + 1:))) then
1782# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1783 call s_prohibit_abort(.not." f_all_default(patch_icpp(patch_id)%alpha(num_fluids + 1:))", "Patch " // trim(istr) // ": alpha(i) must not be set for i > num_fluids")
1784# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1785 end if
1786# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1787 if (f_is_default(patch_icpp(patch_id)%alpha(num_fluids))) then
1788# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1789 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%alpha(num_fluids))", "Patch " // trim(istr) // ": alpha(num_fluids) must be set")
1790# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1791 end if
1792# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1793 end if
1794
1795 if (chemistry) then
1796 end if
1797
1798 end subroutine s_check_active_patch_primitive_variables
1799
1800 !> Verify that the primitive variables associated with the given inactive patch remain unaltered by the user inputs.
1801 impure subroutine s_check_inactive_patch_primitive_variables(patch_id)
1802
1803 integer, intent(in) :: patch_id
1804
1805 call s_int_to_str(patch_id, istr)
1806
1807 if (.not. f_all_default(patch_icpp(patch_id)%alpha_rho)) then
1808# 518 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1809 call s_prohibit_abort(.not." f_all_default(patch_icpp(patch_id)%alpha_rho)", "Inactive patch " // trim(istr) // ": alpha_rho must not be set")
1810# 518 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1811 end if
1812# 520 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1813 if (.not. f_is_default(patch_icpp(patch_id)%rho)) then
1814# 520 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1815 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%rho)", "Inactive patch "//trim(istr)//": rho must not be set")
1816# 520 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1817 end if
1818# 521 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1819 if (.not. f_all_default(patch_icpp(patch_id)%vel)) then
1820# 521 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1821 call s_prohibit_abort(.not." f_all_default(patch_icpp(patch_id)%vel)", "Inactive patch "//trim(istr)//": vel must not be set")
1822# 521 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1823 end if
1824# 522 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1825 if (.not. f_is_default(patch_icpp(patch_id)%pres)) then
1826# 522 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1827 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%pres)", "Inactive patch "//trim(istr)//": pres must not be set")
1828# 522 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1829 end if
1830# 523 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1831 if (.not. f_all_default(patch_icpp(patch_id)%alpha)) then
1832# 523 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1833 call s_prohibit_abort(.not." f_all_default(patch_icpp(patch_id)%alpha)", "Inactive patch "//trim(istr)//": alpha must not be set")
1834# 523 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1835 end if
1836# 524 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1837 if (.not. f_is_default(patch_icpp(patch_id)%gamma)) then
1838# 524 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1839 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%gamma)", "Inactive patch "//trim(istr)//": gamma must not be set")
1840# 524 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1841 end if
1842# 525 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1843 if (.not. f_is_default(patch_icpp(patch_id)%pi_inf)) then
1844# 525 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1845 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%pi_inf)", "Inactive patch "//trim(istr)//": pi_inf must not be set")
1846# 525 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1847 end if
1848# 526 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1849
1850 end subroutine s_check_inactive_patch_primitive_variables
1851
1852 !> Verify that an STL/OBJ model patch (geometry 21) references a valid stl_models entry whose model file exists on disk.
1853 impure subroutine s_check_model_geometry(patch_id)
1854
1855 integer, intent(in) :: patch_id
1856 integer :: mid
1857 character(len=10) :: midstr
1858 logical :: file_exists
1859
1860 call s_int_to_str(patch_id, istr)
1861 mid = patch_icpp(patch_id)%model_id
1862 call s_int_to_str(mid, midstr)
1863
1864 if (mid <= 0 .or. mid > num_stl_models) then
1865# 541 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1866 call s_prohibit_abort(.or."mid <= 0 mid > num_stl_models", "patch_icpp(" // trim(istr) // ")%model_id=" // trim(midstr) // " must be in [1, num_stl_models]")
1867# 541 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1868 end if
1869# 543 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1870
1871 if (stl_models(mid)%model_filepath == dflt_char) then
1872# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1873 call s_prohibit_abort("stl_models(mid)%model_filepath == dflt_char", "Empty model file path for stl_models(" // trim(midstr) // ")")
1874# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1875 end if
1876# 545 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1877
1878 inquire (file=stl_models(mid)%model_filepath, exist=file_exists)
1879
1880 if (.not. file_exists) then
1881# 548 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1882 call s_prohibit_abort(.not." file_exists", "Model file " // trim(stl_models(mid)%model_filepath) // " requested by patch " // trim(istr) // " does not exist")
1883# 548 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1884 end if
1885# 551 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1886
1887 end subroutine s_check_model_geometry
1888
1889end module m_check_patches
m_check_patches
Validates geometry parameters and constraints for initial condition patches.
Definition m_check_patches.fpp.f90:706
m_check_patches::s_check_rectangle_patch_geometry
impure subroutine s_check_rectangle_patch_geometry(patch_id)
Check the rectangle patch input.
Definition m_check_patches.fpp.f90:918
m_check_patches::s_check_line_segment_patch_geometry
impure subroutine s_check_line_segment_patch_geometry(patch_id)
Check the line segment patch input.
Definition m_check_patches.fpp.f90:844
m_check_patches::istr
character(len=10) istr
Definition m_check_patches.fpp.f90:726
m_check_patches::s_check_ellipsoid_patch_geometry
impure subroutine s_check_ellipsoid_patch_geometry(patch_id)
Check the model patch input.
Definition m_check_patches.fpp.f90:1403
m_check_patches::s_check_3d_spherical_harmonic_patch_geometry
impure subroutine s_check_3d_spherical_harmonic_patch_geometry(patch_id)
Validate geometry parameters for a 3D spherical harmonic patch.
Definition m_check_patches.fpp.f90:1200
m_check_patches::s_check_circle_patch_geometry
impure subroutine s_check_circle_patch_geometry(patch_id)
Check the circle patch input.
Definition m_check_patches.fpp.f90:878
m_check_patches::s_check_cylinder_patch_geometry
impure subroutine s_check_cylinder_patch_geometry(patch_id)
Check the model patch input.
Definition m_check_patches.fpp.f90:1293
m_check_patches::s_check_2d_modal_patch_geometry
impure subroutine s_check_2d_modal_patch_geometry(patch_id)
Validate geometry parameters for a 2D modal (Fourier) patch.
Definition m_check_patches.fpp.f90:1160
m_check_patches::s_check_inactive_patch_geometry
impure subroutine s_check_inactive_patch_geometry(patch_id)
Verify that inactive patch geometry parameters remain at defaults.
Definition m_check_patches.fpp.f90:1455
m_check_patches::s_check_supported_patch_smoothing
impure subroutine s_check_supported_patch_smoothing(patch_id)
Check the smoothing parameters.
Definition m_check_patches.fpp.f90:1600
m_check_patches::s_check_inactive_patch_primitive_variables
impure subroutine s_check_inactive_patch_primitive_variables(patch_id)
Verify that the primitive variables associated with the given inactive patch remain unaltered by the ...
Definition m_check_patches.fpp.f90:1802
m_check_patches::s_check_ellipse_patch_geometry
impure subroutine s_check_ellipse_patch_geometry(patch_id)
Check the ellipse patch input.
Definition m_check_patches.fpp.f90:1016
m_check_patches::s_check_model_geometry
impure subroutine s_check_model_geometry(patch_id)
Verify that an STL/OBJ model patch (geometry 21) references a valid stl_models entry whose model file...
Definition m_check_patches.fpp.f90:1854
m_check_patches::s_check_2d_taylorgreen_vortex_patch_geometry
impure subroutine s_check_2d_taylorgreen_vortex_patch_geometry(patch_id)
Check the model patch input.
Definition m_check_patches.fpp.f90:1068
m_check_patches::s_check_active_patch_alteration_rights
impure subroutine s_check_active_patch_alteration_rights(patch_id)
Verify the active patch's right to overwrite the preceding patches.
Definition m_check_patches.fpp.f90:1555
m_check_patches::s_check_sphere_patch_geometry
impure subroutine s_check_sphere_patch_geometry(patch_id)
Check the model patch input.
Definition m_check_patches.fpp.f90:1120
m_check_patches::s_check_patches
impure subroutine, public s_check_patches
Validate the geometry parameters of all active and inactive initial condition patches.
Definition m_check_patches.fpp.f90:732
m_check_patches::s_check_active_patch_primitive_variables
impure subroutine s_check_active_patch_primitive_variables(patch_id)
Check the primitive variables.
Definition m_check_patches.fpp.f90:1672
m_check_patches::s_check_inactive_patch_alteration_rights
impure subroutine s_check_inactive_patch_alteration_rights(patch_id)
Verify that inactive patches cannot overwrite other patches.
Definition m_check_patches.fpp.f90:1577
m_check_patches::s_check_plane_sweep_patch_geometry
impure subroutine s_check_plane_sweep_patch_geometry(patch_id)
Check the model patch input.
Definition m_check_patches.fpp.f90:1350
m_check_patches::s_check_line_sweep_patch_geometry
impure subroutine s_check_line_sweep_patch_geometry(patch_id)
Check the line sweep patch input.
Definition m_check_patches.fpp.f90:964
m_check_patches::s_check_unsupported_patch_smoothing
impure subroutine s_check_unsupported_patch_smoothing(patch_id)
Verify that inactive patches cannot be smoothed.
Definition m_check_patches.fpp.f90:1643
m_check_patches::s_check_cuboid_patch_geometry
impure subroutine s_check_cuboid_patch_geometry(patch_id)
Check the model patch input.
Definition m_check_patches.fpp.f90:1240
m_compile_specific
Platform-specific file and directory operations: create, delete, inquire, getcwd, and basename.
Definition m_compile_specific.f90:6
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::model_eqns_5eq
integer, parameter model_eqns_5eq
Definition m_constants.fpp.f90:155
m_constants::num_patches_max
integer, parameter num_patches_max
Maximum number of IC patches.
Definition m_constants.fpp.f90:34
m_constants::dflt_int
integer, parameter dflt_int
Default integer value.
Definition m_constants.fpp.f90:30
m_constants::dflt_char
character, parameter dflt_char
Default string value.
Definition m_constants.fpp.f90:11
m_constants::num_fluids_max
integer, parameter num_fluids_max
Maximum number of fluids in the simulation.
Definition m_constants.fpp.f90:32
m_constants::model_eqns_gamma_law
integer, parameter model_eqns_gamma_law
Definition m_constants.fpp.f90:154
m_data_output
Writes grid and initial condition data to serial or parallel output files.
Definition m_data_output.fpp.f90:7
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:356
m_global_parameters
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:356
m_helper_basic::f_all_default
logical function, public f_all_default(var_array)
Check if ALL elements of a real(wp) array are of default value.
Definition m_helper_basic.fpp.f90:488
m_helper_basic::f_approx_equal
logical elemental function, public f_approx_equal(a, b, tol_input)
Check if two floating point numbers of wp are within tolerance.
Definition m_helper_basic.fpp.f90:373
m_helper_basic::f_is_default
logical elemental function, public f_is_default(var)
Check if a real(wp) variable is of default value.
Definition m_helper_basic.fpp.f90:463
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:367
m_helper::s_int_to_str
elemental subroutine, public s_int_to_str(i, res)
Convert an integer to its trimmed string representation.
Definition m_helper.fpp.f90:777
m_mpi_proxy
Broadcasts user inputs and decomposes the domain across MPI ranks for pre-processing.
Definition m_mpi_proxy.fpp.f90:7