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