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
629
630 ! Dependencies
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
641 use m_helper
643
644 implicit none
645
646 private; public :: s_check_patches
647
648 character(len=10) :: istr
649
650contains
651
652 !> Validate the geometry parameters of all active and inactive initial condition patches.
653 impure subroutine s_check_patches
654
655 integer :: i
656 character(len=10) :: num_patches_str
657
658 call s_int_to_str(num_patches, num_patches_str)
659
660 do i = 1, num_patches_max
661 if (i <= num_patches) then
662 call s_int_to_str(i, istr)
663 if (patch_icpp(i)%geometry == 6) then
664# 46 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
665 call s_prohibit_abort("patch_icpp(i)%geometry == 6", "Invalid patch geometry number. " // "patch_icpp(" // trim(istr) // ")%geometry is deprecated.")
666# 46 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
667 end if
668# 48 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
669 if (patch_icpp(i)%geometry == 7) then
670# 48 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
671 call s_prohibit_abort("patch_icpp(i)%geometry == 7", "Invalid patch geometry number. " // "patch_icpp(" // trim(istr) // ")%geometry is deprecated.")
672# 48 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
673 end if
674# 50 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
675 if (patch_icpp(i)%geometry == 15) then
676# 50 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
677 call s_prohibit_abort("patch_icpp(i)%geometry == 15", "Invalid patch geometry number. " // "patch_icpp(" // trim(istr) // ")%geometry is deprecated.")
678# 50 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
679 end if
680# 52 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
681 if (patch_icpp(i)%geometry == dflt_int) then
682# 52 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
683 call s_prohibit_abort("patch_icpp(i)%geometry == dflt_int", "Invalid patch geometry number. " // "patch_icpp(" // trim(istr) // ")%geometry must be set.")
684# 52 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
685 end if
686# 54 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
687
688 ! Constraints on the geometric initial condition patch parameters
689 if (patch_icpp(i)%geometry == 1) then
691 else if (patch_icpp(i)%geometry == 2) then
693 else if (patch_icpp(i)%geometry == 3) then
695 else if (patch_icpp(i)%geometry == 4) then
697 else if (patch_icpp(i)%geometry == 5) then
699 else if (patch_icpp(i)%geometry == 8) then
701 else if (patch_icpp(i)%geometry == 9) then
703 else if (patch_icpp(i)%geometry == 10) then
705 else if (patch_icpp(i)%geometry == 11) then
707 else if (patch_icpp(i)%geometry == 12) then
709 else if (patch_icpp(i)%geometry == 13) then
711 else if (patch_icpp(i)%geometry == 14) then
713 else if (patch_icpp(i)%geometry == 20) then
715 else if (patch_icpp(i)%geometry == 21) then
717 else
718 call s_prohibit_abort("Invalid patch geometry number", &
719 & "patch_icpp(" // trim(istr) // ")%geometry " // "must be between 1 and 21")
720 end if
721 else
722 if (patch_icpp(i)%geometry /= dflt_int) then
723# 89 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
724 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))
725# 89 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
726 end if
727# 93 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
729 end if
730 end do
731
732 ! Constraints on overwrite rights initial condition patch parameters
733 do i = 1, num_patches
734 if (i <= num_patches) then
736 else
738 end if
739 end do
740
741 ! Constraints on smoothing initial condition patch parameters
742 do i = 1, num_patches
743 if (i > 1 .and. (patch_icpp(i)%geometry == 2 .or. patch_icpp(i)%geometry == 3 .or. patch_icpp(i)%geometry == 4 &
744 & .or. patch_icpp(i)%geometry == 5 .or. patch_icpp(i)%geometry == 8 .or. patch_icpp(i)%geometry == 9 &
745 & .or. patch_icpp(i)%geometry == 10 .or. patch_icpp(i)%geometry == 11 .or. patch_icpp(i)%geometry == 12 &
746 & .or. patch_icpp(i)%geometry == 13 .or. patch_icpp(i)%geometry == 14)) then
748 else
750 end if
751 end do
752
753 ! Constraints on flow variables initial condition patch parameters
754 do i = 1, num_patches
755 if (i <= num_patches) then
757 else
759 end if
760 end do
761
762 end subroutine s_check_patches
763
764 !> Check the line segment patch input
765 impure subroutine s_check_line_segment_patch_geometry(patch_id)
766
767 integer, intent(in) :: patch_id
768
769 call s_int_to_str(patch_id, istr)
770
771 if (n > 0) then
772# 136 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
773 call s_prohibit_abort("n > 0", "Line segment patch "//trim(istr)//": n must be zero")
774# 136 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
775 end if
776 if (patch_icpp(patch_id)%length_x <= 0._wp) then
777# 137 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
778 call s_prohibit_abort("patch_icpp(patch_id)%length_x <= 0._wp", "Line segment patch " // trim(istr) // ": length_x must be greater than zero")
779# 137 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
780 end if
781# 139 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
782 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
783# 139 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
784 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Line segment patch "//trim(istr)//": x_centroid must be set")
785# 139 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
786 end if
787 if (cyl_coord) then
788# 140 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
789 call s_prohibit_abort("cyl_coord", "Line segment patch "//trim(istr)//": cyl_coord is not supported")
790# 140 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
791 end if
792
794
795 !> Check the circle patch input
796 impure subroutine s_check_circle_patch_geometry(patch_id)
797
798 integer, intent(in) :: patch_id
799
800 call s_int_to_str(patch_id, istr)
801
802 if (n == 0) then
803# 151 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
804 call s_prohibit_abort("n == 0", "Circle patch "//trim(istr)//": n must be zero")
805# 151 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
806 end if
807 if (p > 0) then
808# 152 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
809 call s_prohibit_abort("p > 0", "Circle patch "//trim(istr)//": p must be greater than zero")
810# 152 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
811 end if
812 if (patch_icpp(patch_id)%radius <= 0._wp) then
813# 153 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
814 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "Circle patch "//trim(istr)//": radius must be greater than zero")
815# 153 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
816 end if
817 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
818# 154 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
819 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Circle patch "//trim(istr)//": x_centroid must be set")
820# 154 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
821 end if
822 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
823# 155 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
824 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Circle patch "//trim(istr)//": y_centroid must be set")
825# 155 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
826 end if
827
828 end subroutine s_check_circle_patch_geometry
829
830 !> Check the rectangle patch input
831 impure subroutine s_check_rectangle_patch_geometry(patch_id)
832
833 integer, intent(in) :: patch_id
834
835 call s_int_to_str(patch_id, istr)
836
837 if (n == 0) then
838# 166 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
839 call s_prohibit_abort("n == 0", "Rectangle patch "//trim(istr)//": n must be greater than zero")
840# 166 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
841 end if
842 if (p > 0) then
843# 167 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
844 call s_prohibit_abort("p > 0", "Rectangle patch "//trim(istr)//": p must be zero")
845# 167 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
846 end if
847 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
848# 168 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
849 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Rectangle patch "//trim(istr)//": x_centroid must be set")
850# 168 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
851 end if
852 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
853# 169 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
854 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Rectangle patch "//trim(istr)//": y_centroid must be set")
855# 169 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
856 end if
857 if (patch_icpp(patch_id)%length_x <= 0._wp) then
858# 170 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
859 call s_prohibit_abort("patch_icpp(patch_id)%length_x <= 0._wp", "Rectangle patch "//trim(istr)//": length_x must be greater than zero")
860# 170 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
861 end if
862 if (patch_icpp(patch_id)%length_y <= 0._wp) then
863# 171 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
864 call s_prohibit_abort("patch_icpp(patch_id)%length_y <= 0._wp", "Rectangle patch "//trim(istr)//": length_y must be greater than zero")
865# 171 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
866 end if
867
869
870 !> Check the line sweep patch input
871 impure subroutine s_check_line_sweep_patch_geometry(patch_id)
872
873 integer, intent(in) :: patch_id
874
875 call s_int_to_str(patch_id, istr)
876
877 if (n == 0) then
878# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
879 call s_prohibit_abort("n == 0", "Line sweep patch "//trim(istr)//": n must be greater than zero")
880# 182 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
881 end if
882 if (p > 0) then
883# 183 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
884 call s_prohibit_abort("p > 0", "Line sweep patch "//trim(istr)//": p must be zero")
885# 183 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
886 end if
887 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
888# 184 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
889 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Line sweep patch "//trim(istr)//": x_centroid must be set")
890# 184 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
891 end if
892 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
893# 185 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
894 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Line sweep patch "//trim(istr)//": y_centroid must be set")
895# 185 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
896 end if
897 if (f_is_default(patch_icpp(patch_id)%normal(1))) then
898# 186 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
899 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(1))", "Line sweep patch "//trim(istr)//": normal(1) must be set")
900# 186 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
901 end if
902 if (f_is_default(patch_icpp(patch_id)%normal(2))) then
903# 187 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
904 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(2))", "Line sweep patch "//trim(istr)//": normal(2) must be set")
905# 187 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
906 end if
907 if (.not. f_is_default(patch_icpp(patch_id)%normal(3))) then
908# 188 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
909 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")
910# 188 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
911 end if
912# 190 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
913
915
916 !> Check the ellipse patch input
917 impure subroutine s_check_ellipse_patch_geometry(patch_id)
918
919 integer, intent(in) :: patch_id
920
921 call s_int_to_str(patch_id, istr)
922
923 if (n == 0) then
924# 200 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
925 call s_prohibit_abort("n == 0", "Ellipse patch "//trim(istr)//": n must be greater than zero")
926# 200 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
927 end if
928 if (p > 0) then
929# 201 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
930 call s_prohibit_abort("p > 0", "Ellipse patch "//trim(istr)//": p must be zero")
931# 201 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
932 end if
933 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
934# 202 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
935 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Ellipse patch "//trim(istr)//": x_centroid must be set")
936# 202 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
937 end if
938 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
939# 203 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
940 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Ellipse patch "//trim(istr)//": y_centroid must be set")
941# 203 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
942 end if
943 if (patch_icpp(patch_id)%radii(1) <= 0._wp) then
944# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
945 call s_prohibit_abort("patch_icpp(patch_id)%radii(1) <= 0._wp", "Ellipse patch "//trim(istr)//": radii(1) must be greater than zero")
946# 204 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
947 end if
948 if (patch_icpp(patch_id)%radii(2) <= 0._wp) then
949# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
950 call s_prohibit_abort("patch_icpp(patch_id)%radii(2) <= 0._wp", "Ellipse patch "//trim(istr)//": radii(2) must be greater than zero")
951# 205 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
952 end if
953 if (.not. f_is_default(patch_icpp(patch_id)%radii(3))) then
954# 206 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
955 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radii(3))", "Ellipse patch "//trim(istr)//": radii(3) must not be set")
956# 206 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
957 end if
958
959 end subroutine s_check_ellipse_patch_geometry
960
961 !> Check the model patch input
963
964 integer, intent(in) :: patch_id
965
966 call s_int_to_str(patch_id, istr)
967
968 if (n == 0) then
969# 217 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
970 call s_prohibit_abort("n == 0", "Taylor Green vortex patch "//trim(istr)//": n must be greater than zero")
971# 217 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
972 end if
973 if (p > 0) then
974# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
975 call s_prohibit_abort("p > 0", "Taylor Green vortex patch "//trim(istr)//": p must be zero")
976# 218 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
977 end if
978 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
979# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
980 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Taylor Green vortex patch " // trim(istr) // ": x_centroid must be set")
981# 219 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
982 end if
983# 221 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
984 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
985# 221 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
986 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Taylor Green vortex patch " // trim(istr) // ": y_centroid must be set")
987# 221 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
988 end if
989# 223 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
990 if (patch_icpp(patch_id)%length_x <= 0._wp) then
991# 223 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
992 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")
993# 223 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
994 end if
995# 225 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
996 if (patch_icpp(patch_id)%length_y <= 0._wp) then
997# 225 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
998 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")
999# 225 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1000 end if
1001# 227 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1002 if (patch_icpp(patch_id)%vel(2) <= 0._wp) then
1003# 227 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1004 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")
1005# 227 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1006 end if
1007# 229 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1008
1010
1011 !> Check the model patch input
1012 impure subroutine s_check_sphere_patch_geometry(patch_id)
1013
1014 integer, intent(in) :: patch_id
1015
1016 call s_int_to_str(patch_id, istr)
1017
1018 if (p == 0) then
1019# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1020 call s_prohibit_abort("p == 0", "Sphere patch "//trim(istr)//": p must be greater than zero")
1021# 239 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1022 end if
1023 if (patch_icpp(patch_id)%radius <= 0._wp) then
1024# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1025 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "Sphere patch "//trim(istr)//": radius must be greater than zero")
1026# 240 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1027 end if
1028 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1029# 241 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1030 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Sphere patch "//trim(istr)//": x_centroid must be set")
1031# 241 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1032 end if
1033 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1034# 242 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1035 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Sphere patch "//trim(istr)//": y_centroid must be set")
1036# 242 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1037 end if
1038 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1039# 243 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1040 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Sphere patch "//trim(istr)//": z_centroid must be set")
1041# 243 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1042 end if
1043
1044 end subroutine s_check_sphere_patch_geometry
1045
1046 !> Validate geometry parameters for a 2D modal (Fourier) patch
1047 impure subroutine s_check_2d_modal_patch_geometry(patch_id)
1048
1049 integer, intent(in) :: patch_id
1050
1051 call s_int_to_str(patch_id, istr)
1052
1053 if (n == 0) then
1054# 254 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1055 call s_prohibit_abort("n == 0", "2D modal patch "//trim(istr)//": n must be greater than zero")
1056# 254 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1057 end if
1058 if (p > 0) then
1059# 255 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1060 call s_prohibit_abort("p > 0", "2D modal patch "//trim(istr)//": p must be zero")
1061# 255 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1062 end if
1063 if (patch_icpp(patch_id)%radius <= 0._wp) then
1064# 256 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1065 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "2D modal patch "//trim(istr)//": radius must be greater than zero")
1066# 256 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1067 end if
1068 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1069# 257 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1070 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "2D modal patch "//trim(istr)//": x_centroid must be set")
1071# 257 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1072 end if
1073 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1074# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1075 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "2D modal patch "//trim(istr)//": y_centroid must be set")
1076# 258 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1077 end if
1078
1079 end subroutine s_check_2d_modal_patch_geometry
1080
1081 !> Validate geometry parameters for a 3D spherical harmonic patch
1083
1084 integer, intent(in) :: patch_id
1085
1086 call s_int_to_str(patch_id, istr)
1087
1088 if (p == 0) then
1089# 269 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1090 call s_prohibit_abort("p == 0", "Spherical harmonic patch "//trim(istr)//": p must be greater than zero")
1091# 269 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1092 end if
1093 if (patch_icpp(patch_id)%radius <= 0._wp) then
1094# 270 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1095 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "Spherical harmonic patch " // trim(istr) // ": radius must be greater than zero")
1096# 270 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1097 end if
1098# 272 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1099 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1100# 272 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1101 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Spherical harmonic patch " // trim(istr) // ": x_centroid must be set")
1102# 272 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1103 end if
1104# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1105 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1106# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1107 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Spherical harmonic patch " // trim(istr) // ": y_centroid must be set")
1108# 274 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1109 end if
1110# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1111 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1112# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1113 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Spherical harmonic patch " // trim(istr) // ": z_centroid must be set")
1114# 276 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1115 end if
1116# 278 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1117
1119
1120 !> Check the model patch input
1121 impure subroutine s_check_cuboid_patch_geometry(patch_id)
1122
1123 ! Patch identifier
1124 integer, intent(in) :: patch_id
1125
1126 call s_int_to_str(patch_id, istr)
1127
1128 if (p == 0) then
1129# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1130 call s_prohibit_abort("p == 0", "Cuboid patch "//trim(istr)//": p must be greater than zero")
1131# 289 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1132 end if
1133 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1134# 290 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1135 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Cuboid patch "//trim(istr)//": x_centroid must be set")
1136# 290 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1137 end if
1138 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1139# 291 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1140 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Cuboid patch "//trim(istr)//": y_centroid must be set")
1141# 291 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1142 end if
1143 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1144# 292 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1145 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Cuboid patch "//trim(istr)//": z_centroid must be set")
1146# 292 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1147 end if
1148 if (patch_icpp(patch_id)%length_x <= 0._wp) then
1149# 293 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1150 call s_prohibit_abort("patch_icpp(patch_id)%length_x <= 0._wp", "Cuboid patch "//trim(istr)//": length_x must be greater than zero")
1151# 293 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1152 end if
1153 if (patch_icpp(patch_id)%length_y <= 0._wp) then
1154# 294 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1155 call s_prohibit_abort("patch_icpp(patch_id)%length_y <= 0._wp", "Cuboid patch "//trim(istr)//": length_y must be greater than zero")
1156# 294 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1157 end if
1158 if (patch_icpp(patch_id)%length_z <= 0._wp) then
1159# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1160 call s_prohibit_abort("patch_icpp(patch_id)%length_z <= 0._wp", "Cuboid patch "//trim(istr)//": length_z must be greater than zero")
1161# 295 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1162 end if
1163
1164 end subroutine s_check_cuboid_patch_geometry
1165
1166 !> Check the model patch input
1167 impure subroutine s_check_cylinder_patch_geometry(patch_id)
1168
1169 ! Patch identifier
1170 integer, intent(in) :: patch_id
1171
1172 call s_int_to_str(patch_id, istr)
1173
1174 if (p == 0) then
1175# 307 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1176 call s_prohibit_abort("p == 0", "Cylinder patch "//trim(istr)//": p must be greater than zero")
1177# 307 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1178 end if
1179 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1180# 308 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1181 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Cylinder patch "//trim(istr)//": x_centroid must be set")
1182# 308 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1183 end if
1184 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1185# 309 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1186 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Cylinder patch "//trim(istr)//": y_centroid must be set")
1187# 309 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1188 end if
1189 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1190# 310 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1191 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Cylinder patch "//trim(istr)//": z_centroid must be set")
1192# 310 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1193 end if
1194 if (patch_icpp(patch_id)%radius <= 0._wp) then
1195# 311 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1196 call s_prohibit_abort("patch_icpp(patch_id)%radius <= 0._wp", "Cylinder patch "//trim(istr)//": radius must be greater than zero")
1197# 311 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1198 end if
1199
1200 ! Check if exactly one length is defined
1201 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
1202# 314 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1203 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")
1204# 314 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1205 end if
1206# 318 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1207
1208 ! Ensure the defined length is positive
1209 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
1210# 320 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1211 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")
1212# 320 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1213 end if
1214# 324 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1215
1216 end subroutine s_check_cylinder_patch_geometry
1217
1218 !> Check the model patch input
1219 impure subroutine s_check_plane_sweep_patch_geometry(patch_id)
1220
1221 ! Patch identifier
1222 integer, intent(in) :: patch_id
1223
1224 call s_int_to_str(patch_id, istr)
1225
1226 if (p == 0) then
1227# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1228 call s_prohibit_abort("p == 0", "Plane sweep patch "//trim(istr)//": p must be greater than zero")
1229# 335 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1230 end if
1231 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1232# 336 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1233 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Plane sweep patch "//trim(istr)//": x_centroid must be set")
1234# 336 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1235 end if
1236 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1237# 337 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1238 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Plane sweep patch "//trim(istr)//": y_centroid must be set")
1239# 337 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1240 end if
1241 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1242# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1243 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Plane sweep patch "//trim(istr)//": z_centroid must be set")
1244# 338 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1245 end if
1246 if (f_is_default(patch_icpp(patch_id)%normal(1))) then
1247# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1248 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(1))", "Plane sweep patch "//trim(istr)//": normal(1) must be set")
1249# 339 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1250 end if
1251 if (f_is_default(patch_icpp(patch_id)%normal(2))) then
1252# 340 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1253 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(2))", "Plane sweep patch "//trim(istr)//": normal(2) must be set")
1254# 340 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1255 end if
1256 if (f_is_default(patch_icpp(patch_id)%normal(3))) then
1257# 341 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1258 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%normal(3))", "Plane sweep patch "//trim(istr)//": normal(3) must be set")
1259# 341 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1260 end if
1261
1263
1264 !> Check the model patch input
1265 impure subroutine s_check_ellipsoid_patch_geometry(patch_id)
1266
1267 integer, intent(in) :: patch_id
1268
1269 call s_int_to_str(patch_id, istr)
1270
1271 if (p == 0) then
1272# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1273 call s_prohibit_abort("p == 0", "Ellipsoid patch "//trim(istr)//": p must be greater than zero")
1274# 352 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1275 end if
1276 if (f_is_default(patch_icpp(patch_id)%x_centroid)) then
1277# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1278 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%x_centroid)", "Ellipsoid patch "//trim(istr)//": x_centroid must be set")
1279# 353 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1280 end if
1281 if (f_is_default(patch_icpp(patch_id)%y_centroid)) then
1282# 354 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1283 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%y_centroid)", "Ellipsoid patch "//trim(istr)//": y_centroid must be set")
1284# 354 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1285 end if
1286 if (f_is_default(patch_icpp(patch_id)%z_centroid)) then
1287# 355 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1288 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%z_centroid)", "Ellipsoid patch "//trim(istr)//": z_centroid must be set")
1289# 355 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1290 end if
1291 if (patch_icpp(patch_id)%radii(1) <= 0._wp) then
1292# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1293 call s_prohibit_abort("patch_icpp(patch_id)%radii(1) <= 0._wp", "Ellipsoid patch "//trim(istr)//": radii(1) must be greater than zero")
1294# 356 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1295 end if
1296 if (patch_icpp(patch_id)%radii(2) <= 0._wp) then
1297# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1298 call s_prohibit_abort("patch_icpp(patch_id)%radii(2) <= 0._wp", "Ellipsoid patch "//trim(istr)//": radii(2) must be greater than zero")
1299# 357 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1300 end if
1301 if (patch_icpp(patch_id)%radii(3) <= 0._wp) then
1302# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1303 call s_prohibit_abort("patch_icpp(patch_id)%radii(3) <= 0._wp", "Ellipsoid patch "//trim(istr)//": radii(3) must be greater than zero")
1304# 358 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1305 end if
1306
1308
1309 !> Verify that inactive patch geometry parameters remain at defaults
1310 impure subroutine s_check_inactive_patch_geometry(patch_id)
1311
1312 integer, intent(in) :: patch_id
1313
1314 call s_int_to_str(patch_id, istr)
1315
1316 if (.not. f_is_default(patch_icpp(patch_id)%x_centroid)) then
1317# 369 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1318 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%x_centroid)", "Inactive patch " // trim(istr) // ": x_centroid must not be set")
1319# 369 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1320 end if
1321# 371 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1322 if (.not. f_is_default(patch_icpp(patch_id)%y_centroid)) then
1323# 371 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1324 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%y_centroid)", "Inactive patch " // trim(istr) // ": y_centroid must not be set")
1325# 371 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1326 end if
1327# 373 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1328 if (.not. f_is_default(patch_icpp(patch_id)%z_centroid)) then
1329# 373 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1330 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%z_centroid)", "Inactive patch " // trim(istr) // ": z_centroid must not be set")
1331# 373 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1332 end if
1333# 375 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1334 if (.not. f_is_default(patch_icpp(patch_id)%length_x)) then
1335# 375 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1336 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%length_x)", "Inactive patch "//trim(istr)//": length_x must not be set")
1337# 375 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1338 end if
1339 if (.not. f_is_default(patch_icpp(patch_id)%length_y)) then
1340# 376 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1341 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%length_y)", "Inactive patch "//trim(istr)//": length_y must not be set")
1342# 376 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1343 end if
1344 if (.not. f_is_default(patch_icpp(patch_id)%length_z)) then
1345# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1346 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%length_z)", "Inactive patch "//trim(istr)//": length_z must not be set")
1347# 377 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1348 end if
1349 if (.not. f_is_default(patch_icpp(patch_id)%radius)) then
1350# 378 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1351 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radius)", "Inactive patch "//trim(istr)//": radius must not be set")
1352# 378 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1353 end if
1354 if (.not. f_is_default(patch_icpp(patch_id)%epsilon)) then
1355# 379 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1356 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%epsilon)", "Inactive patch "//trim(istr)//": epsilon must not be set")
1357# 379 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1358 end if
1359 if (.not. f_is_default(patch_icpp(patch_id)%beta)) then
1360# 380 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1361 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%beta)", "Inactive patch "//trim(istr)//": beta must not be set")
1362# 380 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1363 end if
1364 if (.not. f_is_default(patch_icpp(patch_id)%normal(1))) then
1365# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1366 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%normal(1))", "Inactive patch "//trim(istr)//": normal(1) must not be set")
1367# 381 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1368 end if
1369 if (.not. f_is_default(patch_icpp(patch_id)%normal(2))) then
1370# 382 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1371 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%normal(2))", "Inactive patch "//trim(istr)//": normal(2) must not be set")
1372# 382 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1373 end if
1374 if (.not. f_is_default(patch_icpp(patch_id)%normal(3))) then
1375# 383 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1376 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%normal(3))", "Inactive patch "//trim(istr)//": normal(3) must not be set")
1377# 383 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1378 end if
1379 if (.not. f_is_default(patch_icpp(patch_id)%radii(1))) then
1380# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1381 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radii(1))", "Inactive patch "//trim(istr)//": radii(1) must not be set")
1382# 384 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1383 end if
1384 if (.not. f_is_default(patch_icpp(patch_id)%radii(2))) then
1385# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1386 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radii(2))", "Inactive patch "//trim(istr)//": radii(2) must not be set")
1387# 385 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1388 end if
1389 if (.not. f_is_default(patch_icpp(patch_id)%radii(3))) then
1390# 386 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1391 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%radii(3))", "Inactive patch "//trim(istr)//": radii(3) must not be set")
1392# 386 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1393 end if
1394
1395 end subroutine s_check_inactive_patch_geometry
1396
1397 !> Verify the active patch's right to overwrite the preceding patches
1398 impure subroutine s_check_active_patch_alteration_rights(patch_id)
1399
1400 integer, intent(in) :: patch_id
1401
1402 call s_int_to_str(patch_id, istr)
1403
1404 if (.not. patch_icpp(patch_id)%alter_patch(0)) then
1405# 397 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1406 call s_prohibit_abort(.not." patch_icpp(patch_id)%alter_patch(0)", "Patch "//trim(istr)//": alter_patch(0) must be true")
1407# 397 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1408 end if
1409 if (any(patch_icpp(patch_id)%alter_patch(patch_id:))) then
1410# 398 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1411 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")
1412# 398 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1413 end if
1414# 401 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1415
1417
1418 !> Verify that inactive patches cannot overwrite other patches
1420
1421 ! Patch identifier
1422 integer, intent(in) :: patch_id
1423
1424 call s_int_to_str(patch_id, istr)
1425
1426 if (.not. patch_icpp(patch_id)%alter_patch(0)) then
1427# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1428 call s_prohibit_abort(.not." patch_icpp(patch_id)%alter_patch(0)", "Inactive patch "//trim(istr)//": cannot have alter_patch(0) altered")
1429# 412 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1430 end if
1431 if (any(patch_icpp(patch_id)%alter_patch(1:))) then
1432# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1433 call s_prohibit_abort("any(patch_icpp(patch_id)%alter_patch(1:))", "Inactive patch " // trim(istr) // ": cannot have any alter_patch(i) enabled")
1434# 413 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1435 end if
1436# 415 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1437
1439
1440 !> Check the smoothing parameters
1441 impure subroutine s_check_supported_patch_smoothing(patch_id)
1442
1443 integer, intent(in) :: patch_id
1444
1445 call s_int_to_str(patch_id, istr)
1446
1447 if (patch_icpp(patch_id)%smoothen) then
1448 if (patch_icpp(patch_id)%smooth_patch_id >= patch_id) then
1449# 426 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1450 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")
1451# 426 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1452 end if
1453# 428 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1454 if (patch_icpp(patch_id)%smooth_patch_id == 0) then
1455# 428 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1456 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")
1457# 428 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1458 end if
1459# 430 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1460 if (patch_icpp(patch_id)%smooth_coeff <= 0._wp) then
1461# 430 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1462 call s_prohibit_abort("patch_icpp(patch_id)%smooth_coeff <= 0._wp", "Smoothen enabled. Patch " // trim(istr) // ": smooth_coeff must be greater than zero")
1463# 430 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1464 end if
1465# 432 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1466 else
1467 if (patch_icpp(patch_id)%smooth_patch_id /= patch_id) then
1468# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1469 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")
1470# 433 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1471 end if
1472# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1473 if (.not. f_is_default(patch_icpp(patch_id)%smooth_coeff)) then
1474# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1475 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")
1476# 435 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1477 end if
1478# 437 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1479 end if
1480
1482
1483 !> Verify that inactive patches cannot be smoothed
1484 impure subroutine s_check_unsupported_patch_smoothing(patch_id)
1485
1486 ! Patch identifier
1487 integer, intent(in) :: patch_id
1488
1489 call s_int_to_str(patch_id, istr)
1490
1491 if (patch_icpp(patch_id)%smoothen) then
1492# 449 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1493 call s_prohibit_abort("patch_icpp(patch_id)%smoothen", "Inactive patch "//trim(istr)//": cannot have smoothen enabled")
1494# 449 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1495 end if
1496 if (patch_icpp(patch_id)%smooth_patch_id /= patch_id) then
1497# 450 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1498 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")
1499# 450 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1500 end if
1501# 452 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1502 if (.not. f_is_default(patch_icpp(patch_id)%smooth_coeff)) then
1503# 452 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1504 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%smooth_coeff)", "Inactive patch " // trim(istr) // ": smooth_coeff must not be set")
1505# 452 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1506 end if
1507# 454 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1508
1510
1511 !> Check the primitive variables
1513
1514 integer, intent(in) :: patch_id
1515 logical, dimension(3) :: is_set_b
1516
1517 call s_int_to_str(patch_id, istr)
1518
1519 if (f_is_default(patch_icpp(patch_id)%vel(1))) then
1520# 465 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1521 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%vel(1))", "Patch "//trim(istr)//": vel(1) must be set")
1522# 465 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1523 end if
1524 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
1525# 466 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1526 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")
1527# 466 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1528 end if
1529# 469 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1530 if (n > 0 .and. f_is_default(patch_icpp(patch_id)%vel(2))) then
1531# 469 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1532 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")
1533# 469 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1534 end if
1535 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
1536# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1537 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")
1538# 470 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1539 end if
1540# 473 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1541 if (p > 0 .and. f_is_default(patch_icpp(patch_id)%vel(3))) then
1542# 473 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1543 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")
1544# 473 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1545 end if
1546 if (mhd .and. (f_is_default(patch_icpp(patch_id)%vel(2)) .or. f_is_default(patch_icpp(patch_id)%vel(3)))) then
1547# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1548 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")
1549# 474 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1550 end if
1551# 476 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1552 if (model_eqns == model_eqns_gamma_law .and. patch_icpp(patch_id)%rho <= 0._wp) then
1553# 476 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1554 call s_prohibit_abort(.and."model_eqns == model_eqns_gamma_law patch_icpp(patch_id)%rho <= 0._wp", "Patch " // trim(istr) // ": rho must be greater than zero when model_eqns = 1")
1555# 476 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1556 end if
1557# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1558 if (model_eqns == model_eqns_gamma_law .and. patch_icpp(patch_id)%gamma <= 0._wp) then
1559# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1560 call s_prohibit_abort(.and."model_eqns == model_eqns_gamma_law patch_icpp(patch_id)%gamma <= 0._wp", "Patch " // trim(istr) // ": gamma must be greater than zero when model_eqns = 1")
1561# 478 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1562 end if
1563# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1564 if (model_eqns == model_eqns_gamma_law .and. patch_icpp(patch_id)%pi_inf < 0._wp) then
1565# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1566 call s_prohibit_abort(.and."model_eqns == model_eqns_gamma_law patch_icpp(patch_id)%pi_inf < 0._wp", "Patch " // trim(istr) // ": pi_inf must be greater than or equal to zero when model_eqns = 1")
1567# 480 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1568 end if
1569# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1570 if (patch_icpp(patch_id)%geometry == 5 .and. patch_icpp(patch_id)%pi_inf > 0) then
1571# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1572 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")
1573# 482 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1574 end if
1575# 484 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1576 if (model_eqns == model_eqns_5eq .and. any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0._wp)) then
1577# 484 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1578 call s_prohibit_abort(.and."model_eqns == model_eqns_5eq any(patch_icpp(patch_id)%alpha_rho(1:num_fluids) < 0._wp)", "Patch " // trim(istr) // ": alpha_rho(1:num_fluids) must be greater than or equal to zero when model_eqns = 2")
1579# 484 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1580 end if
1581# 487 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1582
1583 is_set_b(1) = .not. f_is_default(patch_icpp(patch_id)%Bx)
1584 is_set_b(2) = .not. f_is_default(patch_icpp(patch_id)%By)
1585 is_set_b(3) = .not. f_is_default(patch_icpp(patch_id)%Bz)
1586
1587 if (.not. mhd .and. any(is_set_b)) then
1588# 492 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1589 call s_prohibit_abort(.not..and." mhd any(is_set_B)", "Bx, By, and Bz must not be set if MHD is not enabled")
1590# 492 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1591 end if
1592 if (mhd .and. n == 0 .and. is_set_b(1)) then
1593# 493 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1594 call s_prohibit_abort(.and..and."mhd n == 0 is_set_B(1)", "Bx must not be set in 1D MHD simulations")
1595# 493 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1596 end if
1597 if (mhd .and. n > 0 .and. .not. is_set_b(1)) then
1598# 494 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1599 call s_prohibit_abort(.and..and..not."mhd n > 0 is_set_B(1)", "Bx must be set in 2D/3D MHD simulations")
1600# 494 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1601 end if
1602 if (mhd .and. .not. (is_set_b(2) .and. is_set_b(3))) then
1603# 495 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1604 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")
1605# 495 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1606 end if
1607
1608 if (model_eqns == model_eqns_5eq .and. num_fluids < num_fluids_max) then
1609 if (.not. f_all_default(patch_icpp(patch_id)%alpha_rho(num_fluids + 1:))) then
1610# 498 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1611 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")
1612# 498 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1613 end if
1614# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1615 if (.not. f_all_default(patch_icpp(patch_id)%alpha(num_fluids + 1:))) then
1616# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1617 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")
1618# 500 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1619 end if
1620# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1621 if (f_is_default(patch_icpp(patch_id)%alpha(num_fluids))) then
1622# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1623 call s_prohibit_abort("f_is_default(patch_icpp(patch_id)%alpha(num_fluids))", "Patch " // trim(istr) // ": alpha(num_fluids) must be set")
1624# 502 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1625 end if
1626# 504 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1627 end if
1628
1629 if (chemistry) then
1630 end if
1631
1633
1634 !> Verify that the primitive variables associated with the given inactive patch remain unaltered by the user inputs.
1636
1637 integer, intent(in) :: patch_id
1638
1639 call s_int_to_str(patch_id, istr)
1640
1641 if (.not. f_all_default(patch_icpp(patch_id)%alpha_rho)) then
1642# 518 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1643 call s_prohibit_abort(.not." f_all_default(patch_icpp(patch_id)%alpha_rho)", "Inactive patch " // trim(istr) // ": alpha_rho must not be set")
1644# 518 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1645 end if
1646# 520 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1647 if (.not. f_is_default(patch_icpp(patch_id)%rho)) then
1648# 520 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1649 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%rho)", "Inactive patch "//trim(istr)//": rho must not be set")
1650# 520 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1651 end if
1652 if (.not. f_all_default(patch_icpp(patch_id)%vel)) then
1653# 521 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1654 call s_prohibit_abort(.not." f_all_default(patch_icpp(patch_id)%vel)", "Inactive patch "//trim(istr)//": vel must not be set")
1655# 521 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1656 end if
1657 if (.not. f_is_default(patch_icpp(patch_id)%pres)) then
1658# 522 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1659 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%pres)", "Inactive patch "//trim(istr)//": pres must not be set")
1660# 522 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1661 end if
1662 if (.not. f_all_default(patch_icpp(patch_id)%alpha)) then
1663# 523 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1664 call s_prohibit_abort(.not." f_all_default(patch_icpp(patch_id)%alpha)", "Inactive patch "//trim(istr)//": alpha must not be set")
1665# 523 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1666 end if
1667 if (.not. f_is_default(patch_icpp(patch_id)%gamma)) then
1668# 524 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1669 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%gamma)", "Inactive patch "//trim(istr)//": gamma must not be set")
1670# 524 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1671 end if
1672 if (.not. f_is_default(patch_icpp(patch_id)%pi_inf)) then
1673# 525 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1674 call s_prohibit_abort(.not." f_is_default(patch_icpp(patch_id)%pi_inf)", "Inactive patch "//trim(istr)//": pi_inf must not be set")
1675# 525 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1676 end if
1677
1679
1680 !> Verify that an STL/OBJ model patch (geometry 21) references a valid stl_models entry whose model file exists on disk.
1681 impure subroutine s_check_model_geometry(patch_id)
1682
1683 integer, intent(in) :: patch_id
1684 integer :: mid
1685 character(len=10) :: midstr
1686 logical :: file_exists
1687
1688 call s_int_to_str(patch_id, istr)
1689 mid = patch_icpp(patch_id)%model_id
1690 call s_int_to_str(mid, midstr)
1691
1692 if (mid <= 0 .or. mid > num_stl_models) then
1693# 541 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1694 call s_prohibit_abort(.or."mid <= 0 mid > num_stl_models", "patch_icpp(" // trim(istr) // ")%model_id=" // trim(midstr) // " must be in [1, num_stl_models]")
1695# 541 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1696 end if
1697# 543 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1698
1699 if (stl_models(mid)%model_filepath == dflt_char) then
1700# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1701 call s_prohibit_abort("stl_models(mid)%model_filepath == dflt_char", "Empty model file path for stl_models(" // trim(midstr) // ")")
1702# 544 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1703 end if
1704
1705 inquire (file=stl_models(mid)%model_filepath, exist=file_exists)
1706
1707 if (.not. file_exists) then
1708# 548 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1709 call s_prohibit_abort(.not." file_exists", "Model file " // trim(stl_models(mid)%model_filepath) // " requested by patch " // trim(istr) // " does not exist")
1710# 548 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1711 end if
1712# 551 "/home/runner/work/MFC/MFC/src/pre_process/m_check_patches.fpp"
1713
1714 end subroutine s_check_model_geometry
1715
1716end module m_check_patches
Validates geometry parameters and constraints for initial condition patches.
impure subroutine s_check_rectangle_patch_geometry(patch_id)
Check the rectangle patch input.
impure subroutine s_check_line_segment_patch_geometry(patch_id)
Check the line segment patch input.
character(len=10) istr
impure subroutine s_check_ellipsoid_patch_geometry(patch_id)
Check the model patch input.
impure subroutine s_check_3d_spherical_harmonic_patch_geometry(patch_id)
Validate geometry parameters for a 3D spherical harmonic patch.
impure subroutine s_check_circle_patch_geometry(patch_id)
Check the circle patch input.
impure subroutine s_check_cylinder_patch_geometry(patch_id)
Check the model patch input.
impure subroutine s_check_2d_modal_patch_geometry(patch_id)
Validate geometry parameters for a 2D modal (Fourier) patch.
impure subroutine s_check_inactive_patch_geometry(patch_id)
Verify that inactive patch geometry parameters remain at defaults.
impure subroutine s_check_supported_patch_smoothing(patch_id)
Check the smoothing parameters.
impure subroutine s_check_inactive_patch_primitive_variables(patch_id)
Verify that the primitive variables associated with the given inactive patch remain unaltered by the ...
impure subroutine s_check_ellipse_patch_geometry(patch_id)
Check the ellipse patch input.
impure subroutine s_check_model_geometry(patch_id)
Verify that an STL/OBJ model patch (geometry 21) references a valid stl_models entry whose model file...
impure subroutine s_check_2d_taylorgreen_vortex_patch_geometry(patch_id)
Check the model patch input.
impure subroutine s_check_active_patch_alteration_rights(patch_id)
Verify the active patch's right to overwrite the preceding patches.
impure subroutine s_check_sphere_patch_geometry(patch_id)
Check the model patch input.
impure subroutine, public s_check_patches
Validate the geometry parameters of all active and inactive initial condition patches.
impure subroutine s_check_active_patch_primitive_variables(patch_id)
Check the primitive variables.
impure subroutine s_check_inactive_patch_alteration_rights(patch_id)
Verify that inactive patches cannot overwrite other patches.
impure subroutine s_check_plane_sweep_patch_geometry(patch_id)
Check the model patch input.
impure subroutine s_check_line_sweep_patch_geometry(patch_id)
Check the line sweep patch input.
impure subroutine s_check_unsupported_patch_smoothing(patch_id)
Verify that inactive patches cannot be smoothed.
impure subroutine s_check_cuboid_patch_geometry(patch_id)
Check the model patch input.
Platform-specific file and directory operations: create, delete, inquire, getcwd, and basename.
Compile-time constant parameters: default values, tolerances, and physical constants.
integer, parameter model_eqns_5eq
integer, parameter num_patches_max
Maximum number of IC patches.
integer, parameter dflt_int
Default integer value.
character, parameter dflt_char
Default string value.
integer, parameter num_fluids_max
Maximum number of fluids in the simulation.
integer, parameter model_eqns_gamma_law
Writes grid and initial condition data to serial or parallel output files.
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
logical function, public f_all_default(var_array)
Checks if ALL elements of a real(wp) array are of default value.
logical elemental function, public f_approx_equal(a, b, tol_input)
Check if two floating point numbers of wp are within tolerance.
logical elemental function, public f_is_default(var)
Checks if a real(wp) variable is of default value.
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
elemental subroutine, public s_int_to_str(i, res)
Convert an integer to its trimmed string representation.
Broadcasts user inputs and decomposes the domain across MPI ranks for pre-processing.