MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_acoustic_src.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
2!>
3!! @file
4!! @brief Contains module m_acoustic_src
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/simulation/m_acoustic_src.fpp" 2
354
355!> @brief One-way acoustic source injection, Maeda and Colonius JCP (2017)
356module m_acoustic_src
357
358 use m_derived_types
359 use m_global_parameters
360 use m_bubbles
361 use m_variables_conversion
362 use m_eos
363 use m_helper_basic
364 use m_constants
365
366 implicit none
367
368 private; public :: s_initialize_acoustic_src, s_precalculate_acoustic_spatial_sources, s_acoustic_src_calculations
369
370 integer, allocatable, dimension(:) :: pulse, support
371
372# 23 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
373#if defined(MFC_OpenACC)
374# 23 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
375!$acc declare create(pulse, support)
376# 23 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
377#elif defined(MFC_OpenMP)
378# 23 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
379!$omp declare target (pulse, support)
380# 23 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
381#endif
382# 24 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
383
384 logical, allocatable, dimension(:) :: dipole
385
386# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
387#if defined(MFC_OpenACC)
388# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
389!$acc declare create(dipole)
390# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
391#elif defined(MFC_OpenMP)
392# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
393!$omp declare target (dipole)
394# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
395#endif
396# 27 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
397
398 real(wp), allocatable, target, dimension(:,:) :: loc_acoustic
399
400# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
401#if defined(MFC_OpenACC)
402# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
403!$acc declare create(loc_acoustic)
404# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
405#elif defined(MFC_OpenMP)
406# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
407!$omp declare target (loc_acoustic)
408# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
409#endif
410# 30 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
411
412 real(wp), allocatable, dimension(:) :: mag, length, height, wavelength, frequency
413 real(wp), allocatable, dimension(:) :: gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay
414
415# 33 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
416#if defined(MFC_OpenACC)
417# 33 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
418!$acc declare create(mag, length, height, wavelength, frequency)
419# 33 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
420#elif defined(MFC_OpenMP)
421# 33 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
422!$omp declare target (mag, length, height, wavelength, frequency)
423# 33 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
424#endif
425# 34 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
426
427# 34 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
428#if defined(MFC_OpenACC)
429# 34 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
430!$acc declare create(gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay)
431# 34 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
432#elif defined(MFC_OpenMP)
433# 34 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
434!$omp declare target (gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay)
435# 34 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
436#endif
437# 35 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
438
439 real(wp), allocatable, dimension(:) :: foc_length, aperture
440
441# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
442#if defined(MFC_OpenACC)
443# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
444!$acc declare create(foc_length, aperture)
445# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
446#elif defined(MFC_OpenMP)
447# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
448!$omp declare target (foc_length, aperture)
449# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
450#endif
451# 38 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
452
453 real(wp), allocatable, dimension(:) :: element_spacing_angle, element_polygon_ratio, rotate_angle
454
455# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
456#if defined(MFC_OpenACC)
457# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
458!$acc declare create(element_spacing_angle, element_polygon_ratio, rotate_angle)
459# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
460#elif defined(MFC_OpenMP)
461# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
462!$omp declare target (element_spacing_angle, element_polygon_ratio, rotate_angle)
463# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
464#endif
465# 41 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
466
467 real(wp), allocatable, dimension(:) :: bb_bandwidth, bb_lowest_freq
468
469# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
470#if defined(MFC_OpenACC)
471# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
472!$acc declare create(bb_bandwidth, bb_lowest_freq)
473# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
474#elif defined(MFC_OpenMP)
475# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
476!$omp declare target (bb_bandwidth, bb_lowest_freq)
477# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
478#endif
479# 44 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
480
481 integer, allocatable, dimension(:) :: num_elements, element_on, bb_num_freq
482
483# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
484#if defined(MFC_OpenACC)
485# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
486!$acc declare create(num_elements, element_on, bb_num_freq)
487# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
488#elif defined(MFC_OpenMP)
489# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
490!$omp declare target (num_elements, element_on, bb_num_freq)
491# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
492#endif
493# 47 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
494
495 !> @name Acoustic source terms
496 !> @{
497 real(wp), allocatable, dimension(:,:,:) :: mass_src, e_src
498 real(wp), allocatable, dimension(:,:,:,:) :: mom_src
499 !> @}
500
501# 53 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
502#if defined(MFC_OpenACC)
503# 53 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
504!$acc declare create(mass_src, e_src, mom_src)
505# 53 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
506#elif defined(MFC_OpenMP)
507# 53 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
508!$omp declare target (mass_src, e_src, mom_src)
509# 53 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
510#endif
511# 54 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
512
513 integer, dimension(:), allocatable :: source_spatials_num_points !< Number of non-zero source grid points for each source
514
515# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
516#if defined(MFC_OpenACC)
517# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
518!$acc declare create(source_spatials_num_points)
519# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
520#elif defined(MFC_OpenMP)
521# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
522!$omp declare target (source_spatials_num_points)
523# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
524#endif
525# 57 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
526
527 type(source_spatial_type), dimension(:), allocatable :: source_spatials !< Data of non-zero source grid points for each source
528
529# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
530#if defined(MFC_OpenACC)
531# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
532!$acc declare create(source_spatials)
533# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
534#elif defined(MFC_OpenMP)
535# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
536!$omp declare target (source_spatials)
537# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
538#endif
539# 60 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
540
541contains
542
543 !> Initialize the acoustic source module
544 impure subroutine s_initialize_acoustic_src
545
546 integer :: i, j !< generic loop variables
547
548#ifdef MFC_DEBUG
549# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
550 block
551# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
552 use iso_fortran_env, only: output_unit
553# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
554
555# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
556 print *, 'm_acoustic_src.fpp:68: ', '@:ALLOCATE(loc_acoustic(1:3, 1:num_source), mag(1:num_source), dipole(1:num_source), support(1:num_source), length(1:num_source), height(1:num_source), wavelength(1:num_source), frequency(1:num_source), gauss_sigma_dist(1:num_source), gauss_sigma_time(1:num_source), foc_length(1:num_source), aperture(1:num_source), npulse(1:num_source), pulse(1:num_source), dir(1:num_source), delay(1:num_source), element_polygon_ratio(1:num_source), rotate_angle(1:num_source), element_spacing_angle(1:num_source), num_elements(1:num_source), element_on(1:num_source), bb_num_freq(1:num_source), bb_bandwidth(1:num_source), bb_lowest_freq(1:num_source))'
557# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
558
559# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
560 call flush (output_unit)
561# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
562 end block
563# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
564#endif
565# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
566 allocate (loc_acoustic(1:3, 1:num_source), mag(1:num_source), dipole(1:num_source), support(1:num_source), length(1:num_source), height(1:num_source), wavelength(1:num_source), frequency(1:num_source), gauss_sigma_dist(1:num_source), gauss_sigma_time(1:num_source), foc_length(1:num_source), aperture(1:num_source), npulse(1:num_source), pulse(1:num_source), dir(1:num_source), delay(1:num_source), element_polygon_ratio(1:num_source), rotate_angle(1:num_source), element_spacing_angle(1:num_source), num_elements(1:num_source), element_on(1:num_source), bb_num_freq(1:num_source), bb_bandwidth(1:num_source), bb_lowest_freq(1:num_source))
567# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
568
569# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
570
571# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
572
573# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
574
575# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
576
577# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
578
579# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
580
581# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
582
583# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
584
585# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
586
587# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
588
589# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
590
591# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
592
593# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
594
595# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
596
597# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
598
599# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
600
601# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
602
603# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
604
605# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
606
607# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
608
609# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
610
611# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
612
613# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
614
615# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
616
617# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
618#if defined(MFC_OpenACC)
619# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
620!$acc enter data create(loc_acoustic, mag, dipole, support, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, foc_length, aperture, npulse, pulse, dir, delay, element_polygon_ratio, rotate_angle, element_spacing_angle, num_elements, element_on, bb_num_freq, bb_bandwidth, bb_lowest_freq)
621# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
622#elif defined(MFC_OpenMP)
623# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
624!$omp target enter data map(always,alloc:loc_acoustic, mag, dipole, support, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, foc_length, aperture, npulse, pulse, dir, delay, element_polygon_ratio, rotate_angle, element_spacing_angle, num_elements, element_on, bb_num_freq, bb_bandwidth, bb_lowest_freq)
625# 68 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
626#endif
627# 74 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
628
629 do i = 1, num_source
630 do j = 1, 3
631 loc_acoustic(j, i) = acoustic(i)%loc(j)
632 end do
633 mag(i) = acoustic(i)%mag
634 dipole(i) = acoustic(i)%dipole
635 support(i) = acoustic(i)%support
636 length(i) = acoustic(i)%length
637 height(i) = acoustic(i)%height
638 wavelength(i) = acoustic(i)%wavelength
639 frequency(i) = acoustic(i)%frequency
640 gauss_sigma_dist(i) = acoustic(i)%gauss_sigma_dist
641 gauss_sigma_time(i) = acoustic(i)%gauss_sigma_time
642 foc_length(i) = acoustic(i)%foc_length
643 aperture(i) = acoustic(i)%aperture
644 npulse(i) = acoustic(i)%npulse
645 pulse(i) = acoustic(i)%pulse
646 dir(i) = acoustic(i)%dir
647 element_spacing_angle(i) = acoustic(i)%element_spacing_angle
648 element_polygon_ratio(i) = acoustic(i)%element_polygon_ratio
649 num_elements(i) = acoustic(i)%num_elements
650 bb_num_freq(i) = acoustic(i)%bb_num_freq
651 bb_bandwidth(i) = acoustic(i)%bb_bandwidth
652 bb_lowest_freq(i) = acoustic(i)%bb_lowest_freq
653
654 if (acoustic(i)%element_on == dflt_int) then
655 element_on(i) = 0
656 else
657 element_on(i) = acoustic(i)%element_on
658 end if
659 if (f_is_default(acoustic(i)%rotate_angle)) then
660 rotate_angle(i) = 0._wp
661 else
662 rotate_angle(i) = acoustic(i)%rotate_angle
663 end if
664 if (f_is_default(acoustic(i)%delay)) then ! m_checker guarantees acoustic(i)%delay is set for pulse = 2 (Gaussian)
665 delay(i) = 0._wp ! Defaults to zero for sine and square waves
666 else
667 delay(i) = acoustic(i)%delay
668 end if
669 end do
670
671# 116 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
672#if defined(MFC_OpenACC)
673# 116 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
674!$acc update device(loc_acoustic, mag, dipole, support, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, foc_length, aperture, npulse, pulse, dir, delay, element_polygon_ratio, rotate_angle, element_spacing_angle, num_elements, element_on, bb_num_freq, bb_bandwidth, bb_lowest_freq)
675# 116 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
676#elif defined(MFC_OpenMP)
677# 116 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
678!$omp target update to(loc_acoustic, mag, dipole, support, length, height, wavelength, frequency, gauss_sigma_dist, gauss_sigma_time, foc_length, aperture, npulse, pulse, dir, delay, element_polygon_ratio, rotate_angle, element_spacing_angle, num_elements, element_on, bb_num_freq, bb_bandwidth, bb_lowest_freq)
679# 116 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
680#endif
681# 119 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
682
683#ifdef MFC_DEBUG
684# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
685 block
686# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
687 use iso_fortran_env, only: output_unit
688# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
689
690# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
691 print *, 'm_acoustic_src.fpp:120: ', '@:ALLOCATE(mass_src(0:m, 0:n, 0:p))'
692# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
693
694# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
695 call flush (output_unit)
696# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
697 end block
698# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
699#endif
700# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
701 allocate (mass_src(0:m, 0:n, 0:p))
702# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
703
704# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
705
706# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
707#if defined(MFC_OpenACC)
708# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
709!$acc enter data create(mass_src)
710# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
711#elif defined(MFC_OpenMP)
712# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
713!$omp target enter data map(always,alloc:mass_src)
714# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
715#endif
716# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
717#ifdef MFC_DEBUG
718# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
719 block
720# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
721 use iso_fortran_env, only: output_unit
722# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
723
724# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
725 print *, 'm_acoustic_src.fpp:121: ', '@:ALLOCATE(mom_src(1:num_vels, 0:m, 0:n, 0:p))'
726# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
727
728# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
729 call flush (output_unit)
730# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
731 end block
732# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
733#endif
734# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
735 allocate (mom_src(1:num_vels, 0:m, 0:n, 0:p))
736# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
737
738# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
739
740# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
741#if defined(MFC_OpenACC)
742# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
743!$acc enter data create(mom_src)
744# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
745#elif defined(MFC_OpenMP)
746# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
747!$omp target enter data map(always,alloc:mom_src)
748# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
749#endif
750# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
751#ifdef MFC_DEBUG
752# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
753 block
754# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
755 use iso_fortran_env, only: output_unit
756# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
757
758# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
759 print *, 'm_acoustic_src.fpp:122: ', '@:ALLOCATE(E_src(0:m, 0:n, 0:p))'
760# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
761
762# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
763 call flush (output_unit)
764# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
765 end block
766# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
767#endif
768# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
769 allocate (e_src(0:m, 0:n, 0:p))
770# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
771
772# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
773
774# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
775#if defined(MFC_OpenACC)
776# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
777!$acc enter data create(E_src)
778# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
779#elif defined(MFC_OpenMP)
780# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
781!$omp target enter data map(always,alloc:E_src)
782# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
783#endif
784# 123 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
785
786 end subroutine s_initialize_acoustic_src
787
788 !> Compute mass, momentum, and energy acoustic source terms and add to the RHS
789 impure subroutine s_acoustic_src_calculations(q_cons_vf, q_prim_vf, rhs_vf)
790
791 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf !< Conservative variables
792 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf !< Primitive variables
793 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
794
795# 136 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
796 real(wp), dimension(num_fluids) :: myalpha, myalpha_rho
797# 138 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
798 real(wp) :: myrho, pi_inf_mix, qv_dummy
799 real(wp) :: sim_time, c, gamma_mix
800 real(wp) :: blkmod_q, pres_q, alpha_q, alpha_rho_q
801 real(wp) :: frequency_local, gauss_sigma_time_local
802 real(wp) :: mass_src_diff, mom_src_diff
803 real(wp) :: source_temporal
804 real(wp) :: period_bb !< period of each sine wave in broadband source
805 real(wp) :: sl_bb !< spectral level at each frequency
806 real(wp) :: ffre_bb !< source term corresponding to each frequency
807 real(wp) :: sum_bb !< total source term for the broadband wave
808 real(wp), allocatable, dimension(:) :: phi_rn !< random phase shift for each frequency
809 integer :: i, j, k, l, q !< generic loop variables
810 integer :: ai !< acoustic source index
811 integer :: num_points
812 logical :: freq_conv_flag, gauss_conv_flag
813 integer, parameter :: mass_label = 1, mom_label = 2
814
815 sim_time = mytime ! Accumulated time, correct under adaptive dt
816
817
818# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
819
820# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
821#if defined(MFC_OpenACC)
822# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
823!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
824# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
825#elif defined(MFC_OpenMP)
826# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
827
828# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
829
830# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
831
832# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
833!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l)
834# 157 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
835#endif
836# 158 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
837 do l = 0, p
838 do k = 0, n
839 do j = 0, m
840 mass_src(j, k, l) = 0._wp
841 mom_src(1, j, k, l) = 0._wp
842 e_src(j, k, l) = 0._wp
843 if (n > 0) mom_src(2, j, k, l) = 0._wp
844 if (p > 0) mom_src(3, j, k, l) = 0._wp
845 end do
846 end do
847 end do
848
849# 169 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
850#if defined(MFC_OpenACC)
851# 169 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
852!$acc end parallel loop
853# 169 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
854#elif defined(MFC_OpenMP)
855# 169 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
856
857# 169 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
858!$omp end target teams loop
859# 169 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
860#endif
861# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
862
863 ! Keep outer loop sequential because different sources can have very different number of points
864 do ai = 1, num_source
865 ! Skip if the pulse has not started yet for sine and square waves
866 if (.not. (sim_time < delay(ai) .and. (pulse(ai) == 1 .or. pulse(ai) == 3))) then
867 ! Decide if frequency need to be converted from wavelength
868 freq_conv_flag = f_is_default(frequency(ai))
869 gauss_conv_flag = f_is_default(gauss_sigma_time(ai))
870
871 num_points = source_spatials_num_points(ai) ! Use scalar to force firstprivate to prevent GPU bug
872
873 ! Calculate the broadband source
874 period_bb = 0._wp
875 sl_bb = 0._wp
876 ffre_bb = 0._wp
877 sum_bb = 0._wp
878
879 ! Allocate buffers for random phase shift
880 allocate (phi_rn(1:bb_num_freq(ai)))
881 phi_rn(1:bb_num_freq(ai)) = 0._wp
882
883 if (pulse(ai) == 4) then
884 call random_number(phi_rn(1:bb_num_freq(ai)))
885 ! Ensure all the ranks have the same random phase shift
886 call s_mpi_send_random_number(phi_rn, bb_num_freq(ai))
887 end if
888
889 do k = 1, bb_num_freq(ai)
890 ! Acoustic period of the wave at each discrete frequency
891 period_bb = 1._wp/(bb_lowest_freq(ai) + k*bb_bandwidth(ai))
892 ! Spectral level at each frequency
893 sl_bb = broadband_spectral_level_constant*mag(ai) + k*mag(ai)/broadband_spectral_level_growth_rate
894 ! Source term corresponding to each frequencies
895 ffre_bb = sqrt((2._wp*sl_bb*bb_bandwidth(ai)))*cos((sim_time)*2._wp*pi/period_bb + 2._wp*pi*phi_rn(k))
896 ! Sum up the source term of each frequency to obtain the total source term for broadband wave
897 sum_bb = sum_bb + ffre_bb
898 end do
899
900 deallocate (phi_rn)
901
902
903# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
904
905# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
906#if defined(MFC_OpenACC)
907# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
908!$acc parallel loop gang vector default(present) private(myalpha, myalpha_rho, myRho, pi_inf_mix, qv_dummy, c, blkmod_q, pres_q, alpha_q, alpha_rho_q, gamma_mix, frequency_local, &
909# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
910!$acc& gauss_sigma_time_local, mass_src_diff, mom_src_diff, source_temporal, j, k, l, q) copyin(sum_BB, freq_conv_flag, gauss_conv_flag, sim_time)
911# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
912#elif defined(MFC_OpenMP)
913# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
914
915# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
916
917# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
918
919# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
920!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(myalpha, myalpha_rho, myRho, &
921# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
922!$omp& pi_inf_mix, qv_dummy, c, blkmod_q, pres_q, alpha_q, alpha_rho_q, gamma_mix, frequency_local, gauss_sigma_time_local, mass_src_diff, mom_src_diff, source_temporal, j, k, l, q) &
923# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
924!$omp& map(to:sum_BB, freq_conv_flag, gauss_conv_flag, sim_time)
925# 210 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
926#endif
927# 214 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
928 do i = 1, num_points
929 j = source_spatials(ai)%coord(1, i)
930 k = source_spatials(ai)%coord(2, i)
931 l = source_spatials(ai)%coord(3, i)
932
933 ! Compute speed of sound
934
935# 220 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
936#if defined(MFC_OpenACC)
937# 220 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
938!$acc loop seq
939# 220 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
940#elif defined(MFC_OpenMP)
941# 220 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
942
943# 220 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
944#endif
945# 221 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
946 do q = 1, num_fluids
947 myalpha_rho(q) = q_cons_vf(q)%sf(j, k, l)
948 myalpha(q) = q_cons_vf(eqn_idx%adv%beg + q - 1)%sf(j, k, l)
949 end do
950
951 call s_compute_mixture_coefficients(myalpha_rho, myalpha, myrho, gamma_mix, pi_inf_mix, qv_dummy)
952
953 ! Mixture sound speed, as s_compute_speed_of_sound computes it. Inlined because that
954 ! call faults CCE OpenACC from this loop (#1794); fold it back once that is isolated.
955 if (any_state_dependent_eos) then ! frozen mixing of per-phase moduli, as in s_compute_speed_of_sound
956 c = 0._wp
957
958# 232 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
959#if defined(MFC_OpenACC)
960# 232 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
961!$acc loop seq
962# 232 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
963#elif defined(MFC_OpenMP)
964# 232 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
965
966# 232 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
967#endif
968# 233 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
969 do q = 1, num_fluids
970 pres_q = q_prim_vf(eqn_idx%E)%sf(j, k, l)
971 alpha_q = myalpha(q)
972 alpha_rho_q = myalpha_rho(q)
973 call s_phase_bulk_modulus(pres_q, alpha_q, alpha_rho_q, q, blkmod_q)
974 c = c + myalpha(q)*blkmod_q
975 end do
976 c = c/myrho
977 else
978 c = f_bulk_modulus(q_prim_vf(eqn_idx%E)%sf(j, k, l), gamma_mix, pi_inf_mix)/myrho
979 end if
980 if (model_eqns == model_eqns_5eq .and. bubbles_euler .and. .not. (mpp_lim .and. num_fluids > 1)) then
981 c = c/(1._wp - myalpha(num_fluids))
982 end if
983 c = sqrt(c)
984
985 ! Wavelength to frequency conversion
986 if (pulse(ai) == 1 .or. pulse(ai) == 3) frequency_local = f_frequency_local(freq_conv_flag, ai, c)
987 if (pulse(ai) == 2) gauss_sigma_time_local = f_gauss_sigma_time_local(gauss_conv_flag, ai, c)
988
989 ! Update momentum source term
990 call s_source_temporal(sim_time, c, ai, mom_label, frequency_local, gauss_sigma_time_local, source_temporal, &
991 & sum_bb)
992 mom_src_diff = source_temporal*source_spatials(ai)%val(i)
993
994 if (dipole(ai)) then ! Double amplitude & No momentum source term (only works for Planar)
995 mass_src(j, k, l) = mass_src(j, k, l) + 2._wp*mom_src_diff/c
996 e_src(j, k, l) = e_src(j, k, l) + 2._wp*mom_src_diff*c*gamma_mix
997 cycle
998 end if
999
1000 if (n == 0) then ! 1D
1001 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*sign(1._wp, dir(ai)) ! Left or right-going wave
1002 else if (p == 0) then ! 2D
1003 if (support(ai) < 5) then ! Planar
1004 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*cos(dir(ai))
1005 mom_src(2, j, k, l) = mom_src(2, j, k, l) + mom_src_diff*sin(dir(ai))
1006 else
1007 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*cos(source_spatials(ai)%angle(i))
1008 mom_src(2, j, k, l) = mom_src(2, j, k, l) + mom_src_diff*sin(source_spatials(ai)%angle(i))
1009 end if
1010 else ! 3D
1011 if (support(ai) < 5) then ! Planar
1012 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*cos(dir(ai))
1013 mom_src(2, j, k, l) = mom_src(2, j, k, l) + mom_src_diff*sin(dir(ai))
1014 else
1015 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*source_spatials(ai)%xyz_to_r_ratios(1, i)
1016 mom_src(2, j, k, l) = mom_src(2, j, k, l) + mom_src_diff*source_spatials(ai)%xyz_to_r_ratios(2, i)
1017 mom_src(3, j, k, l) = mom_src(3, j, k, l) + mom_src_diff*source_spatials(ai)%xyz_to_r_ratios(3, i)
1018 end if
1019 end if
1020
1021 ! Update mass source term
1022 if (support(ai) < 5) then ! Planar
1023 mass_src_diff = mom_src_diff/c
1024 else ! Spherical or cylindrical support
1025 ! Mass source term must be calculated differently using a correction term for spherical and cylindrical
1026 ! support
1027 call s_source_temporal(sim_time, c, ai, mass_label, frequency_local, gauss_sigma_time_local, &
1028 & source_temporal, sum_bb)
1029 mass_src_diff = source_temporal*source_spatials(ai)%val(i)
1030 end if
1031 mass_src(j, k, l) = mass_src(j, k, l) + mass_src_diff
1032
1033 ! Update energy source term
1034 e_src(j, k, l) = e_src(j, k, l) + mass_src_diff*c**2._wp*gamma_mix
1035 end do
1036
1037# 300 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1038#if defined(MFC_OpenACC)
1039# 300 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1040!$acc end parallel loop
1041# 300 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1042#elif defined(MFC_OpenMP)
1043# 300 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1044
1045# 300 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1046!$omp end target teams loop
1047# 300 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1048#endif
1049# 301 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1050 end if
1051 end do
1052
1053 ! Update the rhs variables
1054
1055# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1056
1057# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1058#if defined(MFC_OpenACC)
1059# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1060!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
1061# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1062#elif defined(MFC_OpenMP)
1063# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1064
1065# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1066
1067# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1068
1069# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1070!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(j, k, l)
1071# 305 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1072#endif
1073# 306 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1074 do l = 0, p
1075 do k = 0, n
1076 do j = 0, m
1077
1078# 309 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1079#if defined(MFC_OpenACC)
1080# 309 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1081!$acc loop seq
1082# 309 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1083#elif defined(MFC_OpenMP)
1084# 309 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1085
1086# 309 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1087#endif
1088# 310 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1089 do q = eqn_idx%cont%beg, eqn_idx%cont%end
1090 rhs_vf(q)%sf(j, k, l) = rhs_vf(q)%sf(j, k, l) + mass_src(j, k, l)
1091 end do
1092
1093# 313 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1094#if defined(MFC_OpenACC)
1095# 313 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1096!$acc loop seq
1097# 313 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1098#elif defined(MFC_OpenMP)
1099# 313 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1100
1101# 313 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1102#endif
1103# 314 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1104 do q = eqn_idx%mom%beg, eqn_idx%mom%end
1105 rhs_vf(q)%sf(j, k, l) = rhs_vf(q)%sf(j, k, l) + mom_src(q - eqn_idx%cont%end, j, k, l)
1106 end do
1107 rhs_vf(eqn_idx%E)%sf(j, k, l) = rhs_vf(eqn_idx%E)%sf(j, k, l) + e_src(j, k, l)
1108 end do
1109 end do
1110 end do
1111
1112# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1113#if defined(MFC_OpenACC)
1114# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1115!$acc end parallel loop
1116# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1117#elif defined(MFC_OpenMP)
1118# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1119
1120# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1121!$omp end target teams loop
1122# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1123#endif
1124# 322 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1125
1126 end subroutine s_acoustic_src_calculations
1127
1128 !> Compute the temporally varying amplitude of the pulse
1129 elemental subroutine s_source_temporal(sim_time, c, ai, term_index, frequency_local, gauss_sigma_time_local, source, sum_BB)
1130
1131
1132# 328 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1133#if MFC_OpenACC
1134# 328 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1135!$acc routine seq
1136# 328 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1137#elif MFC_OpenMP
1138# 328 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1139
1140# 328 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1141
1142# 328 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1143!$omp declare target device_type(any)
1144# 328 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1145#endif
1146# 329 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1147 integer, intent(in) :: ai, term_index
1148 real(wp), intent(in) :: sim_time, c, sum_bb
1149 real(wp), intent(in) :: frequency_local, gauss_sigma_time_local
1150 real(wp), intent(out) :: source
1151 real(wp) :: omega !< angular frequency
1152 real(wp) :: sine_wave !< sine function for square wave
1153 real(wp) :: foc_length_factor !< Scale amplitude with radius for spherical support
1154 ! i.e. Spherical support -> 1/r scaling; Cylindrical support -> 1/sqrt(r) [empirical correction: ^-0.5 -> ^-0.85]
1155 integer, parameter :: mass_label = 1
1156
1157 ! An unfocused source leaves foc_length at its unset default (dflt_real < 0, or 0): apply no
1158 ! radial amplitude scaling. This guards every branch against the silent-corruption the default
1159 ! would otherwise cause - foc_length(ai)**(-0.85) = pow(negative, non-integer) = NaN on some
1160 ! compilers (e.g. nvhpc <= 24.3) in 2D, and 1/foc_length = wrong-sign or Inf in 3D/cylindrical.
1161 if (n == 0 .or. foc_length(ai) <= 0._wp) then
1162 foc_length_factor = 1._wp
1163 else if (p == 0 .and. (.not. cyl_coord)) then ! 2D Cartesian: cylindrical (line-source) spreading
1164 foc_length_factor = foc_length(ai)**(-0.85_wp) ! Empirical correction to 1/sqrt(r)
1165 else ! 3D or axisymmetric: spherical spreading
1166 foc_length_factor = 1._wp/foc_length(ai)
1167 end if
1168
1169 source = 0._wp
1170
1171 ! Temporal waveform: sine, Gaussian pulse, square wave, or broadband
1172 if (pulse(ai) == 1) then ! Sine wave
1173 if ((sim_time - delay(ai))*frequency_local > npulse(ai)) return
1174
1175 omega = 2._wp*pi*frequency_local
1176 source = mag(ai)*sin((sim_time - delay(ai))*omega)
1177
1178 if (term_index == mass_label) then
1179 source = source/c + foc_length_factor*mag(ai)*(cos((sim_time - delay(ai))*omega) - 1._wp)/omega
1180 end if
1181 else if (pulse(ai) == 2) then ! Gaussian pulse
1182 source = mag(ai)*exp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp))
1183
1184 if (term_index == mass_label) then
1185 source = source/c - foc_length_factor*mag(ai)*sqrt(pi/2)*gauss_sigma_time_local*(erf((sim_time - delay(ai)) &
1186 & /(sqrt(2._wp)*gauss_sigma_time_local)) + 1)
1187 end if
1188 else if (pulse(ai) == 3) then ! Square wave
1189 if ((sim_time - delay(ai))*frequency_local > npulse(ai)) return
1190
1191 omega = 2._wp*pi*frequency_local
1192 sine_wave = sin((sim_time - delay(ai))*omega)
1193 source = mag(ai)*sign(1._wp, sine_wave)
1194
1195 ! Prevent max-norm differences due to compilers to pass CI
1196 if (abs(sine_wave) < 1.e-2_wp) then
1197 source = mag(ai)*sine_wave*1.e2_wp
1198 end if
1199 else if (pulse(ai) == 4) then ! Broadband wave
1200 source = sum_bb
1201 end if
1202
1203 end subroutine s_source_temporal
1204
1205 !> Pre-compute non-zero spatial source weights before time-stepping
1206 impure subroutine s_precalculate_acoustic_spatial_sources
1207
1208 integer :: j, k, l, ai
1209 integer :: count
1210 integer :: dim
1211 real(wp) :: source_spatial, angle, xyz_to_r_ratios(3)
1212 real(wp), parameter :: threshold = 1.e-10_wp
1213
1214 if (n == 0) then
1215 dim = 1
1216 else if (p == 0) then
1217 dim = 2
1218 else
1219 dim = 3
1220 end if
1221
1222#ifdef MFC_DEBUG
1223# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1224 block
1225# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1226 use iso_fortran_env, only: output_unit
1227# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1228
1229# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1230 print *, 'm_acoustic_src.fpp:404: ', '@:ALLOCATE(source_spatials_num_points(1:num_source))'
1231# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1232
1233# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1234 call flush (output_unit)
1235# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1236 end block
1237# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1238#endif
1239# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1240 allocate (source_spatials_num_points(1:num_source))
1241# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1242
1243# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1244
1245# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1246#if defined(MFC_OpenACC)
1247# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1248!$acc enter data create(source_spatials_num_points)
1249# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1250#elif defined(MFC_OpenMP)
1251# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1252!$omp target enter data map(always,alloc:source_spatials_num_points)
1253# 404 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1254#endif
1255# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1256#ifdef MFC_DEBUG
1257# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1258 block
1259# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1260 use iso_fortran_env, only: output_unit
1261# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1262
1263# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1264 print *, 'm_acoustic_src.fpp:405: ', '@:ALLOCATE(source_spatials(1:num_source))'
1265# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1266
1267# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1268 call flush (output_unit)
1269# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1270 end block
1271# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1272#endif
1273# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1274 allocate (source_spatials(1:num_source))
1275# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1276
1277# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1278
1279# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1280#if defined(MFC_OpenACC)
1281# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1282!$acc enter data create(source_spatials)
1283# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1284#elif defined(MFC_OpenMP)
1285# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1286!$omp target enter data map(always,alloc:source_spatials)
1287# 405 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1288#endif
1289# 406 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1290
1291 do ai = 1, num_source
1292 ! First pass: Count the number of points for each source
1293 count = 0
1294 do l = 0, p
1295 do k = 0, n
1296 do j = 0, m
1297 call s_source_spatial(j, k, l, loc_acoustic(:,ai), ai, source_spatial, angle, xyz_to_r_ratios)
1298 if (abs(source_spatial) < threshold) cycle
1299 count = count + 1
1300 end do
1301 end do
1302 end do
1303 source_spatials_num_points(ai) = count
1304
1305 ! Allocate arrays with the correct size
1306
1307#ifdef MFC_DEBUG
1308# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1309 block
1310# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1311 use iso_fortran_env, only: output_unit
1312# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1313
1314# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1315 print *, 'm_acoustic_src.fpp:423: ', '@:ALLOCATE(source_spatials(ai)%coord(1:3, 1:count))'
1316# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1317
1318# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1319 call flush (output_unit)
1320# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1321 end block
1322# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1323#endif
1324# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1325 allocate (source_spatials(ai)%coord(1:3, 1:count))
1326# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1327
1328# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1329
1330# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1331#if defined(MFC_OpenACC)
1332# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1333!$acc enter data create(source_spatials(ai)%coord)
1334# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1335#elif defined(MFC_OpenMP)
1336# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1337!$omp target enter data map(always,alloc:source_spatials(ai)%coord)
1338# 423 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1339#endif
1340# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1341#ifdef MFC_DEBUG
1342# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1343 block
1344# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1345 use iso_fortran_env, only: output_unit
1346# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1347
1348# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1349 print *, 'm_acoustic_src.fpp:424: ', '@:ALLOCATE(source_spatials(ai)%val(1:count))'
1350# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1351
1352# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1353 call flush (output_unit)
1354# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1355 end block
1356# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1357#endif
1358# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1359 allocate (source_spatials(ai)%val(1:count))
1360# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1361
1362# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1363
1364# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1365#if defined(MFC_OpenACC)
1366# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1367!$acc enter data create(source_spatials(ai)%val)
1368# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1369#elif defined(MFC_OpenMP)
1370# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1371!$omp target enter data map(always,alloc:source_spatials(ai)%val)
1372# 424 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1373#endif
1374# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1375#ifdef MFC_DEBUG
1376# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1377 block
1378# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1379 use iso_fortran_env, only: output_unit
1380# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1381
1382# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1383 print *, 'm_acoustic_src.fpp:425: ', '@:ALLOCATE(source_spatials(ai)%angle(1:count))'
1384# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1385
1386# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1387 call flush (output_unit)
1388# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1389 end block
1390# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1391#endif
1392# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1393 allocate (source_spatials(ai)%angle(1:count))
1394# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1395
1396# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1397
1398# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1399#if defined(MFC_OpenACC)
1400# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1401!$acc enter data create(source_spatials(ai)%angle)
1402# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1403#elif defined(MFC_OpenMP)
1404# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1405!$omp target enter data map(always,alloc:source_spatials(ai)%angle)
1406# 425 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1407#endif
1408# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1409#ifdef MFC_DEBUG
1410# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1411 block
1412# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1413 use iso_fortran_env, only: output_unit
1414# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1415
1416# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1417 print *, 'm_acoustic_src.fpp:426: ', '@:ALLOCATE(source_spatials(ai)%xyz_to_r_ratios(1:3, 1:count))'
1418# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1419
1420# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1421 call flush (output_unit)
1422# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1423 end block
1424# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1425#endif
1426# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1427 allocate (source_spatials(ai)%xyz_to_r_ratios(1:3, 1:count))
1428# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1429
1430# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1431
1432# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1433#if defined(MFC_OpenACC)
1434# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1435!$acc enter data create(source_spatials(ai)%xyz_to_r_ratios)
1436# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1437#elif defined(MFC_OpenMP)
1438# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1439!$omp target enter data map(always,alloc:source_spatials(ai)%xyz_to_r_ratios)
1440# 426 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1441#endif
1442# 427 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1443
1444#ifdef _CRAYFTN
1445# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1446 block
1447# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1448#ifdef MFC_DEBUG
1449# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1450 block
1451# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1452 use iso_fortran_env, only: output_unit
1453# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1454
1455# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1456 print *, 'm_acoustic_src.fpp:428: ', '@:ACC_SETUP_source_spatials(source_spatials(ai))'
1457# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1458
1459# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1460 call flush (output_unit)
1461# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1462 end block
1463# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1464#endif
1465# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1466
1467# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1468
1469# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1470#if defined(MFC_OpenACC)
1471# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1472!$acc enter data copyin(source_spatials(ai))
1473# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1474#elif defined(MFC_OpenMP)
1475# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1476!$omp target enter data map(to:source_spatials(ai))
1477# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1478#endif
1479# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1480 if (associated(source_spatials(ai)%coord)) then
1481# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1482
1483# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1484#if defined(MFC_OpenACC)
1485# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1486!$acc enter data copyin(source_spatials(ai)%coord)
1487# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1488#elif defined(MFC_OpenMP)
1489# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1490!$omp target enter data map(to:source_spatials(ai)%coord)
1491# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1492#endif
1493# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1494 end if
1495# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1496 if (associated(source_spatials(ai)%val)) then
1497# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1498
1499# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1500#if defined(MFC_OpenACC)
1501# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1502!$acc enter data copyin(source_spatials(ai)%val)
1503# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1504#elif defined(MFC_OpenMP)
1505# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1506!$omp target enter data map(to:source_spatials(ai)%val)
1507# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1508#endif
1509# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1510 end if
1511# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1512 if (associated(source_spatials(ai)%angle)) then
1513# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1514
1515# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1516#if defined(MFC_OpenACC)
1517# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1518!$acc enter data copyin(source_spatials(ai)%angle)
1519# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1520#elif defined(MFC_OpenMP)
1521# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1522!$omp target enter data map(to:source_spatials(ai)%angle)
1523# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1524#endif
1525# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1526 end if
1527# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1528 if (associated(source_spatials(ai)%xyz_to_r_ratios)) then
1529# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1530
1531# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1532#if defined(MFC_OpenACC)
1533# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1534!$acc enter data copyin(source_spatials(ai)%xyz_to_r_ratios)
1535# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1536#elif defined(MFC_OpenMP)
1537# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1538!$omp target enter data map(to:source_spatials(ai)%xyz_to_r_ratios)
1539# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1540#endif
1541# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1542 end if
1543# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1544 end block
1545# 428 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1546#endif
1547# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1548
1549 ! Second pass: Store the values
1550 count = 0 ! Reset counter
1551 do l = 0, p
1552 do k = 0, n
1553 do j = 0, m
1554 call s_source_spatial(j, k, l, loc_acoustic(:,ai), ai, source_spatial, angle, xyz_to_r_ratios)
1555 if (abs(source_spatial) < threshold) cycle
1556 count = count + 1
1557 source_spatials(ai)%coord(1, count) = j
1558 source_spatials(ai)%coord(2, count) = k
1559 source_spatials(ai)%coord(3, count) = l
1560 source_spatials(ai)%val(count) = source_spatial
1561 if (support(ai) >= 5) then
1562 if (dim == 2) source_spatials(ai)%angle(count) = angle
1563 if (dim == 3) source_spatials(ai)%xyz_to_r_ratios(1:3,count) = xyz_to_r_ratios
1564 end if
1565 end do
1566 end do
1567 end do
1568
1569 if (source_spatials_num_points(ai) /= count) then
1570 call s_mpi_abort('Fatal Error: Inconsistent allocation of source_spatials')
1571 end if
1572
1573 if (count > 0) then
1574
1575# 455 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1576#if defined(MFC_OpenACC)
1577# 455 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1578!$acc update device(source_spatials(ai)%coord)
1579# 455 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1580#elif defined(MFC_OpenMP)
1581# 455 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1582!$omp target update to(source_spatials(ai)%coord)
1583# 455 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1584#endif
1585# 456 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1586
1587# 456 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1588#if defined(MFC_OpenACC)
1589# 456 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1590!$acc update device(source_spatials(ai)%val)
1591# 456 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1592#elif defined(MFC_OpenMP)
1593# 456 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1594!$omp target update to(source_spatials(ai)%val)
1595# 456 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1596#endif
1597# 457 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1598 if (support(ai) >= 5) then
1599 if (dim == 2) then
1600
1601# 459 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1602#if defined(MFC_OpenACC)
1603# 459 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1604!$acc update device(source_spatials(ai)%angle)
1605# 459 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1606#elif defined(MFC_OpenMP)
1607# 459 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1608!$omp target update to(source_spatials(ai)%angle)
1609# 459 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1610#endif
1611# 460 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1612 end if
1613 if (dim == 3) then
1614
1615# 462 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1616#if defined(MFC_OpenACC)
1617# 462 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1618!$acc update device(source_spatials(ai)%xyz_to_r_ratios)
1619# 462 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1620#elif defined(MFC_OpenMP)
1621# 462 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1622!$omp target update to(source_spatials(ai)%xyz_to_r_ratios)
1623# 462 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1624#endif
1625# 463 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1626 end if
1627 end if
1628 end if
1629 end do
1630
1631#ifdef MFC_DEBUG
1632 do ai = 1, num_source
1633 write (*, '(A,I2,A,I8,A)') 'Acoustic source ', ai, ' has ', source_spatials_num_points(ai), &
1634 & ' grid points with non-zero source term'
1635 end do
1636#endif
1637
1638 end subroutine s_precalculate_acoustic_spatial_sources
1639
1640 !> Compute the spatial support of the acoustic source
1641 subroutine s_source_spatial(j, k, l, loc, ai, source, angle, xyz_to_r_ratios)
1642
1643 integer, intent(in) :: j, k, l, ai
1644 real(wp), dimension(3), intent(in) :: loc
1645 real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3)
1646 real(wp) :: sig, r(3)
1647
1648 ! Calculate sig spatial support width
1649
1650 if (n == 0) then
1651 sig = dx(j)
1652 else if (p == 0) then
1653 sig = maxval((/dx(j), dy(k)/))
1654 else
1655 sig = maxval((/dx(j), dy(k), dz(l)/))
1656 end if
1657 sig = sig*acoustic_spatial_support_width
1658
1659 ! Calculate displacement from acoustic source location
1660 r(1) = x_cc(j) - loc(1)
1661 if (n /= 0) r(2) = y_cc(k) - loc(2)
1662 if (p /= 0) r(3) = z_cc(l) - loc(3)
1663
1664 if (any(support(ai) == (/1, 2, 3, 4/))) then
1665 call s_source_spatial_planar(ai, sig, r, source)
1666 else if (any(support(ai) == (/5, 6, 7/))) then
1667 call s_source_spatial_transducer(ai, sig, r, source, angle, xyz_to_r_ratios)
1668 else if (any(support(ai) == (/9, 10, 11/))) then
1669 call s_source_spatial_transducer_array(ai, sig, r, source, angle, xyz_to_r_ratios)
1670 end if
1671
1672 end subroutine s_source_spatial
1673
1674 !> Compute the spatial support for planar acoustic sources in 1D, 2D, and 3D
1675 subroutine s_source_spatial_planar(ai, sig, r, source)
1676
1677 integer, intent(in) :: ai
1678 real(wp), intent(in) :: sig, r(3)
1679 real(wp), intent(out) :: source
1680 real(wp) :: dist
1681
1682 source = 0._wp
1683
1684 ! Gaussian spatial pulse profile: exp(-0.5 * (d / sigma)^2) / (sqrt(2*pi) * sigma)
1685 if (support(ai) == 1) then ! 1D
1686 source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp)
1687 else if (support(ai) == 2 .or. support(ai) == 3) then ! 2D or 3D
1688 ! If we let unit vector e = (cos(dir), sin(dir)),
1689 dist = r(1)*cos(dir(ai)) + r(2)*sin(dir(ai)) ! dot(r,e)
1690 ! |r - dist*e| < length/2
1691 if ((r(1) - dist*cos(dir(ai)))**2._wp + (r(2) - dist*sin(dir(ai)))**2._wp < 0.25_wp*length(ai)**2._wp) then
1692 if (support(ai) /= 3 .or. abs(r(3)) < 0.25_wp*height(ai)) then ! additional height constraint for 3D
1693 source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
1694 end if
1695 end if
1696 end if
1697
1698 end subroutine s_source_spatial_planar
1699
1700 !> Compute the spatial support for a single transducer in 2D, 2D axisymmetric, and 3D
1701 subroutine s_source_spatial_transducer(ai, sig, r, source, angle, xyz_to_r_ratios)
1702
1703 integer, intent(in) :: ai
1704 real(wp), intent(in) :: sig, r(3)
1705 real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3)
1706 real(wp) :: current_angle, angle_half_aperture, dist, norm
1707
1708 source = 0._wp ! If not affected by transducer
1709 angle = 0._wp
1710 xyz_to_r_ratios = 0._wp
1711
1712 if (support(ai) == 5 .or. support(ai) == 6) then ! 2D or 2D axisymmetric
1713 current_angle = -atan(r(2)/(foc_length(ai) - r(1)))
1714 angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
1715
1716 if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then
1717 dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
1718 source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
1719 angle = -atan(r(2)/(foc_length(ai) - r(1)))
1720 end if
1721 else if (support(ai) == 7) then ! 3D
1722 current_angle = -atan(sqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1)))
1723 angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
1724
1725 if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then
1726 dist = foc_length(ai) - sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
1727 source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
1728
1729 norm = sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
1730 xyz_to_r_ratios(1) = -(r(1) - foc_length(ai))/norm
1731 xyz_to_r_ratios(2) = -r(2)/norm
1732 xyz_to_r_ratios(3) = -r(3)/norm
1733 end if
1734 end if
1735
1736 end subroutine s_source_spatial_transducer
1737
1738 !> Compute the spatial support for multiple transducers in 2D, 2D axisymmetric, and 3D
1739 subroutine s_source_spatial_transducer_array(ai, sig, r, source, angle, xyz_to_r_ratios)
1740
1741 integer, intent(in) :: ai
1742 real(wp), intent(in) :: sig, r(3)
1743 real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3)
1744 integer :: elem, elem_min, elem_max
1745 real(wp) :: current_angle, angle_half_aperture, angle_per_elem, dist
1746 real(wp) :: angle_min, angle_max, norm
1747 real(wp) :: poly_side_length, aperture_element_3D, angle_elem
1748 real(wp) :: x2, y2, z2, x3, y3, z3, C, f, half_apert, dist_interp_to_elem_center
1749
1750 if (element_on(ai) == 0) then ! Full transducer
1751 elem_min = 1
1752 elem_max = num_elements(ai)
1753 else ! Transducer element specified
1754 elem_min = element_on(ai)
1755 elem_max = element_on(ai)
1756 end if
1757
1758 source = 0._wp ! If not affected by any transducer element
1759 angle = 0._wp
1760 xyz_to_r_ratios = 0._wp
1761
1762 if (support(ai) == 9 .or. support(ai) == 10) then ! 2D or 2D axisymmetric
1763 current_angle = -atan(r(2)/(foc_length(ai) - r(1)))
1764 angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
1765 angle_per_elem = (2._wp*angle_half_aperture - (num_elements(ai) - 1._wp)*element_spacing_angle(ai))/num_elements(ai)
1766 dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
1767
1768 do elem = elem_min, elem_max
1769 angle_max = angle_half_aperture - (element_spacing_angle(ai) + angle_per_elem)*(elem - 1._wp)
1770 angle_min = angle_max - angle_per_elem
1771
1772 if (current_angle > angle_min .and. current_angle < angle_max .and. r(1) < foc_length(ai)) then
1773 source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp)
1774 angle = current_angle
1775 exit ! Assume elements don't overlap
1776 end if
1777 end do
1778 else if (support(ai) == 11) then ! 3D
1779 poly_side_length = aperture(ai)*sin(pi/num_elements(ai))
1780 aperture_element_3d = poly_side_length*element_polygon_ratio(ai)
1781 f = foc_length(ai)
1782 half_apert = aperture(ai)/2._wp
1783
1784 do elem = elem_min, elem_max
1785 angle_elem = 2._wp*pi*real(elem, wp)/real(num_elements(ai), wp) + rotate_angle(ai)
1786
1787 ! Point 2 is the elem center
1788 x2 = f - sqrt(f**2 - half_apert**2)
1789 y2 = half_apert*cos(angle_elem)
1790 z2 = half_apert*sin(angle_elem)
1791
1792 ! Construct a plane normal to the line from the focal point to the elem center, Point 3 is the intercept of the
1793 ! plane and the line from the focal point to the current location
1794 c = f**2._wp/((r(1) - f)*(x2 - f) + r(2)*y2 + r(3)*z2) ! Constant for intermediate step
1795 x3 = c*(r(1) - f) + f
1796 y3 = c*r(2)
1797 z3 = c*r(3)
1798
1799 dist_interp_to_elem_center = sqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp)
1800 if ((dist_interp_to_elem_center < aperture_element_3d/2._wp) .and. (r(1) < f)) then
1801 dist = sqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp)
1802 source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp)
1803
1804 norm = sqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp)
1805 xyz_to_r_ratios(1) = -(r(1) - f)/norm
1806 xyz_to_r_ratios(2) = -r(2)/norm
1807 xyz_to_r_ratios(3) = -r(3)/norm
1808 end if
1809 end do
1810 end if
1811
1812 end subroutine s_source_spatial_transducer_array
1813
1814 !> Convert wavelength to frequency
1815 elemental function f_frequency_local(freq_conv_flag, ai, c)
1816
1817
1818# 654 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1819#if MFC_OpenACC
1820# 654 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1821!$acc routine seq
1822# 654 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1823#elif MFC_OpenMP
1824# 654 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1825
1826# 654 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1827
1828# 654 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1829!$omp declare target device_type(any)
1830# 654 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1831#endif
1832# 655 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1833 logical, intent(in) :: freq_conv_flag
1834 integer, intent(in) :: ai
1835 real(wp), intent(in) :: c
1836 real(wp) :: f_frequency_local
1837
1838 if (freq_conv_flag) then
1839 f_frequency_local = c/wavelength(ai)
1840 else
1841 f_frequency_local = frequency(ai)
1842 end if
1843
1844 end function f_frequency_local
1845
1846 !> Convert Gaussian sigma from distance to time
1847 function f_gauss_sigma_time_local(gauss_conv_flag, ai, c)
1848
1849
1850# 671 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1851#if MFC_OpenACC
1852# 671 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1853!$acc routine seq
1854# 671 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1855#elif MFC_OpenMP
1856# 671 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1857
1858# 671 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1859
1860# 671 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1861!$omp declare target device_type(any)
1862# 671 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1863#endif
1864# 672 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1865 logical, intent(in) :: gauss_conv_flag
1866 integer, intent(in) :: ai
1867 real(wp), intent(in) :: c
1868 real(wp) :: f_gauss_sigma_time_local
1869
1870 if (gauss_conv_flag) then
1871 f_gauss_sigma_time_local = gauss_sigma_dist(ai)/c
1872 else
1873 f_gauss_sigma_time_local = gauss_sigma_time(ai)
1874 end if
1875
1876 end function f_gauss_sigma_time_local
1877
1878end module m_acoustic_src
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1041
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1043
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1043
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1043
m_acoustic_src
One-way acoustic source injection, Maeda and Colonius JCP (2017).
Definition m_acoustic_src.fpp.f90:356
m_acoustic_src::gauss_sigma_time
real(wp), dimension(:), allocatable gauss_sigma_time
Definition m_acoustic_src.fpp.f90:413
m_acoustic_src::f_frequency_local
elemental real(wp) function f_frequency_local(freq_conv_flag, ai, c)
Convert wavelength to frequency.
Definition m_acoustic_src.fpp.f90:1816
m_acoustic_src::source_spatials
type(source_spatial_type), dimension(:), allocatable source_spatials
Data of non-zero source grid points for each source.
Definition m_acoustic_src.fpp.f90:527
m_acoustic_src::s_source_spatial_transducer
subroutine s_source_spatial_transducer(ai, sig, r, source, angle, xyz_to_r_ratios)
Compute the spatial support for a single transducer in 2D, 2D axisymmetric, and 3D.
Definition m_acoustic_src.fpp.f90:1702
m_acoustic_src::height
real(wp), dimension(:), allocatable height
Definition m_acoustic_src.fpp.f90:412
m_acoustic_src::pulse
integer, dimension(:), allocatable pulse
Definition m_acoustic_src.fpp.f90:370
m_acoustic_src::bb_num_freq
integer, dimension(:), allocatable bb_num_freq
Definition m_acoustic_src.fpp.f90:481
m_acoustic_src::dir
real(wp), dimension(:), allocatable dir
Definition m_acoustic_src.fpp.f90:413
m_acoustic_src::s_precalculate_acoustic_spatial_sources
impure subroutine, public s_precalculate_acoustic_spatial_sources
Pre-compute non-zero spatial source weights before time-stepping.
Definition m_acoustic_src.fpp.f90:1207
m_acoustic_src::length
real(wp), dimension(:), allocatable length
Definition m_acoustic_src.fpp.f90:412
m_acoustic_src::rotate_angle
real(wp), dimension(:), allocatable rotate_angle
Definition m_acoustic_src.fpp.f90:453
m_acoustic_src::support
integer, dimension(:), allocatable support
Definition m_acoustic_src.fpp.f90:370
m_acoustic_src::wavelength
real(wp), dimension(:), allocatable wavelength
Definition m_acoustic_src.fpp.f90:412
m_acoustic_src::s_acoustic_src_calculations
impure subroutine, public s_acoustic_src_calculations(q_cons_vf, q_prim_vf, rhs_vf)
Compute mass, momentum, and energy acoustic source terms and add to the RHS.
Definition m_acoustic_src.fpp.f90:790
m_acoustic_src::npulse
real(wp), dimension(:), allocatable npulse
Definition m_acoustic_src.fpp.f90:413
m_acoustic_src::element_on
integer, dimension(:), allocatable element_on
Definition m_acoustic_src.fpp.f90:481
m_acoustic_src::aperture
real(wp), dimension(:), allocatable aperture
Definition m_acoustic_src.fpp.f90:439
m_acoustic_src::foc_length
real(wp), dimension(:), allocatable foc_length
Definition m_acoustic_src.fpp.f90:439
m_acoustic_src::s_source_spatial_planar
subroutine s_source_spatial_planar(ai, sig, r, source)
Compute the spatial support for planar acoustic sources in 1D, 2D, and 3D.
Definition m_acoustic_src.fpp.f90:1676
m_acoustic_src::s_source_spatial_transducer_array
subroutine s_source_spatial_transducer_array(ai, sig, r, source, angle, xyz_to_r_ratios)
Compute the spatial support for multiple transducers in 2D, 2D axisymmetric, and 3D.
Definition m_acoustic_src.fpp.f90:1740
m_acoustic_src::bb_lowest_freq
real(wp), dimension(:), allocatable bb_lowest_freq
Definition m_acoustic_src.fpp.f90:467
m_acoustic_src::num_elements
integer, dimension(:), allocatable num_elements
Definition m_acoustic_src.fpp.f90:481
m_acoustic_src::s_initialize_acoustic_src
impure subroutine, public s_initialize_acoustic_src
Initialize the acoustic source module.
Definition m_acoustic_src.fpp.f90:545
m_acoustic_src::loc_acoustic
real(wp), dimension(:,:), allocatable, target loc_acoustic
Definition m_acoustic_src.fpp.f90:398
m_acoustic_src::dipole
logical, dimension(:), allocatable dipole
Definition m_acoustic_src.fpp.f90:384
m_acoustic_src::mass_src
real(wp), dimension(:,:,:), allocatable mass_src
Definition m_acoustic_src.fpp.f90:497
m_acoustic_src::mag
real(wp), dimension(:), allocatable mag
Definition m_acoustic_src.fpp.f90:412
m_acoustic_src::frequency
real(wp), dimension(:), allocatable frequency
Definition m_acoustic_src.fpp.f90:412
m_acoustic_src::s_source_temporal
elemental subroutine s_source_temporal(sim_time, c, ai, term_index, frequency_local, gauss_sigma_time_local, source, sum_bb)
Compute the temporally varying amplitude of the pulse.
Definition m_acoustic_src.fpp.f90:1130
m_acoustic_src::f_gauss_sigma_time_local
real(wp) function f_gauss_sigma_time_local(gauss_conv_flag, ai, c)
Convert Gaussian sigma from distance to time.
Definition m_acoustic_src.fpp.f90:1848
m_acoustic_src::e_src
real(wp), dimension(:,:,:), allocatable e_src
Definition m_acoustic_src.fpp.f90:497
m_acoustic_src::s_source_spatial
subroutine s_source_spatial(j, k, l, loc, ai, source, angle, xyz_to_r_ratios)
Compute the spatial support of the acoustic source.
Definition m_acoustic_src.fpp.f90:1642
m_acoustic_src::element_spacing_angle
real(wp), dimension(:), allocatable element_spacing_angle
Definition m_acoustic_src.fpp.f90:453
m_acoustic_src::source_spatials_num_points
integer, dimension(:), allocatable source_spatials_num_points
Number of non-zero source grid points for each source.
Definition m_acoustic_src.fpp.f90:513
m_acoustic_src::element_polygon_ratio
real(wp), dimension(:), allocatable element_polygon_ratio
Definition m_acoustic_src.fpp.f90:453
m_acoustic_src::bb_bandwidth
real(wp), dimension(:), allocatable bb_bandwidth
Definition m_acoustic_src.fpp.f90:467
m_acoustic_src::gauss_sigma_dist
real(wp), dimension(:), allocatable gauss_sigma_dist
Definition m_acoustic_src.fpp.f90:413
m_acoustic_src::delay
real(wp), dimension(:), allocatable delay
Definition m_acoustic_src.fpp.f90:413
m_acoustic_src::mom_src
real(wp), dimension(:,:,:,:), allocatable mom_src
Definition m_acoustic_src.fpp.f90:498
m_bubbles
Bubble-dynamics procedures for ensemble- and volume-averaged model.
Definition m_bubbles.fpp.f90:356
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::dflt_int
integer, parameter dflt_int
Default integer value.
Definition m_constants.fpp.f90:30
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_eos
Equations of state in Gamma/Pi form, rho e = Gamma(rho) p + Pi(rho).
Definition m_eos.fpp.f90:402
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:367
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:356
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_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:367
m_derived_types::source_spatial_type
Acoustic source source_spatial pre-calculated values.
Definition m_derived_types.fpp.f90:870