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