Neko 0.9.99
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
fluid_abbdf_device.F90
Go to the documentation of this file.
1! Copyright (c) 2022, 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 rhs_maker
35 use device
36 use utils
37 use, intrinsic :: iso_c_binding
38 implicit none
39 private
40
41 type, public, extends(rhs_maker_sumab_t) :: rhs_maker_sumab_device_t
42 contains
43 procedure, nopass :: compute_fluid => rhs_maker_sumab_device
45
46 type, public, extends(rhs_maker_ext_t) :: rhs_maker_ext_device_t
47 contains
48 procedure, nopass :: compute_fluid => rhs_maker_ext_device
50
51 type, public, extends(rhs_maker_bdf_t) :: rhs_maker_bdf_device_t
52 contains
53 procedure, nopass :: compute_fluid => rhs_maker_bdf_device
55
56#ifdef HAVE_HIP
57 interface
58 subroutine rhs_maker_sumab_hip(u_d, v_d, w_d, uu_d, vv_d, ww_d, &
59 uulag1, uulag2, vvlag1, vvlag2, wwlag1, wwlag2, ab1, ab2, ab3, nab, n)&
60 bind(c, name='rhs_maker_sumab_hip')
61 use, intrinsic :: iso_c_binding
62 import c_rp
63 type(c_ptr), value :: u_d, v_d, w_d, uu_d, vv_d, ww_d
64 type(c_ptr), value :: uulag1, uulag2, vvlag1, vvlag2, wwlag1, wwlag2
65 real(c_rp) :: ab1, ab2, ab3
66 integer(c_int) :: nab, n
67 end subroutine rhs_maker_sumab_hip
68 end interface
69
70 interface
71 subroutine rhs_maker_ext_hip(abx1_d, aby1_d, abz1_d, &
72 abx2_d, aby2_d, abz2_d, &
73 bfx_d, bfy_d, bfz_d, &
74 rho, ab1, ab2, ab3, n) &
75 bind(c, name='rhs_maker_ext_hip')
76 use, intrinsic :: iso_c_binding
77 import c_rp
78 type(c_ptr), value :: abx1_d, aby1_d, abz1_d
79 type(c_ptr), value :: abx2_d, aby2_d, abz2_d
80 type(c_ptr), value :: bfx_d, bfy_d, bfz_d
81 real(c_rp) :: rho, ab1, ab2, ab3
82 integer(c_int) :: n
83 end subroutine rhs_maker_ext_hip
84 end interface
85
86 interface
87 subroutine rhs_maker_bdf_hip(ulag1_d, ulag2_d, vlag1_d, vlag2_d, &
88 wlag1_d, wlag2_d, bfx_d, bfy_d, bfz_d, u_d, v_d, w_d, B_d, &
89 rho, dt, bd2, bd3, bd4, nbd, n) bind(c, name='rhs_maker_bdf_hip')
90 use, intrinsic :: iso_c_binding
91 import c_rp
92 type(c_ptr), value :: ulag1_d, ulag2_d, vlag1_d
93 type(c_ptr), value :: vlag2_d, wlag1_d, wlag2_d
94 type(c_ptr), value :: bfx_d, bfy_d, bfz_d, u_d, v_d, w_d, B_d
95 reaL(c_rp) :: rho, dt, bd2, bd3, bd4
96 integer(c_int) :: nbd, n
97 end subroutine rhs_maker_bdf_hip
98 end interface
99#elif HAVE_CUDA
100 interface
101 subroutine rhs_maker_sumab_cuda(u_d, v_d, w_d, uu_d, vv_d, ww_d, &
102 uulag1, uulag2, vvlag1, vvlag2, wwlag1, wwlag2, ab1, ab2, ab3, nab, n)&
103 bind(c, name='rhs_maker_sumab_cuda')
104 use, intrinsic :: iso_c_binding
105 import c_rp
106 type(c_ptr), value :: u_d, v_d, w_d, uu_d, vv_d, ww_d
107 type(c_ptr), value :: uulag1, uulag2, vvlag1, vvlag2, wwlag1, wwlag2
108 real(c_rp) :: ab1, ab2, ab3
109 integer(c_int) :: nab, n
110 end subroutine rhs_maker_sumab_cuda
111 end interface
112
113 interface
114 subroutine rhs_maker_ext_cuda(abx1_d, aby1_d, abz1_d, &
115 abx2_d, aby2_d, abz2_d, &
116 bfx_d, bfy_d, bfz_d, &
117 rho, ab1, ab2, ab3, n) &
118 bind(c, name='rhs_maker_ext_cuda')
119 use, intrinsic :: iso_c_binding
120 import c_rp
121 type(c_ptr), value :: abx1_d, aby1_d, abz1_d
122 type(c_ptr), value :: abx2_d, aby2_d, abz2_d
123 type(c_ptr), value :: bfx_d, bfy_d, bfz_d
124 real(c_rp) :: rho, ab1, ab2, ab3
125 integer(c_int) :: n
126 end subroutine rhs_maker_ext_cuda
127 end interface
128
129 interface
130 subroutine rhs_maker_bdf_cuda(ulag1_d, ulag2_d, vlag1_d, vlag2_d, &
131 wlag1_d, wlag2_d, bfx_d, bfy_d, bfz_d, u_d, v_d, w_d, B_d, &
132 rho, dt, bd2, bd3, bd4, nbd, n) bind(c, name='rhs_maker_bdf_cuda')
133 use, intrinsic :: iso_c_binding
134 import c_rp
135 type(c_ptr), value :: ulag1_d, ulag2_d, vlag1_d
136 type(c_ptr), value :: vlag2_d, wlag1_d, wlag2_d
137 type(c_ptr), value :: bfx_d, bfy_d, bfz_d, u_d, v_d, w_d, B_d
138 reaL(c_rp) :: rho, dt, bd2, bd3, bd4
139 integer(c_int) :: nbd, n
140 end subroutine rhs_maker_bdf_cuda
141 end interface
142#elif HAVE_OPENCL
143 interface
144 subroutine rhs_maker_sumab_opencl(u_d, v_d, w_d, uu_d, vv_d, ww_d, &
145 uulag1, uulag2, vvlag1, vvlag2, wwlag1, wwlag2, ab1, ab2, ab3, nab, n)&
146 bind(c, name='rhs_maker_sumab_opencl')
147 use, intrinsic :: iso_c_binding
148 import c_rp
149 type(c_ptr), value :: u_d, v_d, w_d, uu_d, vv_d, ww_d
150 type(c_ptr), value :: uulag1, uulag2, vvlag1, vvlag2, wwlag1, wwlag2
151 real(c_rp) :: ab1, ab2, ab3
152 integer(c_int) :: nab, n
153 end subroutine rhs_maker_sumab_opencl
154 end interface
155
156 interface
157 subroutine rhs_maker_ext_opencl(abx1_d, aby1_d, abz1_d, &
158 abx2_d, aby2_d, abz2_d, &
159 bfx_d, bfy_d, bfz_d, &
160 rho, ab1, ab2, ab3, n) &
161 bind(c, name='rhs_maker_ext_opencl')
162 use, intrinsic :: iso_c_binding
163 import c_rp
164 type(c_ptr), value :: abx1_d, aby1_d, abz1_d
165 type(c_ptr), value :: abx2_d, aby2_d, abz2_d
166 type(c_ptr), value :: bfx_d, bfy_d, bfz_d
167 real(c_rp) :: rho, ab1, ab2, ab3
168 integer(c_int) :: n
169 end subroutine rhs_maker_ext_opencl
170 end interface
171
172 interface
173 subroutine rhs_maker_bdf_opencl(ulag1_d, ulag2_d, vlag1_d, vlag2_d, &
174 wlag1_d, wlag2_d, bfx_d, bfy_d, bfz_d, u_d, v_d, w_d, B_d, &
175 rho, dt, bd2, bd3, bd4, nbd, n) bind(c, name='rhs_maker_bdf_opencl')
176 use, intrinsic :: iso_c_binding
177 import c_rp
178 type(c_ptr), value :: ulag1_d, ulag2_d, vlag1_d
179 type(c_ptr), value :: vlag2_d, wlag1_d, wlag2_d
180 type(c_ptr), value :: bfx_d, bfy_d, bfz_d, u_d, v_d, w_d, B_d
181 reaL(c_rp) :: rho, dt, bd2, bd3, bd4
182 integer(c_int) :: nbd, n
183 end subroutine rhs_maker_bdf_opencl
184 end interface
185#endif
186
187contains
188
189 subroutine rhs_maker_sumab_device(u, v, w, uu, vv, ww, uulag, vvlag, wwlag, ab, nab)
190 type(field_t), intent(inout) :: u,v, w
191 type(field_t), intent(inout) :: uu, vv, ww
192 type(field_series_t), intent(inout) :: uulag, vvlag, wwlag
193 real(kind=rp), dimension(3), intent(in) :: ab
194 integer, intent(in) :: nab
195
196#ifdef HAVE_HIP
197 call rhs_maker_sumab_hip(u%x_d, v%x_d, w%x_d, uu%x_d, vv%x_d, ww%x_d, &
198 uulag%lf(1)%x_d, uulag%lf(2)%x_d, vvlag%lf(1)%x_d, vvlag%lf(2)%x_d, &
199 wwlag%lf(1)%x_d, wwlag%lf(2)%x_d, ab(1), ab(2), ab(3), nab, &
200 uu%dof%size())
201#elif HAVE_CUDA
202 call rhs_maker_sumab_cuda(u%x_d, v%x_d, w%x_d, uu%x_d, vv%x_d, ww%x_d, &
203 uulag%lf(1)%x_d, uulag%lf(2)%x_d, vvlag%lf(1)%x_d, vvlag%lf(2)%x_d, &
204 wwlag%lf(1)%x_d, wwlag%lf(2)%x_d, ab(1), ab(2), ab(3), nab, &
205 uu%dof%size())
206#elif HAVE_OPENCL
207 call rhs_maker_sumab_opencl(u%x_d, v%x_d, w%x_d, uu%x_d, vv%x_d, ww%x_d, &
208 uulag%lf(1)%x_d, uulag%lf(2)%x_d, vvlag%lf(1)%x_d, vvlag%lf(2)%x_d, &
209 wwlag%lf(1)%x_d, wwlag%lf(2)%x_d, ab(1), ab(2), ab(3), nab, &
210 uu%dof%size())
211#endif
212
213 end subroutine rhs_maker_sumab_device
214
215 subroutine rhs_maker_ext_device(temp1, temp2, temp3, fx_lag, fy_lag, fz_lag, &
216 fx_laglag, fy_laglag, fz_laglag, fx, fy, fz, &
217 rho, ext_coeffs, n)
218 type(field_t), intent(inout) :: temp1, temp2, temp3
219 type(field_t), intent(inout) :: fx_lag, fy_lag, fz_lag
220 type(field_t), intent(inout) :: fx_laglag, fy_laglag, fz_laglag
221 real(kind=rp), intent(inout) :: rho, ext_coeffs(4)
222 integer, intent(in) :: n
223 real(kind=rp), intent(inout) :: fx(n), fy(n), fz(n)
224 type(c_ptr) :: fx_d, fy_d, fz_d
225
226 fx_d = device_get_ptr(fx)
227 fy_d = device_get_ptr(fy)
228 fz_d = device_get_ptr(fz)
229
230#ifdef HAVE_HIP
231 call rhs_maker_ext_hip(fx_lag%x_d, fy_lag%x_d, fz_lag%x_d, &
232 fx_laglag%x_d, fy_laglag%x_d, fz_laglag%x_d, &
233 fx_d, fy_d, fz_d, rho, &
234 ext_coeffs(1), ext_coeffs(2), ext_coeffs(3), n)
235#elif HAVE_CUDA
236 call rhs_maker_ext_cuda(fx_lag%x_d, fy_lag%x_d, fz_lag%x_d, &
237 fx_laglag%x_d, fy_laglag%x_d, fz_laglag%x_d, &
238 fx_d, fy_d, fz_d, rho, &
239 ext_coeffs(1), ext_coeffs(2), ext_coeffs(3), n)
240#elif HAVE_OPENCL
241 call rhs_maker_ext_opencl(fx_lag%x_d, fy_lag%x_d, fz_lag%x_d, &
242 fx_laglag%x_d, fy_laglag%x_d, fz_laglag%x_d, &
243 fx_d, fy_d, fz_d, rho, &
244 ext_coeffs(1), ext_coeffs(2), ext_coeffs(3), n)
245#endif
246
247 end subroutine rhs_maker_ext_device
248
249 subroutine rhs_maker_bdf_device(ta1, ta2, ta3, tb1, tb2, tb3, &
250 ulag, vlag, wlag, bfx, bfy, bfz, &
251 u, v, w, B, rho, dt, bd, nbd, n)
252 integer, intent(in) :: n, nbd
253 type(field_t), intent(inout) :: ta1, ta2, ta3
254 type(field_t), intent(in) :: u, v, w
255 type(field_t), intent(inout) :: tb1, tb2, tb3
256 type(field_series_t), intent(in) :: ulag, vlag, wlag
257 real(kind=rp), intent(inout) :: bfx(n), bfy(n), bfz(n)
258 real(kind=rp), intent(in) :: b(n)
259 real(kind=rp), intent(in) :: dt, rho, bd(10)
260 type(c_ptr) :: bfx_d, bfy_d, bfz_d, b_d
261
262 bfx_d = device_get_ptr(bfx)
263 bfy_d = device_get_ptr(bfy)
264 bfz_d = device_get_ptr(bfz)
265 b_d = device_get_ptr(b)
266
267#ifdef HAVE_HIP
268 call rhs_maker_bdf_hip(ulag%lf(1)%x_d, ulag%lf(2)%x_d, &
269 vlag%lf(1)%x_d, vlag%lf(2)%x_d, &
270 wlag%lf(1)%x_d, wlag%lf(2)%x_d, &
271 bfx_d, bfy_d, bfz_d, u%x_d, v%x_d, w%x_d, &
272 b_d, rho, dt, bd(2), bd(3), bd(4), nbd, n)
273#elif HAVE_CUDA
274 call rhs_maker_bdf_cuda(ulag%lf(1)%x_d, ulag%lf(2)%x_d, &
275 vlag%lf(1)%x_d, vlag%lf(2)%x_d, &
276 wlag%lf(1)%x_d, wlag%lf(2)%x_d, &
277 bfx_d, bfy_d, bfz_d, u%x_d, v%x_d, w%x_d, &
278 b_d, rho, dt, bd(2), bd(3), bd(4), nbd, n)
279#elif HAVE_OPENCL
280 call rhs_maker_bdf_opencl(ulag%lf(1)%x_d, ulag%lf(2)%x_d, &
281 vlag%lf(1)%x_d, vlag%lf(2)%x_d, &
282 wlag%lf(1)%x_d, wlag%lf(2)%x_d, &
283 bfx_d, bfy_d, bfz_d, u%x_d, v%x_d, w%x_d, &
284 b_d, rho, dt, bd(2), bd(3), bd(4), nbd, n)
285#endif
286
287 end subroutine rhs_maker_bdf_device
288
289end module rhs_maker_device
Return the device pointer for an associated Fortran array.
Definition device.F90:81
Device abstraction, common interface for various accelerators.
Definition device.F90:34
subroutine rhs_maker_sumab_device(u, v, w, uu, vv, ww, uulag, vvlag, wwlag, ab, nab)
subroutine rhs_maker_ext_device(fx_lag, fy_lag, fz_lag, fx_laglag, fy_laglag, fz_laglag, fx, fy, fz, rho, ext_coeffs, n)
subroutine rhs_maker_bdf_device(ulag, vlag, wlag, bfx, bfy, bfz, u, v, w, b, rho, dt, bd, nbd, n)
Routines to generate the right-hand sides for the convection-diffusion equation. Employs the EXT/BDF ...
Definition rhs_maker.f90:38
Utilities.
Definition utils.f90:35
void rhs_maker_sumab_opencl(void *u, void *v, void *w, void *uu, void *vv, void *ww, void *ulag1, void *ulag2, void *vlag1, void *vlag2, void *wlag1, void *wlag2, real *ext1, real *ext2, real *ext3, int *nab, int *n)
Definition rhs_maker.c:49
void rhs_maker_ext_opencl(void *abx1, void *aby1, void *abz1, void *abx2, void *aby2, void *abz2, void *bfx, void *bfy, void *bfz, real *rho, real *ext1, real *ext2, real *ext3, int *n)
Definition rhs_maker.c:89
void rhs_maker_bdf_opencl(void *ulag1, void *ulag2, void *vlag1, void *vlag2, void *wlag1, void *wlag2, void *bfx, void *bfy, void *bfz, void *u, void *v, void *w, void *B, real *rho, real *dt, real *bd2, real *bd3, real *bd4, int *nbd, int *n)
Definition rhs_maker.c:156
void rhs_maker_ext_cuda(void *abx1, void *aby1, void *abz1, void *abx2, void *aby2, void *abz2, void *bfx, void *bfy, void *bfz, real *rho, real *ab1, real *ab2, real *ab3, int *n)
Definition rhs_maker.cu:62
void rhs_maker_bdf_cuda(void *ulag1, void *ulag2, void *vlag1, void *vlag2, void *wlag1, void *wlag2, void *bfx, void *bfy, void *bfz, void *u, void *v, void *w, void *B, real *rho, real *dt, real *bd2, real *bd3, real *bd4, int *nbd, int *n)
Definition rhs_maker.cu:97
void rhs_maker_sumab_cuda(void *u, void *v, void *w, void *uu, void *vv, void *ww, void *ulag1, void *ulag2, void *vlag1, void *vlag2, void *wlag1, void *wlag2, real *ab1, real *ab2, real *ab3, int *nab, int *n)
Definition rhs_maker.cu:43
Abstract type to add contributions to F from lagged BD terms.
Definition rhs_maker.f90:59
Abstract type to sum up contributions to kth order extrapolation scheme.
Definition rhs_maker.f90:52
Abstract type to compute extrapolated velocity field for the pressure equation.
Definition rhs_maker.f90:46