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# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20
21# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22
23# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32! New line at end of file is required for FYPP
33# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
34# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
35# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
36# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59! New line at end of file is required for FYPP
60# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
61
62# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
63# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
64# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
65# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
66# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
67
68# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
69
70# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71
72# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73
74# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 207 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 232 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 243 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 245 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 283 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 293 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 303 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 312 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 329 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 346 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 358 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 364 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 370 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 376 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138! New line at end of file is required for FYPP
139# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
140# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
141# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
142# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
143# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
144# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
145# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
146# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147
148# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153
154# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165! New line at end of file is required for FYPP
166# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
167
168# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
169
170# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
171
172# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
173
174# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 192 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 213 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 241 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 256 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 266 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 275 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 291 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 301 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 308 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223! New line at end of file is required for FYPP
224# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
225
226# 21 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
227
228# 37 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
229
230# 50 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
231
232# 76 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
233
234# 91 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
235
236# 102 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238# 115 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
239
240# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
241
242# 154 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244# 165 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246# 176 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248# 187 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250# 198 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252# 208 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256# 220 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258# 226 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260# 232 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262# 234 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263# 235 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264! New line at end of file is required for FYPP
265# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
266
267# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
268
269! Caution:
270! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
271! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
272! For an example see misc/nvidia_uvm/bind.sh.
273# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
274
275# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
276
277# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
278
279# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
280
281# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
282
283# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
284
285# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
286
287# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
288! New line at end of file is required for FYPP
289# 6 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp" 2
290
291!> @brief Applies acoustic pressure source terms including focused, planar, and broadband transducers
292module m_acoustic_src
293
294 use m_derived_types !< definitions of the derived types
295
296 use m_global_parameters !< definitions of the global parameters
297
298 use m_bubbles !< bubble dynamic routines
299
300 use m_variables_conversion !< state variables type conversion procedures
301
302 use m_helper_basic !< functions to compare floating point numbers
303
304 use m_constants !< definitions of the constants
305
306 implicit none
307 private; public :: s_initialize_acoustic_src, s_precalculate_acoustic_spatial_sources, s_acoustic_src_calculations
308
309 integer, allocatable, dimension(:) :: pulse, support
310
311# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
312#if defined(MFC_OpenACC)
313# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
314!$acc declare create(pulse, support)
315# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
316#elif defined(MFC_OpenMP)
317# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
318!$omp declare target (pulse, support)
319# 26 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
320#endif
321
322 logical, allocatable, dimension(:) :: dipole
323
324# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
325#if defined(MFC_OpenACC)
326# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
327!$acc declare create(dipole)
328# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
329#elif defined(MFC_OpenMP)
330# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
331!$omp declare target (dipole)
332# 29 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
333#endif
334
335 real(wp), allocatable, target, dimension(:, :) :: loc_acoustic
336
337# 32 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
338#if defined(MFC_OpenACC)
339# 32 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
340!$acc declare create(loc_acoustic)
341# 32 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
342#elif defined(MFC_OpenMP)
343# 32 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
344!$omp declare target (loc_acoustic)
345# 32 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
346#endif
347
348 real(wp), allocatable, dimension(:) :: mag, length, height, wavelength, frequency
349 real(wp), allocatable, dimension(:) :: gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay
350
351# 36 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
352#if defined(MFC_OpenACC)
353# 36 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
354!$acc declare create(mag, length, height, wavelength, frequency)
355# 36 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
356#elif defined(MFC_OpenMP)
357# 36 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
358!$omp declare target (mag, length, height, wavelength, frequency)
359# 36 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
360#endif
361
362# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
363#if defined(MFC_OpenACC)
364# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
365!$acc declare create(gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay)
366# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
367#elif defined(MFC_OpenMP)
368# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
369!$omp declare target (gauss_sigma_dist, gauss_sigma_time, npulse, dir, delay)
370# 37 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
371#endif
372
373 real(wp), allocatable, dimension(:) :: foc_length, aperture
374
375# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
376#if defined(MFC_OpenACC)
377# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
378!$acc declare create(foc_length, aperture)
379# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
380#elif defined(MFC_OpenMP)
381# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
382!$omp declare target (foc_length, aperture)
383# 40 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
384#endif
385
386 real(wp), allocatable, dimension(:) :: element_spacing_angle, element_polygon_ratio, rotate_angle
387
388# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
389#if defined(MFC_OpenACC)
390# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
391!$acc declare create(element_spacing_angle, element_polygon_ratio, rotate_angle)
392# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
393#elif defined(MFC_OpenMP)
394# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
395!$omp declare target (element_spacing_angle, element_polygon_ratio, rotate_angle)
396# 43 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
397#endif
398
399 real(wp), allocatable, dimension(:) :: bb_bandwidth, bb_lowest_freq
400
401# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
402#if defined(MFC_OpenACC)
403# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
404!$acc declare create(bb_bandwidth, bb_lowest_freq)
405# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
406#elif defined(MFC_OpenMP)
407# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
408!$omp declare target (bb_bandwidth, bb_lowest_freq)
409# 46 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
410#endif
411
412 integer, allocatable, dimension(:) :: num_elements, element_on, bb_num_freq
413
414# 49 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
415#if defined(MFC_OpenACC)
416# 49 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
417!$acc declare create(num_elements, element_on, bb_num_freq)
418# 49 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
419#elif defined(MFC_OpenMP)
420# 49 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
421!$omp declare target (num_elements, element_on, bb_num_freq)
422# 49 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
423#endif
424
425 !> @name Acoustic source terms
426 !> @{
427 real(wp), allocatable, dimension(:, :, :) :: mass_src, e_src
428 real(wp), allocatable, dimension(:, :, :, :) :: mom_src
429 !> @}
430
431# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
432#if defined(MFC_OpenACC)
433# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
434!$acc declare create(mass_src, e_src, mom_src)
435# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
436#elif defined(MFC_OpenMP)
437# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
438!$omp declare target (mass_src, e_src, mom_src)
439# 56 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
440#endif
441
442 integer, dimension(:), allocatable :: source_spatials_num_points !< Number of non-zero source grid points for each source
443
444# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
445#if defined(MFC_OpenACC)
446# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
447!$acc declare create(source_spatials_num_points)
448# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
449#elif defined(MFC_OpenMP)
450# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
451!$omp declare target (source_spatials_num_points)
452# 59 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
453#endif
454
455 type(source_spatial_type), dimension(:), allocatable :: source_spatials !< Data of non-zero source grid points for each source
456
457# 62 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
458#if defined(MFC_OpenACC)
459# 62 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
460!$acc declare create(source_spatials)
461# 62 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
462#elif defined(MFC_OpenMP)
463# 62 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
464!$omp declare target (source_spatials)
465# 62 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
466#endif
467
468contains
469
470 !> This subroutine initializes the acoustic source module
471 impure subroutine s_initialize_acoustic_src
472 integer :: i, j !< generic loop variables
473
474#ifdef MFC_DEBUG
475# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
476 block
477# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
478 use iso_fortran_env, only: output_unit
479# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
480
481# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
482 print *, 'm_acoustic_src.fpp:70: ', '@: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))'
483# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
484
485# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
486 call flush (output_unit)
487# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
488 end block
489# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
490#endif
491# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
492 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))
493# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
494
495# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
496
497# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
498
499# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
500
501# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
502
503# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
504
505# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
506
507# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
508
509# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
510
511# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
512
513# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
514
515# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
516
517# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
518
519# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
520
521# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
522
523# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
524
525# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
526
527# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
528
529# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
530
531# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
532
533# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
534
535# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
536
537# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
538
539# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
540
541# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
542
543# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
544#if defined(MFC_OpenACC)
545# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
546!$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)
547# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
548#elif defined(MFC_OpenMP)
549# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
550!$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)
551# 70 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
552#endif
553
554 do i = 1, num_source
555 do j = 1, 3
556 loc_acoustic(j, i) = acoustic(i)%loc(j)
557 end do
558 mag(i) = acoustic(i)%mag
559 dipole(i) = acoustic(i)%dipole
560 support(i) = acoustic(i)%support
561 length(i) = acoustic(i)%length
562 height(i) = acoustic(i)%height
563 wavelength(i) = acoustic(i)%wavelength
564 frequency(i) = acoustic(i)%frequency
565 gauss_sigma_dist(i) = acoustic(i)%gauss_sigma_dist
566 gauss_sigma_time(i) = acoustic(i)%gauss_sigma_time
567 foc_length(i) = acoustic(i)%foc_length
568 aperture(i) = acoustic(i)%aperture
569 npulse(i) = acoustic(i)%npulse
570 pulse(i) = acoustic(i)%pulse
571 dir(i) = acoustic(i)%dir
572 element_spacing_angle(i) = acoustic(i)%element_spacing_angle
573 element_polygon_ratio(i) = acoustic(i)%element_polygon_ratio
574 num_elements(i) = acoustic(i)%num_elements
575 bb_num_freq(i) = acoustic(i)%bb_num_freq
576 bb_bandwidth(i) = acoustic(i)%bb_bandwidth
577 bb_lowest_freq(i) = acoustic(i)%bb_lowest_freq
578
579 if (acoustic(i)%element_on == dflt_int) then
580 element_on(i) = 0
581 else
582 element_on(i) = acoustic(i)%element_on
583 end if
584 if (f_is_default(acoustic(i)%rotate_angle)) then
585 rotate_angle(i) = 0._wp
586 else
587 rotate_angle(i) = acoustic(i)%rotate_angle
588 end if
589 if (f_is_default(acoustic(i)%delay)) then ! m_checker guarantees acoustic(i)%delay is set for pulse = 2 (Gaussian)
590 delay(i) = 0._wp ! Defaults to zero for sine and square waves
591 else
592 delay(i) = acoustic(i)%delay
593 end if
594 end do
595
596# 113 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
597#if defined(MFC_OpenACC)
598# 113 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
599!$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)
600# 113 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
601#elif defined(MFC_OpenMP)
602# 113 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
603!$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)
604# 113 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
605#endif
606# 119 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
607
608#ifdef MFC_DEBUG
609# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
610 block
611# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
612 use iso_fortran_env, only: output_unit
613# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
614
615# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
616 print *, 'm_acoustic_src.fpp:120: ', '@:ALLOCATE(mass_src(0:m, 0:n, 0:p))'
617# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
618
619# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
620 call flush (output_unit)
621# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
622 end block
623# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
624#endif
625# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
626 allocate (mass_src(0:m, 0:n, 0:p))
627# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
628
629# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
630
631# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
632#if defined(MFC_OpenACC)
633# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
634!$acc enter data create(mass_src)
635# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
636#elif defined(MFC_OpenMP)
637# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
638!$omp target enter data map(always,alloc:mass_src)
639# 120 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
640#endif
641#ifdef MFC_DEBUG
642# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
643 block
644# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
645 use iso_fortran_env, only: output_unit
646# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
647
648# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
649 print *, 'm_acoustic_src.fpp:121: ', '@:ALLOCATE(mom_src(1:num_vels, 0:m, 0:n, 0:p))'
650# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
651
652# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
653 call flush (output_unit)
654# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
655 end block
656# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
657#endif
658# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
659 allocate (mom_src(1:num_vels, 0:m, 0:n, 0:p))
660# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
661
662# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
663
664# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
665#if defined(MFC_OpenACC)
666# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
667!$acc enter data create(mom_src)
668# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
669#elif defined(MFC_OpenMP)
670# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
671!$omp target enter data map(always,alloc:mom_src)
672# 121 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
673#endif
674#ifdef MFC_DEBUG
675# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
676 block
677# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
678 use iso_fortran_env, only: output_unit
679# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
680
681# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
682 print *, 'm_acoustic_src.fpp:122: ', '@:ALLOCATE(E_src(0:m, 0:n, 0:p))'
683# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
684
685# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
686 call flush (output_unit)
687# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
688 end block
689# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
690#endif
691# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
692 allocate (e_src(0:m, 0:n, 0:p))
693# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
694
695# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
696
697# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
698#if defined(MFC_OpenACC)
699# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
700!$acc enter data create(E_src)
701# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
702#elif defined(MFC_OpenMP)
703# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
704!$omp target enter data map(always,alloc:E_src)
705# 122 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
706#endif
707
708 end subroutine s_initialize_acoustic_src
709
710 !> This subroutine updates the rhs by computing the mass, mom, energy sources
711 !! @param t_step Current time step
712 !! @param rhs_vf rhs variables
713 impure subroutine s_acoustic_src_calculations(q_cons_vf, q_prim_vf, t_step, rhs_vf)
714
715 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf !<
716 !! This variable contains the WENO-reconstructed values of the cell-average
717 !! conservative variables, which are located in q_cons_vf, at cell-interior
718 !! Gaussian quadrature points (QP).
719
720 type(scalar_field), dimension(sys_size), intent(inout) :: q_prim_vf !<
721 !! The primitive variables at cell-interior Gaussian quadrature points. These
722 !! are calculated from the conservative variables and gradient magnitude (GM)
723 !! of the volume fractions, q_cons_qp and gm_alpha_qp, respectively.
724
725 type(scalar_field), dimension(sys_size), intent(inout) :: rhs_vf
726
727 integer, intent(in) :: t_step
728# 147 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
729 real(wp), dimension(num_fluids) :: myalpha, myalpha_rho
730# 149 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
731 real(wp) :: myrho, b_tait
732 real(wp) :: sim_time, c, small_gamma
733 real(wp) :: frequency_local, gauss_sigma_time_local
734 real(wp) :: mass_src_diff, mom_src_diff
735 real(wp) :: source_temporal
736 real(wp) :: period_bb !< period of each sine wave in broadband source
737 real(wp) :: sl_bb !< spectral level at each frequency
738 real(wp) :: ffre_bb !< source term corresponding to each frequency
739 real(wp) :: sum_bb !< total source term for the broadband wave
740 real(wp), allocatable, dimension(:) :: phi_rn !< random phase shift for each frequency
741
742 integer :: i, j, k, l, q !< generic loop variables
743 integer :: ai !< acoustic source index
744 integer :: num_points
745
746 logical :: freq_conv_flag, gauss_conv_flag
747
748 integer, parameter :: mass_label = 1, mom_label = 2
749
750 sim_time = t_step*dt
751
752
753# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
754
755# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
756#if defined(MFC_OpenACC)
757# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
758!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
759# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
760#elif defined(MFC_OpenMP)
761# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
762
763# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
764
765# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
766
767# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
768!$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)
769# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
770#endif
771# 170 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
772
773 do l = 0, p
774 do k = 0, n
775 do j = 0, m
776 mass_src(j, k, l) = 0._wp
777 mom_src(1, j, k, l) = 0._wp
778 e_src(j, k, l) = 0._wp
779 if (n > 0) mom_src(2, j, k, l) = 0._wp
780 if (p > 0) mom_src(3, j, k, l) = 0._wp
781 end do
782 end do
783 end do
784
785# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
786
787# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
788#if defined(MFC_OpenACC)
789# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
790!$acc end parallel loop
791# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
792#elif defined(MFC_OpenMP)
793# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
794
795# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
796
797# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
798!$omp end target teams loop
799# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
800#endif
801# 182 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
802
803
804 ! Keep outer loop sequel because different sources can have very different number of points
805 do ai = 1, num_source
806 ! Skip if the pulse has not started yet for sine and square waves
807 if (.not. (sim_time < delay(ai) .and. (pulse(ai) == 1 .or. pulse(ai) == 3))) then
808
809 ! Decide if frequency need to be converted from wavelength
810 freq_conv_flag = f_is_default(frequency(ai))
811 gauss_conv_flag = f_is_default(gauss_sigma_time(ai))
812
813 num_points = source_spatials_num_points(ai) ! Use scalar to force firstprivate to prevent GPU bug
814
815 ! Calculate the broadband source
816 period_bb = 0._wp
817 sl_bb = 0._wp
818 ffre_bb = 0._wp
819 sum_bb = 0._wp
820
821 ! Allocate buffers for random phase shift
822 allocate (phi_rn(1:bb_num_freq(ai)))
823 phi_rn(1:bb_num_freq(ai)) = 0._wp
824
825 if (pulse(ai) == 4) then
826 call random_number(phi_rn(1:bb_num_freq(ai)))
827 ! Ensure all the ranks have the same random phase shift
828 call s_mpi_send_random_number(phi_rn, bb_num_freq(ai))
829 end if
830
831 do k = 1, bb_num_freq(ai)
832 ! Acoustic period of the wave at each discrete frequency
833 period_bb = 1._wp/(bb_lowest_freq(ai) + k*bb_bandwidth(ai))
834 ! Spectral level at each frequency
835 sl_bb = broadband_spectral_level_constant*mag(ai) + k*mag(ai)/broadband_spectral_level_growth_rate
836 ! Source term corresponding to each frequencies
837 ffre_bb = sqrt((2._wp*sl_bb*bb_bandwidth(ai)))*cos((sim_time)*2._wp*pi/period_bb + 2._wp*pi*phi_rn(k))
838 ! Sum up the source term of each frequency to obtain the total source term for broadband wave
839 sum_bb = sum_bb + ffre_bb
840 end do
841
842 deallocate (phi_rn)
843
844
845# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
846
847# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
848#if defined(MFC_OpenACC)
849# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
850!$acc parallel loop gang vector default(present) private(myalpha, myalpha_rho, myRho, B_tait, c, small_gamma, frequency_local, 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)
851# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
852#elif defined(MFC_OpenMP)
853# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
854
855# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
856
857# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
858
859# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
860!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(myalpha, myalpha_rho, myRho, B_tait, c, small_gamma, frequency_local, gauss_sigma_time_local, mass_src_diff, mom_src_diff, source_temporal, j, k, l, q) map(to:sum_BB, freq_conv_flag, gauss_conv_flag, sim_time)
861# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
862#endif
863# 224 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
864
865 do i = 1, num_points
866 j = source_spatials(ai)%coord(1, i)
867 k = source_spatials(ai)%coord(2, i)
868 l = source_spatials(ai)%coord(3, i)
869
870 ! Compute speed of sound
871 myrho = 0._wp
872 b_tait = 0._wp
873 small_gamma = 0._wp
874
875
876# 235 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
877#if defined(MFC_OpenACC)
878# 235 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
879!$acc loop seq
880# 235 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
881#elif defined(MFC_OpenMP)
882# 235 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
883
884# 235 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
885#endif
886 do q = 1, num_fluids
887 myalpha_rho(q) = q_cons_vf(q)%sf(j, k, l)
888 myalpha(q) = q_cons_vf(advxb + q - 1)%sf(j, k, l)
889 end do
890
891 if (bubbles_euler) then
892 if (num_fluids > 2) then
893
894# 243 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
895#if defined(MFC_OpenACC)
896# 243 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
897!$acc loop seq
898# 243 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
899#elif defined(MFC_OpenMP)
900# 243 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
901
902# 243 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
903#endif
904 do q = 1, num_fluids - 1
905 myrho = myrho + myalpha_rho(q)
906 b_tait = b_tait + myalpha(q)*pi_infs(q)
907 small_gamma = small_gamma + myalpha(q)*gammas(q)
908 end do
909 else
910 myrho = myalpha_rho(1)
911 b_tait = pi_infs(1)
912 small_gamma = gammas(1)
913 end if
914 end if
915
916 if ((.not. bubbles_euler) .or. (mpp_lim .and. (num_fluids > 2))) then
917
918# 257 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
919#if defined(MFC_OpenACC)
920# 257 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
921!$acc loop seq
922# 257 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
923#elif defined(MFC_OpenMP)
924# 257 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
925
926# 257 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
927#endif
928 do q = 1, num_fluids
929 myrho = myrho + myalpha_rho(q)
930 b_tait = b_tait + myalpha(q)*pi_infs(q)
931 small_gamma = small_gamma + myalpha(q)*gammas(q)
932 end do
933 end if
934
935 small_gamma = 1._wp/small_gamma + 1._wp
936 c = sqrt(small_gamma*(q_prim_vf(e_idx)%sf(j, k, l) + ((small_gamma - 1._wp)/small_gamma)*b_tait)/myrho)
937
938 ! Wavelength to frequency conversion
939 if (pulse(ai) == 1 .or. pulse(ai) == 3) frequency_local = f_frequency_local(freq_conv_flag, ai, c)
940 if (pulse(ai) == 2) gauss_sigma_time_local = f_gauss_sigma_time_local(gauss_conv_flag, ai, c)
941
942 ! Update momentum source term
943 call s_source_temporal(sim_time, c, ai, mom_label, frequency_local, gauss_sigma_time_local, source_temporal, sum_bb)
944 mom_src_diff = source_temporal*source_spatials(ai)%val(i)
945
946 if (dipole(ai)) then ! Double amplitude & No momentum source term (only works for Planar)
947 mass_src(j, k, l) = mass_src(j, k, l) + 2._wp*mom_src_diff/c
948 if (model_eqns /= 4) e_src(j, k, l) = e_src(j, k, l) + 2._wp*mom_src_diff*c/(small_gamma - 1._wp)
949 cycle
950 end if
951
952 if (n == 0) then ! 1D
953 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
954
955 elseif (p == 0) then ! 2D
956 if (support(ai) < 5) then ! Planar
957 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*cos(dir(ai))
958 mom_src(2, j, k, l) = mom_src(2, j, k, l) + mom_src_diff*sin(dir(ai))
959 else
960 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*cos(source_spatials(ai)%angle(i))
961 mom_src(2, j, k, l) = mom_src(2, j, k, l) + mom_src_diff*sin(source_spatials(ai)%angle(i))
962 end if
963
964 else ! 3D
965 if (support(ai) < 5) then ! Planar
966 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*cos(dir(ai))
967 mom_src(2, j, k, l) = mom_src(2, j, k, l) + mom_src_diff*sin(dir(ai))
968 else
969 mom_src(1, j, k, l) = mom_src(1, j, k, l) + mom_src_diff*source_spatials(ai)%xyz_to_r_ratios(1, i)
970 mom_src(2, j, k, l) = mom_src(2, j, k, l) + mom_src_diff*source_spatials(ai)%xyz_to_r_ratios(2, i)
971 mom_src(3, j, k, l) = mom_src(3, j, k, l) + mom_src_diff*source_spatials(ai)%xyz_to_r_ratios(3, i)
972 end if
973 end if
974
975 ! Update mass source term
976 if (support(ai) < 5) then ! Planar
977 mass_src_diff = mom_src_diff/c
978 else ! Spherical or cylindrical support
979 ! Mass source term must be calculated differently using a correction term for spherical and cylindrical support
980 call s_source_temporal(sim_time, c, ai, mass_label, frequency_local, gauss_sigma_time_local, source_temporal, sum_bb)
981 mass_src_diff = source_temporal*source_spatials(ai)%val(i)
982 end if
983 mass_src(j, k, l) = mass_src(j, k, l) + mass_src_diff
984
985 ! Update energy source term
986 if (model_eqns /= 4) then
987 e_src(j, k, l) = e_src(j, k, l) + mass_src_diff*c**2._wp/(small_gamma - 1._wp)
988 end if
989
990 end do
991
992# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
993
994# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
995#if defined(MFC_OpenACC)
996# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
997!$acc end parallel loop
998# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
999#elif defined(MFC_OpenMP)
1000# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1001
1002# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1003
1004# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1005!$omp end target teams loop
1006# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1007#endif
1008# 321 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1009
1010 end if
1011 end do
1012
1013 ! Update the rhs variables
1014
1015# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1016
1017# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1018#if defined(MFC_OpenACC)
1019# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1020!$acc parallel loop collapse(3) gang vector default(present) private(j, k, l)
1021# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1022#elif defined(MFC_OpenMP)
1023# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1024
1025# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1026
1027# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1028
1029# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1030!$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)
1031# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1032#endif
1033# 326 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1034
1035 do l = 0, p
1036 do k = 0, n
1037 do j = 0, m
1038
1039# 330 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1040#if defined(MFC_OpenACC)
1041# 330 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1042!$acc loop seq
1043# 330 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1044#elif defined(MFC_OpenMP)
1045# 330 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1046
1047# 330 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1048#endif
1049 do q = contxb, contxe
1050 rhs_vf(q)%sf(j, k, l) = rhs_vf(q)%sf(j, k, l) + mass_src(j, k, l)
1051 end do
1052
1053# 334 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1054#if defined(MFC_OpenACC)
1055# 334 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1056!$acc loop seq
1057# 334 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1058#elif defined(MFC_OpenMP)
1059# 334 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1060
1061# 334 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1062#endif
1063 do q = momxb, momxe
1064 rhs_vf(q)%sf(j, k, l) = rhs_vf(q)%sf(j, k, l) + mom_src(q - contxe, j, k, l)
1065 end do
1066 rhs_vf(e_idx)%sf(j, k, l) = rhs_vf(e_idx)%sf(j, k, l) + e_src(j, k, l)
1067 end do
1068 end do
1069 end do
1070
1071# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1072
1073# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1074#if defined(MFC_OpenACC)
1075# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1076!$acc end parallel loop
1077# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1078#elif defined(MFC_OpenMP)
1079# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1080
1081# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1082
1083# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1084!$omp end target teams loop
1085# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1086#endif
1087# 342 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1088
1089 end subroutine s_acoustic_src_calculations
1090
1091 !> This subroutine gives the temporally varying amplitude of the pulse
1092 !! @param sim_time Simulation time
1093 !! @param c Sound speed
1094 !! @param ai Acoustic source index
1095 !! @param term_index Index of the term to be calculated (1: mass source, 2: momentum source)
1096 !! @param frequency_local Frequency at the spatial location for sine and square waves
1097 !! @param gauss_sigma_time_local sigma in time for Gaussian pulse
1098 !! @param source Source term amplitude
1099 !! @param sum_bb Sum of basis functions
1100 elemental subroutine s_source_temporal(sim_time, c, ai, term_index, frequency_local, gauss_sigma_time_local, source, sum_BB)
1101
1102# 355 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1103#if MFC_OpenACC
1104# 355 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1105!$acc routine seq
1106# 355 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1107#elif MFC_OpenMP
1108# 355 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1109
1110# 355 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1111
1112# 355 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1113!$omp declare target device_type(any)
1114# 355 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1115#endif
1116 integer, intent(in) :: ai, term_index
1117 real(wp), intent(in) :: sim_time, c, sum_bb
1118 real(wp), intent(in) :: frequency_local, gauss_sigma_time_local
1119 real(wp), intent(out) :: source
1120
1121 real(wp) :: omega ! angular frequency
1122 real(wp) :: sine_wave ! sine function for square wave
1123 real(wp) :: foc_length_factor ! Scale amplitude with radius for spherical support
1124 ! i.e. Spherical support -> 1/r scaling; Cylindrical support -> 1/sqrt(r) [empirical correction: ^-0.5 -> ^-0.85]
1125 integer, parameter :: mass_label = 1
1126
1127 if (n == 0) then
1128 foc_length_factor = 1._wp
1129 elseif (p == 0 .and. (.not. cyl_coord)) then ! 2D axisymmetric case is physically 3D
1130 foc_length_factor = foc_length(ai)**(-0.85_wp); ! Empirical correction
1131 else
1132 foc_length_factor = 1/foc_length(ai);
1133 end if
1134
1135 source = 0._wp
1136
1137 if (pulse(ai) == 1) then ! Sine wave
1138 if ((sim_time - delay(ai))*frequency_local > npulse(ai)) return
1139
1140 omega = 2._wp*pi*frequency_local
1141 source = mag(ai)*sin((sim_time - delay(ai))*omega)
1142
1143 if (term_index == mass_label) then
1144 source = source/c + foc_length_factor*mag(ai)*(cos((sim_time - delay(ai))*omega) - 1._wp)/omega
1145 end if
1146
1147 elseif (pulse(ai) == 2) then ! Gaussian pulse
1148 source = mag(ai)*exp(-0.5_wp*((sim_time - delay(ai))**2._wp)/(gauss_sigma_time_local**2._wp))
1149
1150 if (term_index == mass_label) then
1151 source = source/c - &
1152 foc_length_factor*mag(ai)*sqrt(pi/2)*gauss_sigma_time_local* &
1153 (erf((sim_time - delay(ai))/(sqrt(2._wp)*gauss_sigma_time_local)) + 1)
1154 end if
1155
1156 elseif (pulse(ai) == 3) then ! Square wave
1157 if ((sim_time - delay(ai))*frequency_local > npulse(ai)) return
1158
1159 omega = 2._wp*pi*frequency_local
1160 sine_wave = sin((sim_time - delay(ai))*omega)
1161 source = mag(ai)*sign(1._wp, sine_wave)
1162
1163 ! Prevent max-norm differences due to compilers to pass CI
1164 if (abs(sine_wave) < 1.e-2_wp) then
1165 source = mag(ai)*sine_wave*1.e2_wp
1166 end if
1167
1168 elseif (pulse(ai) == 4) then ! Broadband wave
1169 source = sum_bb
1170 end if
1171 end subroutine s_source_temporal
1172
1173 !> This subroutine identifies and precalculates the non-zero acoustic spatial sources before time-stepping
1174 impure subroutine s_precalculate_acoustic_spatial_sources
1175 integer :: j, k, l, ai
1176 integer :: count
1177 integer :: dim
1178 real(wp) :: source_spatial, angle, xyz_to_r_ratios(3)
1179 real(wp), parameter :: threshold = 1.e-10_wp
1180
1181 if (n == 0) then
1182 dim = 1
1183 elseif (p == 0) then
1184 dim = 2
1185 else
1186 dim = 3
1187 end if
1188
1189#ifdef MFC_DEBUG
1190# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1191 block
1192# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1193 use iso_fortran_env, only: output_unit
1194# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1195
1196# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1197 print *, 'm_acoustic_src.fpp:429: ', '@:ALLOCATE(source_spatials_num_points(1:num_source))'
1198# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1199
1200# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1201 call flush (output_unit)
1202# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1203 end block
1204# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1205#endif
1206# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1207 allocate (source_spatials_num_points(1:num_source))
1208# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1209
1210# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1211
1212# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1213#if defined(MFC_OpenACC)
1214# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1215!$acc enter data create(source_spatials_num_points)
1216# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1217#elif defined(MFC_OpenMP)
1218# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1219!$omp target enter data map(always,alloc:source_spatials_num_points)
1220# 429 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1221#endif
1222#ifdef MFC_DEBUG
1223# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1224 block
1225# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1226 use iso_fortran_env, only: output_unit
1227# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1228
1229# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1230 print *, 'm_acoustic_src.fpp:430: ', '@:ALLOCATE(source_spatials(1:num_source))'
1231# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1232
1233# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1234 call flush (output_unit)
1235# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1236 end block
1237# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1238#endif
1239# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1240 allocate (source_spatials(1:num_source))
1241# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1242
1243# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1244
1245# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1246#if defined(MFC_OpenACC)
1247# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1248!$acc enter data create(source_spatials)
1249# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1250#elif defined(MFC_OpenMP)
1251# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1252!$omp target enter data map(always,alloc:source_spatials)
1253# 430 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1254#endif
1255
1256 do ai = 1, num_source
1257 ! First pass: Count the number of points for each source
1258 count = 0
1259 do l = 0, p
1260 do k = 0, n
1261 do j = 0, m
1262 call s_source_spatial(j, k, l, loc_acoustic(:, ai), ai, source_spatial, angle, xyz_to_r_ratios)
1263 if (abs(source_spatial) < threshold) cycle
1264 count = count + 1
1265 end do
1266 end do
1267 end do
1268 source_spatials_num_points(ai) = count
1269
1270 ! Allocate arrays with the correct size
1271
1272#ifdef MFC_DEBUG
1273# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1274 block
1275# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1276 use iso_fortran_env, only: output_unit
1277# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1278
1279# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1280 print *, 'm_acoustic_src.fpp:448: ', '@:ALLOCATE(source_spatials(ai)%coord(1:3, 1:count))'
1281# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1282
1283# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1284 call flush (output_unit)
1285# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1286 end block
1287# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1288#endif
1289# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1290 allocate (source_spatials(ai)%coord(1:3, 1:count))
1291# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1292
1293# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1294
1295# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1296#if defined(MFC_OpenACC)
1297# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1298!$acc enter data create(source_spatials(ai)%coord)
1299# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1300#elif defined(MFC_OpenMP)
1301# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1302!$omp target enter data map(always,alloc:source_spatials(ai)%coord)
1303# 448 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1304#endif
1305#ifdef MFC_DEBUG
1306# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1307 block
1308# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1309 use iso_fortran_env, only: output_unit
1310# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1311
1312# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1313 print *, 'm_acoustic_src.fpp:449: ', '@:ALLOCATE(source_spatials(ai)%val(1:count))'
1314# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1315
1316# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1317 call flush (output_unit)
1318# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1319 end block
1320# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1321#endif
1322# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1323 allocate (source_spatials(ai)%val(1:count))
1324# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1325
1326# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1327
1328# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1329#if defined(MFC_OpenACC)
1330# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1331!$acc enter data create(source_spatials(ai)%val)
1332# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1333#elif defined(MFC_OpenMP)
1334# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1335!$omp target enter data map(always,alloc:source_spatials(ai)%val)
1336# 449 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1337#endif
1338#ifdef MFC_DEBUG
1339# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1340 block
1341# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1342 use iso_fortran_env, only: output_unit
1343# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1344
1345# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1346 print *, 'm_acoustic_src.fpp:450: ', '@:ALLOCATE(source_spatials(ai)%angle(1:count))'
1347# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1348
1349# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1350 call flush (output_unit)
1351# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1352 end block
1353# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1354#endif
1355# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1356 allocate (source_spatials(ai)%angle(1:count))
1357# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1358
1359# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1360
1361# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1362#if defined(MFC_OpenACC)
1363# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1364!$acc enter data create(source_spatials(ai)%angle)
1365# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1366#elif defined(MFC_OpenMP)
1367# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1368!$omp target enter data map(always,alloc:source_spatials(ai)%angle)
1369# 450 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1370#endif
1371#ifdef MFC_DEBUG
1372# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1373 block
1374# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1375 use iso_fortran_env, only: output_unit
1376# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1377
1378# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1379 print *, 'm_acoustic_src.fpp:451: ', '@:ALLOCATE(source_spatials(ai)%xyz_to_r_ratios(1:3, 1:count))'
1380# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1381
1382# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1383 call flush (output_unit)
1384# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1385 end block
1386# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1387#endif
1388# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1389 allocate (source_spatials(ai)%xyz_to_r_ratios(1:3, 1:count))
1390# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1391
1392# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1393
1394# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1395#if defined(MFC_OpenACC)
1396# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1397!$acc enter data create(source_spatials(ai)%xyz_to_r_ratios)
1398# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1399#elif defined(MFC_OpenMP)
1400# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1401!$omp target enter data map(always,alloc:source_spatials(ai)%xyz_to_r_ratios)
1402# 451 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1403#endif
1404
1405#ifdef _CRAYFTN
1406# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1407 block
1408# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1409
1410# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1411#ifdef MFC_DEBUG
1412# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1413 block
1414# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1415 use iso_fortran_env, only: output_unit
1416# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1417
1418# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1419 print *, 'm_acoustic_src.fpp:453: ', '@:ACC_SETUP_source_spatials(source_spatials(ai))'
1420# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1421
1422# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1423 call flush (output_unit)
1424# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1425 end block
1426# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1427#endif
1428# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1429
1430# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1431
1432# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1433#if defined(MFC_OpenACC)
1434# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1435!$acc enter data copyin(source_spatials(ai))
1436# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1437#elif defined(MFC_OpenMP)
1438# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1439!$omp target enter data map(to:source_spatials(ai))
1440# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1441#endif
1442# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1443 if (associated(source_spatials(ai)%coord)) then
1444# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1445
1446# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1447#if defined(MFC_OpenACC)
1448# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1449!$acc enter data copyin(source_spatials(ai)%coord)
1450# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1451#elif defined(MFC_OpenMP)
1452# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1453!$omp target enter data map(to:source_spatials(ai)%coord)
1454# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1455#endif
1456# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1457 end if
1458# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1459 if (associated(source_spatials(ai)%val)) then
1460# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1461
1462# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1463#if defined(MFC_OpenACC)
1464# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1465!$acc enter data copyin(source_spatials(ai)%val)
1466# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1467#elif defined(MFC_OpenMP)
1468# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1469!$omp target enter data map(to:source_spatials(ai)%val)
1470# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1471#endif
1472# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1473 end if
1474# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1475 if (associated(source_spatials(ai)%angle)) then
1476# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1477
1478# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1479#if defined(MFC_OpenACC)
1480# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1481!$acc enter data copyin(source_spatials(ai)%angle)
1482# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1483#elif defined(MFC_OpenMP)
1484# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1485!$omp target enter data map(to:source_spatials(ai)%angle)
1486# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1487#endif
1488# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1489 end if
1490# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1491 if (associated(source_spatials(ai)%xyz_to_r_ratios)) then
1492# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1493
1494# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1495#if defined(MFC_OpenACC)
1496# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1497!$acc enter data copyin(source_spatials(ai)%xyz_to_r_ratios)
1498# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1499#elif defined(MFC_OpenMP)
1500# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1501!$omp target enter data map(to:source_spatials(ai)%xyz_to_r_ratios)
1502# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1503#endif
1504# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1505 end if
1506# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1507
1508# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1509 end block
1510# 453 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1511#endif
1512
1513 ! Second pass: Store the values
1514 count = 0 ! Reset counter
1515 do l = 0, p
1516 do k = 0, n
1517 do j = 0, m
1518 call s_source_spatial(j, k, l, loc_acoustic(:, ai), ai, source_spatial, angle, xyz_to_r_ratios)
1519 if (abs(source_spatial) < threshold) cycle
1520 count = count + 1
1521 source_spatials(ai)%coord(1, count) = j
1522 source_spatials(ai)%coord(2, count) = k
1523 source_spatials(ai)%coord(3, count) = l
1524 source_spatials(ai)%val(count) = source_spatial
1525 if (support(ai) >= 5) then
1526 if (dim == 2) source_spatials(ai)%angle(count) = angle
1527 if (dim == 3) source_spatials(ai)%xyz_to_r_ratios(1:3, count) = xyz_to_r_ratios
1528 end if
1529 end do
1530 end do
1531 end do
1532
1533 if (source_spatials_num_points(ai) /= count) then
1534 call s_mpi_abort('Fatal Error: Inconsistent allocation of source_spatials')
1535 end if
1536
1537
1538# 479 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1539#if defined(MFC_OpenACC)
1540# 479 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1541!$acc update device(source_spatials(ai)%coord)
1542# 479 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1543#elif defined(MFC_OpenMP)
1544# 479 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1545!$omp target update to(source_spatials(ai)%coord)
1546# 479 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1547#endif
1548
1549# 480 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1550#if defined(MFC_OpenACC)
1551# 480 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1552!$acc update device(source_spatials(ai)%val)
1553# 480 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1554#elif defined(MFC_OpenMP)
1555# 480 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1556!$omp target update to(source_spatials(ai)%val)
1557# 480 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1558#endif
1559 if (support(ai) >= 5) then
1560 if (dim == 2) then
1561
1562# 483 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1563#if defined(MFC_OpenACC)
1564# 483 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1565!$acc update device(source_spatials(ai)%angle)
1566# 483 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1567#elif defined(MFC_OpenMP)
1568# 483 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1569!$omp target update to(source_spatials(ai)%angle)
1570# 483 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1571#endif
1572 end if
1573 if (dim == 3) then
1574
1575# 486 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1576#if defined(MFC_OpenACC)
1577# 486 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1578!$acc update device(source_spatials(ai)%xyz_to_r_ratios)
1579# 486 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1580#elif defined(MFC_OpenMP)
1581# 486 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1582!$omp target update to(source_spatials(ai)%xyz_to_r_ratios)
1583# 486 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1584#endif
1585 end if
1586 end if
1587
1588 end do
1589
1590#ifdef MFC_DEBUG
1591 do ai = 1, num_source
1592 write (*, '(A,I2,A,I8,A)') 'Acoustic source ', ai, ' has ', source_spatials_num_points(ai), &
1593 ' grid points with non-zero source term'
1594 end do
1595#endif
1596
1597 end subroutine s_precalculate_acoustic_spatial_sources
1598
1599 !> This subroutine gives the spatial support of the acoustic source
1600 !! @param j x-index
1601 !! @param k y-index
1602 !! @param l z-index
1603 !! @param loc Nominal source term location
1604 !! @param ai Acoustic source index
1605 !! @param source Source term amplitude
1606 !! @param angle Angle of the source term with respect to the x-axis (for 2D or 2D axisymmetric)
1607 !! @param xyz_to_r_ratios Ratios of the [xyz]-component of the source term to the magnitude (for 3D)
1608 subroutine s_source_spatial(j, k, l, loc, ai, source, angle, xyz_to_r_ratios)
1609 integer, intent(in) :: j, k, l, ai
1610 real(wp), dimension(3), intent(in) :: loc
1611 real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3)
1612
1613 real(wp) :: sig, r(3)
1614
1615 ! Calculate sig spatial support width
1616 if (n == 0) then
1617 sig = dx(j)
1618 elseif (p == 0) then
1619 sig = maxval((/dx(j), dy(k)/))
1620 else
1621 sig = maxval((/dx(j), dy(k), dz(l)/))
1622 end if
1623 sig = sig*acoustic_spatial_support_width
1624
1625 ! Calculate displacement from acoustic source location
1626 r(1) = x_cc(j) - loc(1)
1627 if (n /= 0) r(2) = y_cc(k) - loc(2)
1628 if (p /= 0) r(3) = z_cc(l) - loc(3)
1629
1630 if (any(support(ai) == (/1, 2, 3, 4/))) then
1631 call s_source_spatial_planar(ai, sig, r, source)
1632 elseif (any(support(ai) == (/5, 6, 7/))) then
1633 call s_source_spatial_transducer(ai, sig, r, source, angle, xyz_to_r_ratios)
1634 elseif (any(support(ai) == (/9, 10, 11/))) then
1635 call s_source_spatial_transducer_array(ai, sig, r, source, angle, xyz_to_r_ratios)
1636 end if
1637 end subroutine s_source_spatial
1638
1639 !> This subroutine calculates the spatial support for planar acoustic sources in 1D, 2D, and 3D
1640 !! @param ai Acoustic source index
1641 !! @param sig Sigma value for the Gaussian distribution
1642 !! @param r Displacement from source to current point
1643 !! @param source Source term amplitude
1644 subroutine s_source_spatial_planar(ai, sig, r, source)
1645 integer, intent(in) :: ai
1646 real(wp), intent(in) :: sig, r(3)
1647 real(wp), intent(out) :: source
1648
1649 real(wp) :: dist
1650
1651 source = 0._wp
1652
1653 if (support(ai) == 1) then ! 1D
1654 source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(r(1)/(sig/2._wp))**2._wp)
1655
1656 elseif (support(ai) == 2 .or. support(ai) == 3) then ! 2D or 3D
1657 ! If we let unit vector e = (cos(dir), sin(dir)),
1658 dist = r(1)*cos(dir(ai)) + r(2)*sin(dir(ai)) ! dot(r,e)
1659 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 ! |r - dist*e| < length/2
1660 if (support(ai) /= 3 .or. abs(r(3)) < 0.25_wp*height(ai)) then ! additional height constraint for 3D
1661 source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
1662 end if
1663 end if
1664 end if
1665 end subroutine s_source_spatial_planar
1666
1667 !> This subroutine calculates the spatial support for a single transducer in 2D, 2D axisymmetric, and 3D
1668 !! @param ai Acoustic source index
1669 !! @param sig Sigma value for the Gaussian distribution
1670 !! @param r Displacement from source to current point
1671 !! @param source Source term amplitude
1672 !! @param angle Angle of the source term with respect to the x-axis (for 2D or 2D axisymmetric)
1673 !! @param xyz_to_r_ratios Ratios of the [xyz]-component of the source term to the magnitude (for 3D)
1674 subroutine s_source_spatial_transducer(ai, sig, r, source, angle, xyz_to_r_ratios)
1675 integer, intent(in) :: ai
1676 real(wp), intent(in) :: sig, r(3)
1677 real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3)
1678
1679 real(wp) :: current_angle, angle_half_aperture, dist, norm
1680
1681 source = 0._wp ! If not affected by transducer
1682 angle = 0._wp
1683 xyz_to_r_ratios = 0._wp
1684
1685 if (support(ai) == 5 .or. support(ai) == 6) then ! 2D or 2D axisymmetric
1686 current_angle = -atan(r(2)/(foc_length(ai) - r(1)))
1687 angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
1688
1689 if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then
1690 dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
1691 source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
1692 angle = -atan(r(2)/(foc_length(ai) - r(1)))
1693 end if
1694
1695 elseif (support(ai) == 7) then ! 3D
1696 current_angle = -atan(sqrt(r(2)**2 + r(3)**2)/(foc_length(ai) - r(1)))
1697 angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
1698
1699 if (abs(current_angle) < angle_half_aperture .and. r(1) < foc_length(ai)) then
1700 dist = foc_length(ai) - sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
1701 source = 1._wp/(sqrt(2._wp*pi)*sig/2._wp)*exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)
1702
1703 norm = sqrt(r(2)**2._wp + r(3)**2._wp + (foc_length(ai) - r(1))**2._wp)
1704 xyz_to_r_ratios(1) = -(r(1) - foc_length(ai))/norm
1705 xyz_to_r_ratios(2) = -r(2)/norm
1706 xyz_to_r_ratios(3) = -r(3)/norm
1707 end if
1708
1709 end if
1710 end subroutine s_source_spatial_transducer
1711
1712 !> This subroutine calculates the spatial support for multiple transducers in 2D, 2D axisymmetric, and 3D
1713 !! @param ai Acoustic source index
1714 !! @param sig Sigma value for the Gaussian distribution
1715 !! @param r Displacement from source to current point
1716 !! @param source Source term amplitude
1717 !! @param angle Angle of the source term with respect to the x-axis (for 2D or 2D axisymmetric)
1718 !! @param xyz_to_r_ratios Ratios of the [xyz]-component of the source term to the magnitude (for 3D)
1719 subroutine s_source_spatial_transducer_array(ai, sig, r, source, angle, xyz_to_r_ratios)
1720 integer, intent(in) :: ai
1721 real(wp), intent(in) :: sig, r(3)
1722 real(wp), intent(out) :: source, angle, xyz_to_r_ratios(3)
1723
1724 integer :: elem, elem_min, elem_max
1725 real(wp) :: current_angle, angle_half_aperture, angle_per_elem, dist
1726 real(wp) :: angle_min, angle_max, norm
1727 real(wp) :: poly_side_length, aperture_element_3D, angle_elem
1728 real(wp) :: x2, y2, z2, x3, y3, z3, C, f, half_apert, dist_interp_to_elem_center
1729
1730 if (element_on(ai) == 0) then ! Full transducer
1731 elem_min = 1
1732 elem_max = num_elements(ai)
1733 else ! Transducer element specified
1734 elem_min = element_on(ai)
1735 elem_max = element_on(ai)
1736 end if
1737
1738 source = 0._wp ! If not affected by any transducer element
1739 angle = 0._wp
1740 xyz_to_r_ratios = 0._wp
1741
1742 if (support(ai) == 9 .or. support(ai) == 10) then ! 2D or 2D axisymmetric
1743 current_angle = -atan(r(2)/(foc_length(ai) - r(1)))
1744 angle_half_aperture = asin((aperture(ai)/2._wp)/(foc_length(ai)))
1745 angle_per_elem = (2._wp*angle_half_aperture - (num_elements(ai) - 1._wp)*element_spacing_angle(ai))/num_elements(ai)
1746 dist = foc_length(ai) - sqrt(r(2)**2._wp + (foc_length(ai) - r(1))**2._wp)
1747
1748 do elem = elem_min, elem_max
1749 angle_max = angle_half_aperture - (element_spacing_angle(ai) + angle_per_elem)*(elem - 1._wp)
1750 angle_min = angle_max - angle_per_elem
1751
1752 if (current_angle > angle_min .and. current_angle < angle_max .and. r(1) < foc_length(ai)) then
1753 source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp)
1754 angle = current_angle
1755 exit ! Assume elements don't overlap
1756 end if
1757 end do
1758
1759 elseif (support(ai) == 11) then ! 3D
1760 poly_side_length = aperture(ai)*sin(pi/num_elements(ai))
1761 aperture_element_3d = poly_side_length*element_polygon_ratio(ai)
1762 f = foc_length(ai)
1763 half_apert = aperture(ai)/2._wp
1764
1765 do elem = elem_min, elem_max
1766 angle_elem = 2._wp*pi*real(elem, wp)/real(num_elements(ai), wp) + rotate_angle(ai)
1767
1768 ! Point 2 is the elem center
1769 x2 = f - sqrt(f**2 - half_apert**2)
1770 y2 = half_apert*cos(angle_elem)
1771 z2 = half_apert*sin(angle_elem)
1772
1773 ! Construct a plane normal to the line from the focal point to the elem center,
1774 ! Point 3 is the intercept of the plane and the line from the focal point to the current location
1775 c = f**2._wp/((r(1) - f)*(x2 - f) + r(2)*y2 + r(3)*z2) ! Constant for intermediate step
1776 x3 = c*(r(1) - f) + f
1777 y3 = c*r(2)
1778 z3 = c*r(3)
1779
1780 dist_interp_to_elem_center = sqrt((x2 - x3)**2._wp + (y2 - y3)**2._wp + (z2 - z3)**2._wp)
1781 if ((dist_interp_to_elem_center < aperture_element_3d/2._wp) .and. (r(1) < f)) then
1782 dist = sqrt((x3 - r(1))**2._wp + (y3 - r(2))**2._wp + (z3 - r(3))**2._wp)
1783 source = exp(-0.5_wp*(dist/(sig/2._wp))**2._wp)/(sqrt(2._wp*pi)*sig/2._wp)
1784
1785 norm = sqrt(r(2)**2._wp + r(3)**2._wp + (f - r(1))**2._wp)
1786 xyz_to_r_ratios(1) = -(r(1) - f)/norm
1787 xyz_to_r_ratios(2) = -r(2)/norm
1788 xyz_to_r_ratios(3) = -r(3)/norm
1789 end if
1790
1791 end do
1792
1793 end if
1794 end subroutine s_source_spatial_transducer_array
1795
1796 !> This function performs wavelength to frequency conversion
1797 !! @param freq_conv_flag Determines if frequency is given or wavelength
1798 !! @param ai Acoustic source index
1799 !! @param c Speed of sound
1800 !! @return frequency_local Converted frequency
1801 elemental function f_frequency_local(freq_conv_flag, ai, c)
1802
1803# 704 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1804#if MFC_OpenACC
1805# 704 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1806!$acc routine seq
1807# 704 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1808#elif MFC_OpenMP
1809# 704 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1810
1811# 704 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1812
1813# 704 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1814!$omp declare target device_type(any)
1815# 704 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1816#endif
1817 logical, intent(in) :: freq_conv_flag
1818 integer, intent(in) :: ai
1819 real(wp), intent(in) :: c
1820 real(wp) :: f_frequency_local
1821
1822 if (freq_conv_flag) then
1823 f_frequency_local = c/wavelength(ai)
1824 else
1825 f_frequency_local = frequency(ai)
1826 end if
1827 end function f_frequency_local
1828
1829 !> This function performs Gaussian sigma dist to time conversion
1830 !! @param gauss_conv_flag Determines if sigma_dist is given or sigma_time
1831 !! @param c Speed of sound
1832 !! @param ai Acoustic source index
1833 !! @return gauss_sigma_time_local Converted Gaussian sigma time
1834 function f_gauss_sigma_time_local(gauss_conv_flag, ai, c)
1835
1836# 723 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1837#if MFC_OpenACC
1838# 723 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1839!$acc routine seq
1840# 723 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1841#elif MFC_OpenMP
1842# 723 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1843
1844# 723 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1845
1846# 723 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1847!$omp declare target device_type(any)
1848# 723 "/home/runner/work/MFC/MFC/src/simulation/m_acoustic_src.fpp"
1849#endif
1850 logical, intent(in) :: gauss_conv_flag
1851 integer, intent(in) :: ai
1852 real(wp), intent(in) :: c
1853 real(wp) :: f_gauss_sigma_time_local
1854
1855 if (gauss_conv_flag) then
1856 f_gauss_sigma_time_local = gauss_sigma_dist(ai)/c
1857 else
1858 f_gauss_sigma_time_local = gauss_sigma_time(ai)
1859 end if
1860 end function f_gauss_sigma_time_local
1861
1862end module m_acoustic_src
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1119
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1121
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1121
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1121
m_acoustic_src
Applies acoustic pressure source terms including focused, planar, and broadband transducers.
Definition m_acoustic_src.fpp.f90:292
m_acoustic_src::gauss_sigma_time
real(wp), dimension(:), allocatable gauss_sigma_time
Definition m_acoustic_src.fpp.f90:349
m_acoustic_src::loc_acoustic
real(wp), dimension(:, :), allocatable, target loc_acoustic
Definition m_acoustic_src.fpp.f90:335
m_acoustic_src::f_frequency_local
elemental real(wp) function f_frequency_local(freq_conv_flag, ai, c)
This function performs wavelength to frequency conversion.
Definition m_acoustic_src.fpp.f90:1802
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:455
m_acoustic_src::s_source_spatial_transducer
subroutine s_source_spatial_transducer(ai, sig, r, source, angle, xyz_to_r_ratios)
This subroutine calculates the spatial support for a single transducer in 2D, 2D axisymmetric,...
Definition m_acoustic_src.fpp.f90:1675
m_acoustic_src::height
real(wp), dimension(:), allocatable height
Definition m_acoustic_src.fpp.f90:348
m_acoustic_src::mass_src
real(wp), dimension(:, :, :), allocatable mass_src
Definition m_acoustic_src.fpp.f90:427
m_acoustic_src::pulse
integer, dimension(:), allocatable pulse
Definition m_acoustic_src.fpp.f90:309
m_acoustic_src::mom_src
real(wp), dimension(:, :, :, :), allocatable mom_src
Definition m_acoustic_src.fpp.f90:428
m_acoustic_src::bb_num_freq
integer, dimension(:), allocatable bb_num_freq
Definition m_acoustic_src.fpp.f90:412
m_acoustic_src::dir
real(wp), dimension(:), allocatable dir
Definition m_acoustic_src.fpp.f90:349
m_acoustic_src::s_precalculate_acoustic_spatial_sources
impure subroutine, public s_precalculate_acoustic_spatial_sources
This subroutine identifies and precalculates the non-zero acoustic spatial sources before time-steppi...
Definition m_acoustic_src.fpp.f90:1175
m_acoustic_src::length
real(wp), dimension(:), allocatable length
Definition m_acoustic_src.fpp.f90:348
m_acoustic_src::rotate_angle
real(wp), dimension(:), allocatable rotate_angle
Definition m_acoustic_src.fpp.f90:386
m_acoustic_src::support
integer, dimension(:), allocatable support
Definition m_acoustic_src.fpp.f90:309
m_acoustic_src::wavelength
real(wp), dimension(:), allocatable wavelength
Definition m_acoustic_src.fpp.f90:348
m_acoustic_src::npulse
real(wp), dimension(:), allocatable npulse
Definition m_acoustic_src.fpp.f90:349
m_acoustic_src::element_on
integer, dimension(:), allocatable element_on
Definition m_acoustic_src.fpp.f90:412
m_acoustic_src::aperture
real(wp), dimension(:), allocatable aperture
Definition m_acoustic_src.fpp.f90:373
m_acoustic_src::foc_length
real(wp), dimension(:), allocatable foc_length
Definition m_acoustic_src.fpp.f90:373
m_acoustic_src::s_source_spatial_planar
subroutine s_source_spatial_planar(ai, sig, r, source)
This subroutine calculates the spatial support for planar acoustic sources in 1D, 2D,...
Definition m_acoustic_src.fpp.f90:1645
m_acoustic_src::s_source_spatial_transducer_array
subroutine s_source_spatial_transducer_array(ai, sig, r, source, angle, xyz_to_r_ratios)
This subroutine calculates the spatial support for multiple transducers in 2D, 2D axisymmetric,...
Definition m_acoustic_src.fpp.f90:1720
m_acoustic_src::bb_lowest_freq
real(wp), dimension(:), allocatable bb_lowest_freq
Definition m_acoustic_src.fpp.f90:399
m_acoustic_src::num_elements
integer, dimension(:), allocatable num_elements
Definition m_acoustic_src.fpp.f90:412
m_acoustic_src::s_initialize_acoustic_src
impure subroutine, public s_initialize_acoustic_src
This subroutine initializes the acoustic source module.
Definition m_acoustic_src.fpp.f90:472
m_acoustic_src::s_acoustic_src_calculations
impure subroutine, public s_acoustic_src_calculations(q_cons_vf, q_prim_vf, t_step, rhs_vf)
This subroutine updates the rhs by computing the mass, mom, energy sources.
Definition m_acoustic_src.fpp.f90:714
m_acoustic_src::e_src
real(wp), dimension(:, :, :), allocatable e_src
Definition m_acoustic_src.fpp.f90:427
m_acoustic_src::dipole
logical, dimension(:), allocatable dipole
Definition m_acoustic_src.fpp.f90:322
m_acoustic_src::mag
real(wp), dimension(:), allocatable mag
Definition m_acoustic_src.fpp.f90:348
m_acoustic_src::frequency
real(wp), dimension(:), allocatable frequency
Definition m_acoustic_src.fpp.f90:348
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)
This subroutine gives the temporally varying amplitude of the pulse.
Definition m_acoustic_src.fpp.f90:1101
m_acoustic_src::f_gauss_sigma_time_local
real(wp) function f_gauss_sigma_time_local(gauss_conv_flag, ai, c)
This function performs Gaussian sigma dist to time conversion.
Definition m_acoustic_src.fpp.f90:1835
m_acoustic_src::s_source_spatial
subroutine s_source_spatial(j, k, l, loc, ai, source, angle, xyz_to_r_ratios)
This subroutine gives the spatial support of the acoustic source.
Definition m_acoustic_src.fpp.f90:1609
m_acoustic_src::element_spacing_angle
real(wp), dimension(:), allocatable element_spacing_angle
Definition m_acoustic_src.fpp.f90:386
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:442
m_acoustic_src::element_polygon_ratio
real(wp), dimension(:), allocatable element_polygon_ratio
Definition m_acoustic_src.fpp.f90:386
m_acoustic_src::bb_bandwidth
real(wp), dimension(:), allocatable bb_bandwidth
Definition m_acoustic_src.fpp.f90:399
m_acoustic_src::gauss_sigma_dist
real(wp), dimension(:), allocatable gauss_sigma_dist
Definition m_acoustic_src.fpp.f90:349
m_acoustic_src::delay
real(wp), dimension(:), allocatable delay
Definition m_acoustic_src.fpp.f90:349
m_bubbles
Shared bubble-dynamics procedures (radial acceleration, wall pressure, sound speed) for ensemble- and...
Definition m_bubbles.fpp.f90:292
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:23
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:292
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:303
m_global_parameters::num_source
integer num_source
Number of acoustic sources.
Definition m_global_parameters.fpp.f90:1256
m_global_parameters::acoustic
type(acoustic_parameters), dimension(num_probes_max) acoustic
Acoustic source parameters.
Definition m_global_parameters.fpp.f90:1255
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:292
m_helper_basic::f_is_default
logical elemental function, public f_is_default(var)
Checks if a real(wp) variable is of default value.
Definition m_helper_basic.fpp.f90:395
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:303
m_derived_types::source_spatial_type
Acoustic source source_spatial pre-calculated values.
Definition m_derived_types.fpp.f90:718