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