38 use json_module,
only : json_file
56 type(
coef_t),
pointer :: coef => null()
60 integer,
pointer :: msk(:) => null()
62 integer,
pointer :: facet(:) => null()
64 real(kind=
rp),
allocatable :: tau_x(:)
66 real(kind=
rp),
allocatable :: tau_y(:)
68 real(kind=
rp),
allocatable :: tau_z(:)
76 integer,
allocatable :: ind_r(:)
78 integer,
allocatable :: ind_s(:)
80 integer,
allocatable :: ind_t(:)
82 integer,
allocatable :: ind_e(:)
86 integer :: h_index = 0
88 integer :: n_nodes = 0
90 real(kind=
rp) :: nu = 0_rp
92 type(
field_t),
pointer :: tau_field => null()
115 real(kind=
rp),
intent(in) :: t
116 integer,
intent(in) :: tstep
131 type(
coef_t),
intent(in) :: coef
132 integer,
intent(in) :: msk(:)
133 integer,
intent(in) :: facet(:)
134 real(kind=
rp),
intent(in) :: nu
135 integer,
intent(in) :: h_index
136 type(json_file),
intent(inout) :: json
157 module subroutine wall_model_factory(object, coef, msk, facet, nu, &
159 class(wall_model_t),
allocatable,
target,
intent(inout) :: object
160 type(
coef_t),
intent(in) :: coef
161 integer,
intent(in) :: msk(:)
162 integer,
intent(in) :: facet(:)
163 real(kind=
rp),
intent(in) :: nu
164 type(json_file),
intent(inout) :: json
165 end subroutine wall_model_factory
168 public :: wall_model_factory
177 subroutine wall_model_init_base(this, coef, msk, facet, nu, index)
178 class(wall_model_t),
intent(inout) :: this
179 type(
coef_t),
target,
intent(in) :: coef
180 integer,
target,
intent(in) :: msk(0:)
181 integer,
target,
intent(in) :: facet(0:)
182 real(kind=
rp),
intent(in) :: nu
183 integer,
intent(in) :: index
189 this%msk(0:msk(0)) => msk
190 this%facet(0:msk(0)) => facet
195 ignore_existing = .true.)
199 allocate(this%tau_x(this%msk(0)))
200 allocate(this%tau_y(this%msk(0)))
201 allocate(this%tau_z(this%msk(0)))
203 allocate(this%ind_r(this%msk(0)))
204 allocate(this%ind_s(this%msk(0)))
205 allocate(this%ind_t(this%msk(0)))
206 allocate(this%ind_e(this%msk(0)))
208 call this%h%init(this%msk(0))
209 call this%n_x%init(this%msk(0))
210 call this%n_y%init(this%msk(0))
211 call this%n_z%init(this%msk(0))
213 call this%find_points
215 end subroutine wall_model_init_base
218 subroutine wall_model_free_base(this)
219 class(wall_model_t),
intent(inout) :: this
224 nullify(this%tau_field)
226 if (
allocated(this%tau_x))
then
227 deallocate(this%tau_x)
229 if (
allocated(this%tau_y))
then
230 deallocate(this%tau_y)
232 if (
allocated(this%tau_z))
then
233 deallocate(this%tau_z)
235 if (
allocated(this%ind_r))
then
236 deallocate(this%ind_r)
243 end subroutine wall_model_free_base
246 subroutine wall_model_find_points(this)
247 class(wall_model_t),
intent(inout) :: this
248 integer :: n_nodes, fid, idx(4), i, linear
249 real(kind=
rp) :: normal(3), p(3), x, y, z, xw, yw, zw, magp
250 real(kind=
rp) :: hmin, hmax
252 n_nodes = this%msk(0)
253 this%n_nodes = n_nodes
260 normal = this%coef%get_normal(idx(1), idx(2), idx(3), idx(4), fid)
262 this%n_x%x(i) = normal(1)
263 this%n_y%x(i) = normal(2)
264 this%n_z%x(i) = normal(3)
271 this%ind_r(i) = idx(1) + this%h_index
272 this%ind_s(i) = idx(2)
273 this%ind_t(i) = idx(3)
275 this%ind_r(i) = idx(1) - this%h_index
276 this%ind_s(i) = idx(2)
277 this%ind_t(i) = idx(3)
279 this%ind_r(i) = idx(1)
280 this%ind_s(i) = idx(2) + this%h_index
281 this%ind_t(i) = idx(3)
283 this%ind_r(i) = idx(1)
284 this%ind_s(i) = idx(2) - this%h_index
285 this%ind_t(i) = idx(3)
287 this%ind_r(i) = idx(1)
288 this%ind_s(i) = idx(2)
289 this%ind_t(i) = idx(3) + this%h_index
291 this%ind_r(i) = idx(1)
292 this%ind_s(i) = idx(2)
293 this%ind_t(i) = idx(3) - this%h_index
295 call neko_error(
"The face index is not correct ")
297 this%ind_e(i) = idx(4)
300 xw = this%dof%x(idx(1), idx(2), idx(3), idx(4))
301 yw = this%dof%y(idx(1), idx(2), idx(3), idx(4))
302 zw = this%dof%z(idx(1), idx(2), idx(3), idx(4))
305 x = this%dof%x(this%ind_r(i), this%ind_s(i), this%ind_t(i), &
307 y = this%dof%y(this%ind_r(i), this%ind_s(i), this%ind_t(i), &
309 z = this%dof%z(this%ind_r(i), this%ind_s(i), this%ind_t(i), &
319 magp = sqrt(p(1)**2 + p(2)**2 + p(3)**2)
322 this%h%x(i) = p(1)*normal(1) + p(2)*normal(2) + p(3)*normal(3)
326 if ((this%h%x(i) - magp) / magp > 0.1 &
328 write(*,*)
"Significant missalignment between wall normal and &
329 & sampling point direction at wall node", xw, yw, zw
333 hmin =
glmin(this%h%x, n_nodes)
352 end subroutine wall_model_find_points
__device__ void nonlinear_index(const int idx, const int lx, int *index)
Copy data between host and device (or device and device)
Compute wall shear stress.
Device abstraction, common interface for various accelerators.
integer, parameter, public host_to_device
Defines a mapping of the degrees of freedom.
Defines a registry for storing solution fields.
type(field_registry_t), target, public neko_field_registry
Global field registry.
integer, parameter, public neko_log_debug
Debug log level.
type(log_t), public neko_log
Global log stream.
real(kind=rp) function, public glmax(a, n)
Max of a vector of length n.
real(kind=rp) function, public glmin(a, n)
Min of a vector of length n.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
subroutine wall_model_init_base(this, coef, msk, facet, nu, index)
Wall model factory. Both constructs and initializes the object.
subroutine wall_model_find_points(this)
Find sampling points based on the requested index.
subroutine wall_model_free_base(this)
Destructor for the wall_model_t (base) class.
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
Base abstract type for wall-stress models for wall-modelled LES.