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