Loading [MathJax]/extensions/tex2jax.js
Neko 0.9.99
A portable framework for high-order spectral element flow simulations
All Classes Namespaces Files Functions Variables Typedefs Enumerator Macros Pages
euler_res_device.F90
Go to the documentation of this file.
1! Copyright (c) 2025, The Neko Authors
2! All rights reserved.
3!
4! Redistribution and use in source and binary forms, with or without
5! modification, are permitted provided that the following conditions
6! are met:
7!
8! * Redistributions of source code must retain the above copyright
9! notice, this list of conditions and the following disclaimer.
10!
11! * Redistributions in binary form must reproduce the above
12! copyright notice, this list of conditions and the following
13! disclaimer in the documentation and/or other materials provided
14! with the distribution.
15!
16! * Neither the name of the authors nor the names of its
17! contributors may be used to endorse or promote products derived
18! from this software without specific prior written permission.
19!
20! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31! POSSIBILITY OF SUCH DAMAGE.
32!
34 use euler_residual, only : euler_rhs_t
35 use field, only : field_t
36 use ax_product, only : ax_t
37 use coefs, only : coef_t
38 use gather_scatter, only : gs_t, gs_op_add
39 use num_types, only : rp, c_rp
41 use utils, only : neko_error
42 use, intrinsic :: iso_c_binding, only : c_ptr, c_int
43 use operators, only : div
44 use field_math, only : field_cmult
46 use field_list, only : field_list_t
47 use device_math, only : device_copy
48
49 type, public, extends(euler_rhs_t) :: euler_res_device_t
50 contains
51 procedure, nopass :: step => advance_primitive_variables_device
52 procedure, nopass :: evaluate_rhs_device
53 end type euler_res_device_t
54
55#ifdef HAVE_HIP
56 interface
57 subroutine euler_res_part_visc_hip(rhs_field_d, Binv_d, field_d, &
58 h, c_avisc_low, n) &
59 bind(c, name = 'euler_res_part_visc_hip')
60 use, intrinsic :: iso_c_binding
61 import c_rp
62 implicit none
63 type(c_ptr), value :: rhs_field_d, Binv_d, field_d, h
64 real(c_rp) :: c_avisc_low
65 integer(c_int) :: n
66 end subroutine euler_res_part_visc_hip
67 end interface
68
69 interface
70 subroutine euler_res_part_mx_flux_hip(f_x, f_y, f_z, &
71 m_x, m_y, m_z, rho_field, p, n) &
72 bind(c, name = 'euler_res_part_mx_flux_hip')
73 use, intrinsic :: iso_c_binding
74 implicit none
75 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
76 integer(c_int) :: n
77 end subroutine euler_res_part_mx_flux_hip
78 end interface
79
80 interface
81 subroutine euler_res_part_my_flux_hip(f_x, f_y, f_z, &
82 m_x, m_y, m_z, rho_field, p, n) &
83 bind(c, name = 'euler_res_part_my_flux_hip')
84 use, intrinsic :: iso_c_binding
85 implicit none
86 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
87 integer(c_int) :: n
88 end subroutine euler_res_part_my_flux_hip
89 end interface
90
91 interface
92 subroutine euler_res_part_mz_flux_hip(f_x, f_y, f_z, &
93 m_x, m_y, m_z, rho_field, p, n) &
94 bind(c, name = 'euler_res_part_mz_flux_hip')
95 use, intrinsic :: iso_c_binding
96 implicit none
97 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
98 integer(c_int) :: n
99 end subroutine euler_res_part_mz_flux_hip
100 end interface
101
102 interface
103 subroutine euler_res_part_e_flux_hip(f_x, f_y, f_z, &
104 m_x, m_y, m_z, rho_field, p, E, n) &
105 bind(c, name = 'euler_res_part_E_flux_hip')
106 use, intrinsic :: iso_c_binding
107 implicit none
108 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p, E
109 integer(c_int) :: n
110 end subroutine euler_res_part_e_flux_hip
111 end interface
112
113 interface
114 subroutine euler_res_part_coef_mult_hip(rhs_rho_field_d, rhs_m_x_d, &
115 rhs_m_y_d, rhs_m_z_d, &
116 rhs_E_d, mult_d, n) &
117 bind(c, name = 'euler_res_part_coef_mult_hip')
118 use, intrinsic :: iso_c_binding
119 implicit none
120 type(c_ptr), value :: rhs_rho_field_d, rhs_m_x_d, rhs_m_y_d, rhs_m_z_d, &
121 rhs_E_d, mult_d
122 integer(c_int) :: n
123 end subroutine euler_res_part_coef_mult_hip
124 end interface
125
126 interface
127 subroutine euler_res_part_rk_sum_hip(rho, m_x, m_y, m_z, E, &
128 k_rho_i, k_m_x_i, k_m_y_i, &
129 k_m_z_i, k_E_i, &
130 dt, b_i, n) &
131 bind(c, name = 'euler_res_part_rk_sum_hip')
132 use, intrinsic :: iso_c_binding
133 import c_rp
134 implicit none
135 type(c_ptr), value :: rho, m_x, m_y, m_z, E, &
136 k_rho_i, k_m_x_i, k_m_y_i, &
137 k_m_z_i, k_E_i
138 real(c_rp) :: dt, b_i
139 integer(c_int) :: n
140 end subroutine euler_res_part_rk_sum_hip
141 end interface
142#elif HAVE_CUDA
143 interface
144 subroutine euler_res_part_visc_cuda(rhs_field_d, Binv_d, field_d, &
145 h, c_avisc_low, n) &
146 bind(c, name = 'euler_res_part_visc_cuda')
147 use, intrinsic :: iso_c_binding
148 import c_rp
149 implicit none
150 type(c_ptr), value :: rhs_field_d, Binv_d, field_d, h
151 real(c_rp) :: c_avisc_low
152 integer(c_int) :: n
153 end subroutine euler_res_part_visc_cuda
154 end interface
155
156 interface
157 subroutine euler_res_part_mx_flux_cuda(f_x, f_y, f_z, &
158 m_x, m_y, m_z, rho_field, p, n) &
159 bind(c, name = 'euler_res_part_mx_flux_cuda')
160 use, intrinsic :: iso_c_binding
161 implicit none
162 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
163 integer(c_int) :: n
164 end subroutine euler_res_part_mx_flux_cuda
165 end interface
166
167 interface
168 subroutine euler_res_part_my_flux_cuda(f_x, f_y, f_z, &
169 m_x, m_y, m_z, rho_field, p, n) &
170 bind(c, name = 'euler_res_part_my_flux_cuda')
171 use, intrinsic :: iso_c_binding
172 implicit none
173 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
174 integer(c_int) :: n
175 end subroutine euler_res_part_my_flux_cuda
176 end interface
177
178 interface
179 subroutine euler_res_part_mz_flux_cuda(f_x, f_y, f_z, &
180 m_x, m_y, m_z, rho_field, p, n) &
181 bind(c, name = 'euler_res_part_mz_flux_cuda')
182 use, intrinsic :: iso_c_binding
183 implicit none
184 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
185 integer(c_int) :: n
186 end subroutine euler_res_part_mz_flux_cuda
187 end interface
188
189 interface
190 subroutine euler_res_part_e_flux_cuda(f_x, f_y, f_z, &
191 m_x, m_y, m_z, rho_field, p, E, n) &
192 bind(c, name = 'euler_res_part_E_flux_cuda')
193 use, intrinsic :: iso_c_binding
194 implicit none
195 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p, E
196 integer(c_int) :: n
197 end subroutine euler_res_part_e_flux_cuda
198 end interface
199
200 interface
201 subroutine euler_res_part_coef_mult_cuda(rhs_rho_field_d, &
202 rhs_m_x_d, rhs_m_y_d, rhs_m_z_d, &
203 rhs_E_d, mult_d, n) &
204 bind(c, name = 'euler_res_part_coef_mult_cuda')
205 use, intrinsic :: iso_c_binding
206 implicit none
207 type(c_ptr), value :: rhs_rho_field_d, rhs_m_x_d, rhs_m_y_d, rhs_m_z_d, &
208 rhs_E_d, mult_d
209 integer(c_int) :: n
210 end subroutine euler_res_part_coef_mult_cuda
211 end interface
212
213 interface
214 subroutine euler_res_part_rk_sum_cuda(rho, m_x, m_y, m_z, E, &
215 k_rho_i, k_m_x_i, k_m_y_i, &
216 k_m_z_i, k_E_i, &
217 dt, c, n) &
218 bind(c, name = 'euler_res_part_rk_sum_cuda')
219 use, intrinsic :: iso_c_binding
220 import c_rp
221 implicit none
222 type(c_ptr), value :: rho, m_x, m_y, m_z, E, &
223 k_rho_i, k_m_x_i, k_m_y_i, &
224 k_m_z_i, k_E_i
225 real(c_rp) :: dt, c
226 integer(c_int) :: n
227 end subroutine euler_res_part_rk_sum_cuda
228 end interface
229#elif HAVE_OPENCL
230 interface
231 subroutine euler_res_part_visc_opencl(rhs_field_d, Binv_d, field_d, &
232 h, c_avisc_low, n) &
233 bind(c, name = 'euler_res_part_visc_opencl')
234 use, intrinsic :: iso_c_binding
235 import c_rp
236 implicit none
237 type(c_ptr), value :: rhs_field_d, Binv_d, field_d, h
238 real(c_rp) :: c_avisc_low
239 integer(c_int) :: n
240 end subroutine euler_res_part_visc_opencl
241 end interface
242
243 interface
244 subroutine euler_res_part_mx_flux_opencl(f_x, f_y, f_z, &
245 m_x, m_y, m_z, rho_field, p, n) &
246 bind(c, name = 'euler_res_part_mx_flux_opencl')
247 use, intrinsic :: iso_c_binding
248 implicit none
249 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
250 integer(c_int) :: n
251 end subroutine euler_res_part_mx_flux_opencl
252 end interface
253
254 interface
255 subroutine euler_res_part_my_flux_opencl(f_x, f_y, f_z, &
256 m_x, m_y, m_z, rho_field, p, n) &
257 bind(c, name = 'euler_res_part_my_flux_opencl')
258 use, intrinsic :: iso_c_binding
259 implicit none
260 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
261 integer(c_int) :: n
262 end subroutine euler_res_part_my_flux_opencl
263 end interface
264
265 interface
266 subroutine euler_res_part_mz_flux_opencl(f_x, f_y, f_z, &
267 m_x, m_y, m_z, rho_field, p, n) &
268 bind(c, name = 'euler_res_part_mz_flux_opencl')
269 use, intrinsic :: iso_c_binding
270 implicit none
271 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p
272 integer(c_int) :: n
273 end subroutine euler_res_part_mz_flux_opencl
274 end interface
275
276 interface
277 subroutine euler_res_part_e_flux_opencl(f_x, f_y, f_z, &
278 m_x, m_y, m_z, rho_field, p, E, n) &
279 bind(c, name = 'euler_res_part_E_flux_opencl')
280 use, intrinsic :: iso_c_binding
281 implicit none
282 type(c_ptr), value :: f_x, f_y, f_z, m_x, m_y, m_z, rho_field, p, E
283 integer(c_int) :: n
284 end subroutine euler_res_part_e_flux_opencl
285 end interface
286
287 interface
288 subroutine euler_res_part_coef_mult_opencl(rhs_rho_field_d, &
289 rhs_m_x_d, rhs_m_y_d, rhs_m_z_d, &
290 rhs_E_d, mult_d, n) &
291 bind(c, name = 'euler_res_part_coef_mult_opencl')
292 use, intrinsic :: iso_c_binding
293 implicit none
294 type(c_ptr), value :: rhs_rho_field_d, rhs_m_x_d, rhs_m_y_d, rhs_m_z_d, &
295 rhs_E_d, mult_d
296 integer(c_int) :: n
298 end interface
299
300 interface
301 subroutine euler_res_part_rk_sum_opencl(rho, m_x, m_y, m_z, E, &
302 k_rho_i, k_m_x_i, k_m_y_i, &
303 k_m_z_i, k_E_i, &
304 dt, c, n) &
305 bind(c, name = 'euler_res_part_rk_sum_opencl')
306 use, intrinsic :: iso_c_binding
307 import c_rp
308 implicit none
309 type(c_ptr), value :: rho, m_x, m_y, m_z, E, &
310 k_rho_i, k_m_x_i, k_m_y_i, &
311 k_m_z_i, k_E_i
312 real(c_rp) :: dt, c
313 integer(c_int) :: n
314 end subroutine euler_res_part_rk_sum_opencl
315 end interface
316#endif
317
318contains
320 m_x, m_y, m_z, E, p, u, v, w, Ax, &
321 coef, gs, h, c_avisc_low, rk_scheme, dt)
322 type(field_t), intent(inout) :: rho_field, m_x, m_y, m_z, E
323 type(field_t), intent(in) :: p, u, v, w, h
324 class(ax_t), intent(inout) :: Ax
325 type(coef_t), intent(inout) :: coef
326 type(gs_t), intent(inout) :: gs
327 real(kind=rp) :: c_avisc_low
328 class(runge_kutta_time_scheme_t), intent(in) :: rk_scheme
329 real(kind=rp), intent(in) :: dt
330 integer :: n, s, i, j, k
331 real(kind=rp) :: t, c
332 type(field_t), pointer :: k_rho_1, k_rho_2, k_rho_3, k_rho_4, &
333 k_m_x_1, k_m_x_2, k_m_x_3, k_m_x_4, &
334 k_m_y_1, k_m_y_2, k_m_y_3, k_m_y_4, &
335 k_m_z_1, k_m_z_2, k_m_z_3, k_m_z_4, &
336 k_e_1, k_e_2, k_e_3, k_e_4, &
337 temp_rho, temp_m_x, temp_m_y, temp_m_z, temp_e
338 integer :: temp_indices(25)
339 type(field_list_t) :: k_rho, k_m_x, k_m_y, k_m_z, k_E
340
341 n = p%dof%size()
342 s = rk_scheme%order
343 call neko_scratch_registry%request_field(k_rho_1, temp_indices(1))
344 call neko_scratch_registry%request_field(k_rho_2, temp_indices(2))
345 call neko_scratch_registry%request_field(k_rho_3, temp_indices(3))
346 call neko_scratch_registry%request_field(k_rho_4, temp_indices(4))
347 call neko_scratch_registry%request_field(k_m_x_1, temp_indices(5))
348 call neko_scratch_registry%request_field(k_m_x_2, temp_indices(6))
349 call neko_scratch_registry%request_field(k_m_x_3, temp_indices(7))
350 call neko_scratch_registry%request_field(k_m_x_4, temp_indices(8))
351 call neko_scratch_registry%request_field(k_m_y_1, temp_indices(9))
352 call neko_scratch_registry%request_field(k_m_y_2, temp_indices(10))
353 call neko_scratch_registry%request_field(k_m_y_3, temp_indices(11))
354 call neko_scratch_registry%request_field(k_m_y_4, temp_indices(12))
355 call neko_scratch_registry%request_field(k_m_z_1, temp_indices(13))
356 call neko_scratch_registry%request_field(k_m_z_2, temp_indices(14))
357 call neko_scratch_registry%request_field(k_m_z_3, temp_indices(15))
358 call neko_scratch_registry%request_field(k_m_z_4, temp_indices(16))
359 call neko_scratch_registry%request_field(k_e_1, temp_indices(17))
360 call neko_scratch_registry%request_field(k_e_2, temp_indices(18))
361 call neko_scratch_registry%request_field(k_e_3, temp_indices(19))
362 call neko_scratch_registry%request_field(k_e_4, temp_indices(20))
363 call neko_scratch_registry%request_field(temp_rho, temp_indices(21))
364 call neko_scratch_registry%request_field(temp_m_x, temp_indices(22))
365 call neko_scratch_registry%request_field(temp_m_y, temp_indices(23))
366 call neko_scratch_registry%request_field(temp_m_z, temp_indices(24))
367 call neko_scratch_registry%request_field(temp_e, temp_indices(25))
368
369 call k_rho%init(4)
370 call k_rho%assign(1, k_rho_1)
371 call k_rho%assign(2, k_rho_2)
372 call k_rho%assign(3, k_rho_3)
373 call k_rho%assign(4, k_rho_4)
374 call k_m_x%init(4)
375 call k_m_x%assign(1, k_m_x_1)
376 call k_m_x%assign(2, k_m_x_2)
377 call k_m_x%assign(3, k_m_x_3)
378 call k_m_x%assign(4, k_m_x_4)
379 call k_m_y%init(4)
380 call k_m_y%assign(1, k_m_y_1)
381 call k_m_y%assign(2, k_m_y_2)
382 call k_m_y%assign(3, k_m_y_3)
383 call k_m_y%assign(4, k_m_y_4)
384 call k_m_z%init(4)
385 call k_m_z%assign(1, k_m_z_1)
386 call k_m_z%assign(2, k_m_z_2)
387 call k_m_z%assign(3, k_m_z_3)
388 call k_m_z%assign(4, k_m_z_4)
389 call k_e%init(4)
390 call k_e%assign(1, k_e_1)
391 call k_e%assign(2, k_e_2)
392 call k_e%assign(3, k_e_3)
393 call k_e%assign(4, k_e_4)
394
395 ! Runge-Kutta stages
396 do i = 1, s
397 call device_copy(temp_rho%x_d, rho_field%x_d, n)
398 call device_copy(temp_m_x%x_d, m_x%x_d, n)
399 call device_copy(temp_m_y%x_d, m_y%x_d, n)
400 call device_copy(temp_m_z%x_d, m_z%x_d, n)
401 call device_copy(temp_e%x_d, e%x_d, n)
402
403 do j = 1, i-1
404#ifdef HAVE_HIP
405 call euler_res_part_rk_sum_hip(temp_rho%x_d, temp_m_x%x_d, temp_m_y%x_d, &
406 temp_m_z%x_d, temp_e%x_d, &
407 k_rho%items(j)%ptr%x_d, k_m_x%items(j)%ptr%x_d, k_m_y%items(j)%ptr%x_d, &
408 k_m_z%items(j)%ptr%x_d, k_e%items(j)%ptr%x_d, &
409 dt, rk_scheme%coeffs_A(i, j), n)
410#elif HAVE_CUDA
411 call euler_res_part_rk_sum_cuda(temp_rho%x_d, temp_m_x%x_d, temp_m_y%x_d, &
412 temp_m_z%x_d, temp_e%x_d, &
413 k_rho%items(j)%ptr%x_d, k_m_x%items(j)%ptr%x_d, k_m_y%items(j)%ptr%x_d, &
414 k_m_z%items(j)%ptr%x_d, k_e%items(j)%ptr%x_d, &
415 dt, rk_scheme%coeffs_A(i, j), n)
416#elif HAVE_OPENCL
417 call euler_res_part_rk_sum_opencl(temp_rho%x_d, temp_m_x%x_d, temp_m_y%x_d, &
418 temp_m_z%x_d, temp_e%x_d, &
419 k_rho%items(j)%ptr%x_d, k_m_x%items(j)%ptr%x_d, k_m_y%items(j)%ptr%x_d, &
420 k_m_z%items(j)%ptr%x_d, k_e%items(j)%ptr%x_d, &
421 dt, rk_scheme%coeffs_A(i, j), n)
422#endif
423 end do
424
425 ! Compute f(U) = rhs(U) for the intermediate values
426 call evaluate_rhs_device(k_rho%items(i)%ptr, k_m_x%items(i)%ptr, &
427 k_m_y%items(i)%ptr, k_m_z%items(i)%ptr, k_e%items(i)%ptr, &
428 temp_rho, temp_m_x, temp_m_y, temp_m_z, temp_e, &
429 p, u, v, w, ax, &
430 coef, gs, h, c_avisc_low)
431 end do
432
433 ! Update the solution
434 do i = 1, s
435#ifdef HAVE_HIP
436 call euler_res_part_rk_sum_hip(rho_field%x_d, &
437 m_x%x_d, m_y%x_d, m_z%x_d, e%x_d, &
438 k_rho%items(i)%ptr%x_d, k_m_x%items(i)%ptr%x_d, k_m_y%items(i)%ptr%x_d, &
439 k_m_z%items(i)%ptr%x_d, k_e%items(i)%ptr%x_d, &
440 dt, rk_scheme%coeffs_b(i), n)
441#elif HAVE_CUDA
442 call euler_res_part_rk_sum_cuda(rho_field%x_d, &
443 m_x%x_d, m_y%x_d, m_z%x_d, e%x_d, &
444 k_rho%items(i)%ptr%x_d, k_m_x%items(i)%ptr%x_d, k_m_y%items(i)%ptr%x_d, &
445 k_m_z%items(i)%ptr%x_d, k_e%items(i)%ptr%x_d, &
446 dt, rk_scheme%coeffs_b(i), n)
447#elif HAVE_OPENCL
448 call euler_res_part_rk_sum_opencl(rho_field%x_d, &
449 m_x%x_d, m_y%x_d, m_z%x_d, e%x_d, &
450 k_rho%items(i)%ptr%x_d, k_m_x%items(i)%ptr%x_d, k_m_y%items(i)%ptr%x_d, &
451 k_m_z%items(i)%ptr%x_d, k_e%items(i)%ptr%x_d, &
452 dt, rk_scheme%coeffs_b(i), n)
453#endif
454 end do
455
456 call neko_scratch_registry%relinquish_field(temp_indices)
458
459 subroutine evaluate_rhs_device(rhs_rho_field, rhs_m_x, rhs_m_y, &
460 rhs_m_z, rhs_E, rho_field, &
461 m_x, m_y, m_z, E, p, u, v, w, Ax, &
462 coef, gs, h, c_avisc_low)
463 type(field_t), intent(inout) :: rhs_rho_field, rhs_m_x, rhs_m_y, rhs_m_z, rhs_E
464 type(field_t), intent(inout) :: rho_field, m_x, m_y, m_z, E
465 type(field_t), intent(in) :: p, u, v, w, h
466 class(ax_t), intent(inout) :: Ax
467 type(coef_t), intent(inout) :: coef
468 type(gs_t), intent(inout) :: gs
469 real(kind=rp) :: c_avisc_low
470 integer :: n
471 type(field_t), pointer :: temp, f_x, f_y, f_z, &
472 visc_rho, visc_m_x, visc_m_y, visc_m_z, visc_E
473 integer :: temp_indices(9)
474
475 n = coef%dof%size()
476 call neko_scratch_registry%request_field(temp, temp_indices(1))
477 call neko_scratch_registry%request_field(f_x, temp_indices(2))
478 call neko_scratch_registry%request_field(f_y, temp_indices(3))
479 call neko_scratch_registry%request_field(f_z, temp_indices(4))
480
482 call div(rhs_rho_field%x, m_x%x, m_y%x, m_z%x, coef)
483
485 ! m_x
486#ifdef HAVE_HIP
487 call euler_res_part_mx_flux_hip(f_x%x_d, f_y%x_d, f_z%x_d, &
488 m_x%x_d, m_y%x_d, m_z%x_d, rho_field%x_d, p%x_d, n)
489#elif HAVE_CUDA
490 call euler_res_part_mx_flux_cuda(f_x%x_d, f_y%x_d, f_z%x_d, &
491 m_x%x_d, m_y%x_d, m_z%x_d, rho_field%x_d, p%x_d, n)
492#elif HAVE_OPENCL
493 call euler_res_part_mx_flux_opencl(f_x%x_d, f_y%x_d, f_z%x_d, &
494 m_x%x_d, m_y%x_d, m_z%x_d, rho_field%x_d, p%x_d, n)
495#endif
496 call div(rhs_m_x%x, f_x%x, f_y%x, f_z%x, coef)
497 ! m_y
498#ifdef HAVE_HIP
499 call euler_res_part_my_flux_hip(f_x%x_d, f_y%x_d, f_z%x_d, &
500 m_x%x_d, m_y%x_d, m_z%x_d, &
501 rho_field%x_d, p%x_d, n)
502#elif HAVE_CUDA
503 call euler_res_part_my_flux_cuda(f_x%x_d, f_y%x_d, f_z%x_d, &
504 m_x%x_d, m_y%x_d, m_z%x_d, &
505 rho_field%x_d, p%x_d, n)
506#elif HAVE_OPENCL
507 call euler_res_part_my_flux_opencl(f_x%x_d, f_y%x_d, f_z%x_d, &
508 m_x%x_d, m_y%x_d, m_z%x_d, &
509 rho_field%x_d, p%x_d, n)
510#endif
511 call div(rhs_m_y%x, f_x%x, f_y%x, f_z%x, coef)
512 ! m_z
513#ifdef HAVE_HIP
514 call euler_res_part_mz_flux_hip(f_x%x_d, f_y%x_d, f_z%x_d, &
515 m_x%x_d, m_y%x_d, m_z%x_d, &
516 rho_field%x_d, p%x_d, n)
517#elif HAVE_CUDA
518 call euler_res_part_mz_flux_cuda(f_x%x_d, f_y%x_d, f_z%x_d, &
519 m_x%x_d, m_y%x_d, m_z%x_d, &
520 rho_field%x_d, p%x_d, n)
521#elif HAVE_OPENCL
522 call euler_res_part_mz_flux_opencl(f_x%x_d, f_y%x_d, f_z%x_d, &
523 m_x%x_d, m_y%x_d, m_z%x_d, &
524 rho_field%x_d, p%x_d, n)
525#endif
526 call div(rhs_m_z%x, f_x%x, f_y%x, f_z%x, coef)
527
529#ifdef HAVE_HIP
530 call euler_res_part_e_flux_hip(f_x%x_d, f_y%x_d, f_z%x_d, &
531 m_x%x_d, m_y%x_d, m_z%x_d, &
532 rho_field%x_d, p%x_d, e%x_d, n)
533#elif HAVE_CUDA
534 call euler_res_part_e_flux_cuda(f_x%x_d, f_y%x_d, f_z%x_d, &
535 m_x%x_d, m_y%x_d, m_z%x_d, &
536 rho_field%x_d, p%x_d, e%x_d, n)
537#elif HAVE_OPENCL
538 call euler_res_part_e_flux_opencl(f_x%x_d, f_y%x_d, f_z%x_d, &
539 m_x%x_d, m_y%x_d, m_z%x_d, &
540 rho_field%x_d, p%x_d, e%x_d, n)
541#endif
542 call div(rhs_e%x, f_x%x, f_y%x, f_z%x, coef)
543
544 call gs%op(rhs_rho_field, gs_op_add)
545 call gs%op(rhs_m_x, gs_op_add)
546 call gs%op(rhs_m_y, gs_op_add)
547 call gs%op(rhs_m_z, gs_op_add)
548 call gs%op(rhs_e, gs_op_add)
549
550#ifdef HAVE_HIP
551 call euler_res_part_coef_mult_hip(rhs_rho_field%x_d, rhs_m_x%x_d, &
552 rhs_m_y%x_d, rhs_m_z%x_d, &
553 rhs_e%x_d, coef%mult_d, n)
554#elif HAVE_CUDA
555 call euler_res_part_coef_mult_cuda(rhs_rho_field%x_d, rhs_m_x%x_d, &
556 rhs_m_y%x_d, rhs_m_z%x_d, &
557 rhs_e%x_d, coef%mult_d, n)
558#elif HAVE_OPENCL
559 call euler_res_part_coef_mult_opencl(rhs_rho_field%x_d, rhs_m_x%x_d, &
560 rhs_m_y%x_d, rhs_m_z%x_d, &
561 rhs_e%x_d, coef%mult_d, n)
562#endif
563
564 call neko_scratch_registry%request_field(visc_rho, temp_indices(5))
565 call neko_scratch_registry%request_field(visc_m_x, temp_indices(6))
566 call neko_scratch_registry%request_field(visc_m_y, temp_indices(7))
567 call neko_scratch_registry%request_field(visc_m_z, temp_indices(8))
568 call neko_scratch_registry%request_field(visc_e, temp_indices(9))
569
570 ! Calculate artificial diffusion
571 call ax%compute(visc_rho%x, rho_field%x, coef, p%msh, p%Xh)
572 call ax%compute(visc_m_x%x, m_x%x, coef, p%msh, p%Xh)
573 call ax%compute(visc_m_y%x, m_y%x, coef, p%msh, p%Xh)
574 call ax%compute(visc_m_z%x, m_z%x, coef, p%msh, p%Xh)
575 call ax%compute(visc_e%x, e%x, coef, p%msh, p%Xh)
576
577 call gs%op(visc_rho, gs_op_add)
578 call gs%op(visc_m_x, gs_op_add)
579 call gs%op(visc_m_y, gs_op_add)
580 call gs%op(visc_m_z, gs_op_add)
581 call gs%op(visc_e, gs_op_add)
582
583#ifdef HAVE_HIP
584 call euler_res_part_visc_hip(rhs_rho_field%x_d, coef%Binv_d, &
585 visc_rho%x_d, h%x_d, c_avisc_low, n)
586 call euler_res_part_visc_hip(rhs_m_x%x_d, coef%Binv_d, &
587 visc_m_x%x_d, h%x_d, c_avisc_low, n)
588 call euler_res_part_visc_hip(rhs_m_y%x_d, coef%Binv_d, &
589 visc_m_y%x_d, h%x_d, c_avisc_low, n)
590 call euler_res_part_visc_hip(rhs_m_z%x_d, coef%Binv_d, &
591 visc_m_z%x_d, h%x_d, c_avisc_low, n)
592 call euler_res_part_visc_hip(rhs_e%x_d, coef%Binv_d, &
593 visc_e%x_d, h%x_d, c_avisc_low, n)
594#elif HAVE_CUDA
595 call euler_res_part_visc_cuda(rhs_rho_field%x_d, coef%Binv_d, &
596 visc_rho%x_d, h%x_d, c_avisc_low, n)
597 call euler_res_part_visc_cuda(rhs_m_x%x_d, coef%Binv_d, &
598 visc_m_x%x_d, h%x_d, c_avisc_low, n)
599 call euler_res_part_visc_cuda(rhs_m_y%x_d, coef%Binv_d, &
600 visc_m_y%x_d, h%x_d, c_avisc_low, n)
601 call euler_res_part_visc_cuda(rhs_m_z%x_d, coef%Binv_d, &
602 visc_m_z%x_d, h%x_d, c_avisc_low, n)
603 call euler_res_part_visc_cuda(rhs_e%x_d, coef%Binv_d, &
604 visc_e%x_d, h%x_d, c_avisc_low, n)
605#elif HAVE_OPENCL
606 call euler_res_part_visc_opencl(rhs_rho_field%x_d, coef%Binv_d, &
607 visc_rho%x_d, h%x_d, c_avisc_low, n)
608 call euler_res_part_visc_opencl(rhs_m_x%x_d, coef%Binv_d, &
609 visc_m_x%x_d, h%x_d, c_avisc_low, n)
610 call euler_res_part_visc_opencl(rhs_m_y%x_d, coef%Binv_d, &
611 visc_m_y%x_d, h%x_d, c_avisc_low, n)
612 call euler_res_part_visc_opencl(rhs_m_z%x_d, coef%Binv_d, &
613 visc_m_z%x_d, h%x_d, c_avisc_low, n)
614 call euler_res_part_visc_opencl(rhs_e%x_d, coef%Binv_d, &
615 visc_e%x_d, h%x_d, c_avisc_low, n)
616#endif
617
618 call neko_scratch_registry%relinquish_field(temp_indices)
619
620 end subroutine evaluate_rhs_device
621
622end module euler_res_device
void euler_res_part_coef_mult_opencl(void *rhs_rho, void *rhs_m_x, void *rhs_m_y, void *rhs_m_z, void *rhs_E, void *mult, int *n)
Definition euler_res.c:196
void euler_res_part_my_flux_opencl(void *f_x, void *f_y, void *f_z, void *m_x, void *m_y, void *m_z, void *rho_field, void *p, int *n)
Definition euler_res.c:102
void euler_res_part_mx_flux_opencl(void *f_x, void *f_y, void *f_z, void *m_x, void *m_y, void *m_z, void *rho_field, void *p, int *n)
Definition euler_res.c:71
void euler_res_part_mz_flux_opencl(void *f_x, void *f_y, void *f_z, void *m_x, void *m_y, void *m_z, void *rho_field, void *p, int *n)
Definition euler_res.c:133
void euler_res_part_rk_sum_opencl(void *rho, void *m_x, void *m_y, void *m_z, void *E, void *k_rho_i, void *k_m_x_i, void *k_m_y_i, void *k_m_z_i, void *k_E_i, real *dt, real *c, int *n)
Definition euler_res.c:225
void euler_res_part_visc_opencl(void *rhs_u, void *Binv, void *lap_sol, void *h, real *c_avisc, int *n)
Definition euler_res.c:44
void euler_res_part_mx_flux_cuda(void *f_x, void *f_y, void *f_z, void *m_x, void *m_y, void *m_z, void *rho_field, void *p, int *n)
Definition euler_res.cu:56
void euler_res_part_my_flux_cuda(void *f_x, void *f_y, void *f_z, void *m_x, void *m_y, void *m_z, void *rho_field, void *p, int *n)
Definition euler_res.cu:71
void euler_res_part_visc_cuda(void *rhs_u, void *Binv, void *lap_sol, void *h, real *c_avisc, int *n)
Definition euler_res.cu:42
void euler_res_part_rk_sum_cuda(void *rho, void *m_x, void *m_y, void *m_z, void *E, void *k_rho_i, void *k_m_x_i, void *k_m_y_i, void *k_m_z_i, void *k_E_i, real *dt, real *c, int *n)
Definition euler_res.cu:132
void euler_res_part_coef_mult_cuda(void *rhs_rho, void *rhs_m_x, void *rhs_m_y, void *rhs_m_z, void *rhs_E, void *mult, int *n)
Definition euler_res.cu:117
void euler_res_part_mz_flux_cuda(void *f_x, void *f_y, void *f_z, void *m_x, void *m_y, void *m_z, void *rho_field, void *p, int *n)
Definition euler_res.cu:86
Defines a Matrix-vector product.
Definition ax.f90:34
Coefficients.
Definition coef.f90:34
subroutine, public device_copy(a_d, b_d, n)
Copy a vector .
subroutine evaluate_rhs_device(rhs_rho_field, rhs_m_x, rhs_m_y, rhs_m_z, rhs_e, rho_field, m_x, m_y, m_z, e, p, u, v, w, ax, coef, gs, h, c_avisc_low)
subroutine advance_primitive_variables_device(rho_field, m_x, m_y, m_z, e, p, u, v, w, ax, coef, gs, h, c_avisc_low, rk_scheme, dt)
subroutine, public field_cmult(a, c, n)
Multiplication by constant c .
Defines a field.
Definition field.f90:34
Gather-scatter.
integer, parameter, public c_rp
Definition num_types.f90:13
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Operators.
Definition operators.f90:34
subroutine, public div(res, ux, uy, uz, coef)
Compute the divergence of a vector field.
Defines a registry for storing and requesting temporary fields This can be used when you have a funct...
type(scratch_registry_t), target, public neko_scratch_registry
Global scratch registry.
Utilities.
Definition utils.f90:35
Base type for a matrix-vector product providing .
Definition ax.f90:43
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Definition coef.f90:55
Abstract type to compute rhs.
Definition euler_res.f90:47
field_list_t, To be able to group fields together