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