MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_helper_basic.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
2!>
3!! @file
4!! @brief Contains module m_helper_basic
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
7# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
8# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
9# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
10# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
11# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
12# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
13# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
14
15# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
17# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
21! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
22! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
23# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
24# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
25# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
26
27# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29
30# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
61! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
62! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
63# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
64# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
65# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
66
67# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
69
70# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
71
72# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
73
74# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
75
76# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
77
78# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
79
80# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
81
82# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
83
84# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
85! New line at end of file is required for FYPP
86# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
87
88# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 95 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 100 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 105 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 110 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117
118# 115 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
119
120# 120 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
121
122# 125 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
123
124# 130 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
125
126# 135 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 165 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 219 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 233 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 258 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 269 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 271 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139# 282 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 332 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142
143# 342 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
144
145# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
146
147# 361 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
148
149# 378 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
150
151# 388 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
152
153# 395 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
154
155# 401 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
156
157# 407 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
158
159# 413 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
160
161# 419 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
162
163# 425 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
164! New line at end of file is required for FYPP
165# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
166# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
167# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
168# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
173
174# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
175# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
177
178# 12 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
179# 1 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp" 1
180! Default for Fypp runs outside the toolchain (e.g. documentation). Searched last, so the
181! build/include/<target>/thermochem.fpp the toolchain writes from m_thermochem takes precedence.
182# 4 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
183# 5 "/home/runner/work/MFC/MFC/src/common/include/defaults/thermochem.fpp"
184# 13 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 2
185
186# 16 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
187# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
188
189# 24 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
190
191# 53 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
192
193# 65 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
194
195# 75 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
196
197# 105 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
198
199# 117 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
200
201# 127 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
202
203# 174 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
204! New line at end of file is required for FYPP
205# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
206
207# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236
237# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
238
239# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
240
241# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
242
243# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
244
245# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
246
247# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
248
249# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
250
251# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
252
253# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
254
255# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
256
257# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
258
259# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
260
261# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
262! New line at end of file is required for FYPP
263# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
264
265! GPU parallel region (scalar reductions, maxval/minval)
266# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! GPU parallel loop over threads (most common GPU macro)
269# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Required closing for GPU_PARALLEL_LOOP
272# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Mark routine for device compilation
275# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Declare device-resident data
278# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Inner loop within a GPU parallel region
281# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Scoped GPU data region
284# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Host code with device pointers (for MPI with GPU buffers)
287# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289! Allocate device memory (unscoped)
290# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291
292! Free device memory
293# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
294
295! Atomic operation on device
296# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297
298! End atomic capture block
299# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
300
301! Copy data between host and device
302# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
303
304! Synchronization barrier
305# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
306
307! Import GPU library module (openacc or omp_lib)
308# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
309
310! Emit code only for AMD compiler
311# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
312
313! Emit code for non-Cray compilers
314# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
315
316! Emit code only for Cray compiler
317# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
318
319! Emit code for non-NVIDIA compilers
320# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
321
322# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
323# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
324! New line at end of file is required for FYPP
325# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
326
327# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
328
329! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
330! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
331! example see misc/nvidia_uvm/bind.sh.
332# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
333
334! Allocate and create GPU device memory
335# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
336
337! Free GPU device memory and deallocate
338# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
339
340! Cray-specific GPU pointer setup for vector fields
341# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
342
343! Cray-specific GPU pointer setup for scalar fields
344# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
345
346! Cray-specific GPU pointer setup for acoustic source spatials
347# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
348
349# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
350
351# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
352! New line at end of file is required for FYPP
353# 6 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp" 2
354
355!> @brief Basic floating-point utilities: approximate equality, default detection, and coordinate bounds
356module m_helper_basic
357
358 use m_derived_types
359 use m_precision_select
360 use m_constants, only: recon_type_weno, recon_type_muscl
361
362 implicit none
363
364 private
365 public :: f_approx_equal, f_approx_in_array, f_is_default, f_all_default, f_is_integer, s_configure_coordinate_bounds, &
366 & s_update_cell_bounds
367
368contains
369
370 !> Check if two floating point numbers of wp are within tolerance.
371 !! @param tol_input Relative error (default = 1.e-10_wp).
372 logical elemental function f_approx_equal(a, b, tol_input) result(res)
373
374
375# 26 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
376#if MFC_OpenACC
377# 26 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
378!$acc routine seq
379# 26 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
380#elif MFC_OpenMP
381# 26 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
382
383# 26 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
384
385# 26 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
386!$omp declare target device_type(any)
387# 26 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
388#endif
389# 27 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
390 real(wp), intent(in) :: a, b
391 real(wp), optional, intent(in) :: tol_input
392 real(wp) :: tol
393
394 if (present(tol_input)) then
395 tol = tol_input
396 else
397 if (wp == single_precision) then
398 tol = 1.e-6_wp
399 else
400 tol = 1.e-10_wp
401 end if
402 end if
403
404 if (a == b) then
405 res = .true.
406 else if (a == 0._wp .or. b == 0._wp .or. (abs(a) + abs(b) < tiny(a))) then
407 res = (abs(a - b) < (tol*tiny(a)))
408 else
409 res = (abs(a - b)/min(abs(a) + abs(b), huge(a)) < tol)
410 end if
411
412 end function f_approx_equal
413
414 !> Check if a wp value approximately matches any element of an array within tolerance.
415 !! @param tol_input Relative error (default = 1e-10_wp).
416 logical function f_approx_in_array(a, b, tol_input) result(res)
417
418
419# 55 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
420#if MFC_OpenACC
421# 55 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
422!$acc routine seq
423# 55 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
424#elif MFC_OpenMP
425# 55 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
426
427# 55 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
428
429# 55 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
430!$omp declare target device_type(any)
431# 55 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
432#endif
433# 56 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
434 real(wp), intent(in) :: a
435 real(wp), intent(in) :: b(:)
436 real(wp), optional, intent(in) :: tol_input
437 real(wp) :: tol
438 integer :: i
439
440 res = .false.
441
442 if (present(tol_input)) then
443 tol = tol_input
444 else
445 if (wp == single_precision) then
446 tol = 1.e-6_wp
447 else
448 tol = 1.e-10_wp
449 end if
450 end if
451
452 do i = 1, size(b)
453 if (f_approx_equal(a, b(i), tol)) then
454 res = .true.
455 exit
456 end if
457 end do
458
459 end function f_approx_in_array
460
461 !> Check if a real(wp) variable is of default value.
462 logical elemental function f_is_default(var) result(res)
463
464
465# 86 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
466#if MFC_OpenACC
467# 86 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
468!$acc routine seq
469# 86 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
470#elif MFC_OpenMP
471# 86 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
472
473# 86 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
474
475# 86 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
476!$omp declare target device_type(any)
477# 86 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
478#endif
479# 87 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
480 real(wp), intent(in) :: var
481
482 res = f_approx_equal(var, dflt_real)
483
484 end function f_is_default
485
486 !> Check if ALL elements of a real(wp) array are of default value.
487 logical function f_all_default(var_array) result(res)
488
489 real(wp), intent(in) :: var_array(:)
490
491 res = all(f_is_default(var_array))
492
493 end function f_all_default
494
495 !> Check if a real(wp) variable is an integer.
496 logical elemental function f_is_integer(var) result(res)
497
498
499# 105 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
500#if MFC_OpenACC
501# 105 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
502!$acc routine seq
503# 105 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
504#elif MFC_OpenMP
505# 105 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
506
507# 105 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
508
509# 105 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
510!$omp declare target device_type(any)
511# 105 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
512#endif
513# 106 "/home/runner/work/MFC/MFC/src/common/m_helper_basic.fpp"
514 real(wp), intent(in) :: var
515
516 res = f_approx_equal(var, real(nint(var), wp))
517
518 end function f_is_integer
519
520 !> Compute ghost-cell buffer size and set interior/buffered coordinate index bounds.
521 subroutine s_configure_coordinate_bounds(recon_type, weno_polyn, muscl_polyn, igr_order, buff_size, idwint, idwbuff, viscous, &
522 & bubbles_lagrange, m, n, p, num_dims, igr, ib, fd_number)
523
524 integer, intent(in) :: recon_type, weno_polyn, muscl_polyn
525 integer, intent(in) :: m, n, p, num_dims, igr_order, fd_number
526 integer, intent(inout) :: buff_size
527 type(int_bounds_info), dimension(3), intent(inout) :: idwint, idwbuff
528 logical, intent(in) :: viscous, bubbles_lagrange
529 logical, intent(in) :: igr
530 logical, intent(in) :: ib
531
532 ! Determine ghost cell buffer size for boundary conditions
533
534 if (igr) then
535 buff_size = (igr_order - 1)/2 + 2
536 else if (recon_type == recon_type_weno) then
537 if (viscous) then
538 buff_size = 2*weno_polyn + 2
539 else
540 buff_size = weno_polyn + 2
541 end if
542 else if (recon_type == recon_type_muscl) then
543 buff_size = muscl_polyn + 2
544 end if
545
546 ! Correction for smearing function in the lagrangian subgrid bubble model
547 if (bubbles_lagrange) then
548 buff_size = max(buff_size + fd_number, mapcells + 1 + fd_number)
549 end if
550
551 if (ib) then
552 buff_size = max(buff_size, 10)
553 end if
554
555 ! Configuring Coordinate Direction Indexes
556 idwint(1)%beg = 0; idwint(2)%beg = 0; idwint(3)%beg = 0
557 idwint(1)%end = m; idwint(2)%end = n; idwint(3)%end = p
558
559 idwbuff(1)%beg = -buff_size
560 if (num_dims > 1) then; idwbuff(2)%beg = -buff_size; else; idwbuff(2)%beg = 0; end if
561 if (num_dims > 2) then; idwbuff(3)%beg = -buff_size; else; idwbuff(3)%beg = 0; end if
562
563 idwbuff(1)%end = idwint(1)%end - idwbuff(1)%beg
564 idwbuff(2)%end = idwint(2)%end - idwbuff(2)%beg
565 idwbuff(3)%end = idwint(3)%end - idwbuff(3)%beg
566
567 end subroutine s_configure_coordinate_bounds
568
569 !> Update the min and max number of cells in each set of axes
570 !! @param bounds min and max values to update
571 elemental subroutine s_update_cell_bounds(bounds, m, n, p)
572
573 type(cell_num_bounds), intent(out) :: bounds
574 integer, intent(in) :: m, n, p
575
576 bounds%mn_max = max(m, n)
577 bounds%np_max = max(n, p)
578 bounds%mp_max = max(m, p)
579 bounds%mnp_max = max(m, n, p)
580 bounds%mn_min = min(m, n)
581 bounds%np_min = min(n, p)
582 bounds%mp_min = min(m, p)
583 bounds%mnp_min = min(m, n, p)
584
585 end subroutine s_update_cell_bounds
586
587end module m_helper_basic
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::recon_type_muscl
integer, parameter recon_type_muscl
Definition m_constants.fpp.f90:168
m_constants::recon_type_weno
integer, parameter recon_type_weno
Definition m_constants.fpp.f90:167
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:356
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:356
m_helper_basic::s_configure_coordinate_bounds
subroutine, public s_configure_coordinate_bounds(recon_type, weno_polyn, muscl_polyn, igr_order, buff_size, idwint, idwbuff, viscous, bubbles_lagrange, m, n, p, num_dims, igr, ib, fd_number)
Compute ghost-cell buffer size and set interior/buffered coordinate index bounds.
Definition m_helper_basic.fpp.f90:523
m_helper_basic::f_all_default
logical function, public f_all_default(var_array)
Check if ALL elements of a real(wp) array are of default value.
Definition m_helper_basic.fpp.f90:488
m_helper_basic::f_is_integer
logical elemental function, public f_is_integer(var)
Check if a real(wp) variable is an integer.
Definition m_helper_basic.fpp.f90:497
m_helper_basic::f_approx_in_array
logical function, public f_approx_in_array(a, b, tol_input)
Check if a wp value approximately matches any element of an array within tolerance.
Definition m_helper_basic.fpp.f90:417
m_helper_basic::f_approx_equal
logical elemental function, public f_approx_equal(a, b, tol_input)
Check if two floating point numbers of wp are within tolerance.
Definition m_helper_basic.fpp.f90:373
m_helper_basic::s_update_cell_bounds
elemental subroutine, public s_update_cell_bounds(bounds, m, n, p)
Update the min and max number of cells in each set of axes.
Definition m_helper_basic.fpp.f90:572
m_helper_basic::f_is_default
logical elemental function, public f_is_default(var)
Check if a real(wp) variable is of default value.
Definition m_helper_basic.fpp.f90:463
m_precision_select
Working-precision kind selection (half/single/double) and corresponding MPI datatype parameters.
Definition m_precision_select.f90:5
m_precision_select::wp
integer, parameter wp
Change to single_precision if needed.
Definition m_precision_select.f90:25
m_precision_select::single_precision
integer, parameter single_precision
Definition m_precision_select.f90:17