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
dynamic_smagorinsky_device.f90
Go to the documentation of this file.
1! Copyright (c) 2024, 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!
35 use num_types, only : rp
36 use field_list, only : field_list_t
39 use field, only : field_t
40 use operators, only : strain_rate
41 use coefs, only : coef_t
43 use gs_ops, only : gs_op_add
44 use device_math, only : device_col2
48 implicit none
49 private
50
52
53contains
54
68 subroutine dynamic_smagorinsky_compute_device(if_ext, t, tstep, coef, nut, &
69 delta, c_dyn, test_filter, mij, lij, num, den)
70 logical, intent(in) :: if_ext
71 real(kind=rp), intent(in) :: t
72 integer, intent(in) :: tstep
73 type(coef_t), intent(in) :: coef
74 type(field_t), intent(inout) :: nut
75 type(field_t), intent(in) :: delta
76 type(field_t), intent(inout) :: c_dyn
77 type(elementwise_filter_t), intent(inout) :: test_filter
78 type(field_t), intent(inout) :: mij(6), lij(6)
79 type(field_t), intent(inout) :: num, den
80
81 type(field_t), pointer :: u, v, w
82 type(field_t) :: c_dyn_curr
83 ! the strain rate tensor
84 type(field_t), pointer :: s11, s22, s33, s12, s13, s23, s_abs
85 real(kind=rp) :: alpha ! running averaging coefficient
86 integer :: temp_indices(7)
87 integer :: i
88
89 if (tstep .eq. 1) then
90 alpha = 1.0_rp
91 else
92 alpha = 0.9_rp
93 end if
94
95 if (if_ext .eqv. .true.) then
96 u => neko_field_registry%get_field_by_name("u_e")
97 v => neko_field_registry%get_field_by_name("v_e")
98 w => neko_field_registry%get_field_by_name("w_e")
99 else
100 u => neko_field_registry%get_field_by_name("u")
101 v => neko_field_registry%get_field_by_name("v")
102 w => neko_field_registry%get_field_by_name("w")
103 end if
104
105 call neko_scratch_registry%request_field(s11, temp_indices(1))
106 call neko_scratch_registry%request_field(s22, temp_indices(2))
107 call neko_scratch_registry%request_field(s33, temp_indices(3))
108 call neko_scratch_registry%request_field(s12, temp_indices(4))
109 call neko_scratch_registry%request_field(s13, temp_indices(5))
110 call neko_scratch_registry%request_field(s23, temp_indices(6))
111 call neko_scratch_registry%request_field(s_abs, temp_indices(7))
112
113 ! Compute the strain rate tensor
114 call strain_rate(s11%x, s22%x, s33%x, s12%x, s13%x, s23%x, u, v, w, coef)
115
116 call coef%gs_h%op(s11%x, s11%dof%size(), gs_op_add)
117 call coef%gs_h%op(s22%x, s11%dof%size(), gs_op_add)
118 call coef%gs_h%op(s33%x, s11%dof%size(), gs_op_add)
119 call coef%gs_h%op(s12%x, s11%dof%size(), gs_op_add)
120 call coef%gs_h%op(s13%x, s11%dof%size(), gs_op_add)
121 call coef%gs_h%op(s23%x, s11%dof%size(), gs_op_add)
122
123 call device_s_abs_compute(s_abs%x_d, s11%x_d, s22%x_d, s33%x_d, &
124 s12%x_d, s13%x_d, s23%x_d, &
125 s11%dof%size())
126
127 call compute_lij_device(lij, u, v, w, test_filter, u%dof%size())
128 call compute_nut_device(nut, c_dyn, num, den, lij, mij, &
129 s11, s22, s33, s12, s13, s23, &
130 s_abs, test_filter, delta, alpha, &
131 coef, u%dof%size())
132
133 call coef%gs_h%op(nut, gs_op_add)
134 call device_col2(nut%x_d, coef%mult_d, nut%dof%size())
135
136 call neko_scratch_registry%relinquish_field(temp_indices)
138
147 subroutine compute_lij_device(lij, u, v, w, test_filter, n)
148 type(field_t), intent(inout) :: lij(6)
149 type(field_t), pointer, intent(in) :: u, v, w
150 type(elementwise_filter_t), intent(inout) :: test_filter
151 integer, intent(in) :: n
152 integer :: i
154 type(field_t), pointer :: fu, fv, fw, fuu, fvv, fww, fuv, fuw, fvw
155 integer :: temp_indices(9)
156
157 call neko_scratch_registry%request_field(fu, temp_indices(1))
158 call neko_scratch_registry%request_field(fv, temp_indices(2))
159 call neko_scratch_registry%request_field(fw, temp_indices(3))
160 call neko_scratch_registry%request_field(fuu, temp_indices(4))
161 call neko_scratch_registry%request_field(fvv, temp_indices(5))
162 call neko_scratch_registry%request_field(fww, temp_indices(6))
163 call neko_scratch_registry%request_field(fuv, temp_indices(7))
164 call neko_scratch_registry%request_field(fuw, temp_indices(8))
165 call neko_scratch_registry%request_field(fvw, temp_indices(9))
166
167 ! Use test filter for the velocity fields
168 call test_filter%apply(fu, u)
169 call test_filter%apply(fv, v)
170 call test_filter%apply(fw, w)
171
172 !! ___ ___
173 !! Compute u_i*u_j and u_i*u_j
174 call device_lij_compute_part1(lij(1)%x_d, lij(2)%x_d, lij(3)%x_d, &
175 lij(4)%x_d, lij(5)%x_d, lij(6)%x_d, &
176 u%x_d, v%x_d, w%x_d, &
177 fu%x_d, fv%x_d, fw%x_d, &
178 fuu%x_d, fvv%x_d, fww%x_d, &
179 fuv%x_d, fuw%x_d, fvw%x_d, n)
180
181 !! Filter u_i*u_j by the test filter
182 call test_filter%apply(fuu, fuu)
183 call test_filter%apply(fvv, fvv)
184 call test_filter%apply(fww, fww)
185 call test_filter%apply(fuv, fuv)
186 call test_filter%apply(fuw, fuw)
187 call test_filter%apply(fvw, fvw)
188
189 !! Assember the final form
190 !! ___ ___ _______
191 !! L_ij = u_i*u_j - u_i*u_j
192 call device_lij_compute_part2(lij(1)%x_d, lij(2)%x_d, lij(3)%x_d, &
193 lij(4)%x_d, lij(5)%x_d, lij(6)%x_d, &
194 fuu%x_d, fvv%x_d, fww%x_d, &
195 fuv%x_d, fuw%x_d, fvw%x_d, n)
196 call neko_scratch_registry%relinquish_field(temp_indices)
197 end subroutine compute_lij_device
198
219 subroutine compute_nut_device(nut, c_dyn, num, den, lij, mij, &
220 s11, s22, s33, s12, s13, s23, &
221 s_abs, test_filter, delta, alpha, &
222 coef, n)
223 type(field_t), intent(inout) :: nut, c_dyn
224 type(field_t), intent(inout) :: num, den
225 type(field_t), intent(in) :: lij(6)
226 type(field_t), intent(inout) :: mij(6)
227 type(field_t), intent(inout) :: s11, s22, s33, s12, s13, s23, s_abs
228 type(elementwise_filter_t), intent(inout) :: test_filter
229 type(field_t), intent(in) :: delta
230 real(kind=rp), intent(in) :: alpha
231 type(coef_t), intent(in) :: coef
232 integer, intent(in) :: n
233
234 real(kind=rp) :: delta_ratio2
235 integer :: temp_indices(13)
236 type(field_t), pointer :: fs11, fs22, fs33, fs12, fs13, fs23, fs_abs, &
237 fsabss11, fsabss22, fsabss33, &
238 fsabss12, fsabss13, fsabss23
239
240 delta_ratio2 = ((test_filter%nx-1.0_rp)/(test_filter%nt-1.0_rp))**2
241
242 call neko_scratch_registry%request_field(fs11, temp_indices(1))
243 call neko_scratch_registry%request_field(fs22, temp_indices(2))
244 call neko_scratch_registry%request_field(fs33, temp_indices(3))
245 call neko_scratch_registry%request_field(fs12, temp_indices(4))
246 call neko_scratch_registry%request_field(fs13, temp_indices(5))
247 call neko_scratch_registry%request_field(fs23, temp_indices(6))
248 call neko_scratch_registry%request_field(fsabss11, temp_indices(7))
249 call neko_scratch_registry%request_field(fsabss22, temp_indices(8))
250 call neko_scratch_registry%request_field(fsabss33, temp_indices(9))
251 call neko_scratch_registry%request_field(fsabss12, temp_indices(10))
252 call neko_scratch_registry%request_field(fsabss13, temp_indices(11))
253 call neko_scratch_registry%request_field(fsabss23, temp_indices(12))
254 call neko_scratch_registry%request_field(fs_abs, temp_indices(13))
255
256 !! Compute M_ij
257 !! _____ ____
258 !! Compute s_abs and s_ij
259 call test_filter%apply(fs_abs, s_abs)
260 call test_filter%apply(fs11, s11)
261 call test_filter%apply(fs22, s22)
262 call test_filter%apply(fs33, s33)
263 call test_filter%apply(fs12, s12)
264 call test_filter%apply(fs13, s13)
265 call test_filter%apply(fs23, s23)
266
267 !! _____ ____
268 !! Compute (delta_test/delta)^2 s_abs*s_ij and s_abs*s_ij
269 call device_mij_compute_part1(mij(1)%x_d, mij(2)%x_d, mij(3)%x_d, &
270 mij(4)%x_d, mij(5)%x_d, mij(6)%x_d, &
271 s_abs%x_d, s11%x_d, s22%x_d, s33%x_d, &
272 s12%x_d, s13%x_d, s23%x_d, &
273 fs_abs%x_d, fs11%x_d, fs22%x_d, fs33%x_d, &
274 fs12%x_d, fs13%x_d, fs23%x_d, &
275 fsabss11%x_d, fsabss22%x_d, fsabss33%x_d, &
276 fsabss12%x_d, fsabss13%x_d, fsabss23%x_d, &
277 delta_ratio2, n)
278
279 !! Filter s_abs*s_ij by the test filter
280 call test_filter%apply(fsabss11, fsabss11)
281 call test_filter%apply(fsabss22, fsabss22)
282 call test_filter%apply(fsabss33, fsabss33)
283 call test_filter%apply(fsabss12, fsabss12)
284 call test_filter%apply(fsabss13, fsabss13)
285 call test_filter%apply(fsabss23, fsabss23)
286
287 !! Finalise the compute of Mij and nut
288 call device_mij_nut_compute_part2(mij(1)%x_d, mij(2)%x_d, mij(3)%x_d, &
289 mij(4)%x_d, mij(5)%x_d, mij(6)%x_d, &
290 lij(1)%x_d, lij(2)%x_d, lij(3)%x_d, &
291 lij(4)%x_d, lij(5)%x_d, lij(6)%x_d, &
292 fsabss11%x_d, fsabss22%x_d, fsabss33%x_d, &
293 fsabss12%x_d, fsabss13%x_d, fsabss23%x_d, &
294 num%x_d, den%x_d, c_dyn%x_d, delta%x_d, &
295 s_abs%x_d, nut%x_d, alpha, coef%mult_d, n)
296 call neko_scratch_registry%relinquish_field(temp_indices)
297 end subroutine compute_nut_device
298
300
Coefficients.
Definition coef.f90:34
subroutine, public device_lij_compute_part1(l11_d, l22_d, l33_d, l12_d, l13_d, l23_d, u_d, v_d, w_d, fu_d, fv_d, fw_d, fuu_d, fvv_d, fww_d, fuv_d, fuw_d, fvw_d, n)
part 1 of the computing of the lij field
subroutine, public device_mij_compute_part1(m11_d, m22_d, m33_d, m12_d, m13_d, m23_d, s_abs_d, s11_d, s22_d, s33_d, s12_d, s13_d, s23_d, fs_abs_d, fs11_d, fs22_d, fs33_d, fs12_d, fs13_d, fs23_d, fsabss11_d, fsabss22_d, fsabss33_d, fsabss12_d, fsabss13_d, fsabss23_d, delta_ratio2, n)
part 1 of the computing of the mij field
subroutine, public device_s_abs_compute(s_abs_d, s11_d, s22_d, s33_d, s12_d, s13_d, s23_d, n)
Compute the s_abs field for the Sigma model indevice.
subroutine, public device_lij_compute_part2(l11_d, l22_d, l33_d, l12_d, l13_d, l23_d, fuu_d, fvv_d, fww_d, fuv_d, fuw_d, fvw_d, n)
part 2 of the computing of the lij field
subroutine, public device_mij_nut_compute_part2(m11_d, m22_d, m33_d, m12_d, m13_d, m23_d, l11_d, l22_d, l33_d, l12_d, l13_d, l23_d, fsabss11_d, fsabss22_d, fsabss33_d, fsabss12_d, fsabss13_d, fsabss23_d, num_d, den_d, c_dyn_d, delta_d, s_abs_d, nut_d, alpha, mult_d, n)
part 1 of the computing of the mij field
subroutine, public device_col2(a_d, b_d, n)
Vector multiplication .
Implements the device kernel for the smagorinsky_t type.
subroutine, public dynamic_smagorinsky_compute_device(if_ext, t, tstep, coef, nut, delta, c_dyn, test_filter, mij, lij, num, den)
Compute eddy viscosity on the device.
subroutine compute_nut_device(nut, c_dyn, num, den, lij, mij, s11, s22, s33, s12, s13, s23, s_abs, test_filter, delta, alpha, coef, n)
Compute M_ij and nut on the device.
subroutine compute_lij_device(lij, u, v, w, test_filter, n)
Compute Germano Identity on the device.
Implements explicit_filter_t.
Defines a registry for storing solution fields.
type(field_registry_t), target, public neko_field_registry
Global field registry.
Defines a field.
Definition field.f90:34
Defines Gather-scatter operations.
Definition gs_ops.f90:34
integer, parameter, public gs_op_add
Definition gs_ops.f90:36
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Operators.
Definition operators.f90:34
subroutine, public strain_rate(s11, s22, s33, s12, s13, s23, u, v, w, coef)
Compute the strain rate tensor, i.e 0.5 * du_i/dx_j + du_j/dx_i.
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.
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Definition coef.f90:55
Implements the explicit filter for SEM.
field_list_t, To be able to group fields together