41 use,
intrinsic :: iso_fortran_env
42 use,
intrinsic :: iso_c_binding
49 real(kind=
rp),
dimension(3) :: uinf = (/0d0, 0d0, 0d0 /)
50 real(kind=
rp) :: delta
52 type(c_ptr),
private :: blax_d = c_null_ptr
53 type(c_ptr),
private :: blay_d = c_null_ptr
54 type(c_ptr),
private :: blaz_d = c_null_ptr
68 class(
blasius_t),
target,
intent(inout) :: this
73 if (c_associated(this%blax_d))
then
77 if (c_associated(this%blay_d))
then
81 if (c_associated(this%blaz_d))
then
90 integer,
intent(in) :: n
91 real(kind=
rp),
intent(inout),
dimension(n) :: x
92 real(kind=
rp),
intent(in),
optional :: t
93 integer,
intent(in),
optional :: tstep
98 class(
blasius_t),
intent(inout),
target :: this
100 real(kind=
rp),
intent(in),
optional :: t
101 integer,
intent(in),
optional :: tstep
107 integer,
intent(in) :: n
108 real(kind=
rp),
intent(inout),
dimension(n) :: x
109 real(kind=
rp),
intent(inout),
dimension(n) :: y
110 real(kind=
rp),
intent(inout),
dimension(n) :: z
111 real(kind=
rp),
intent(in),
optional :: t
112 integer,
intent(in),
optional :: tstep
113 integer :: i, m, k, idx(4), facet
115 associate(xc => this%coef%dof%x, yc => this%coef%dof%y, &
116 zc => this%coef%dof%z, nx => this%coef%nx, ny => this%coef%ny, &
117 nz => this%coef%nz, lx => this%coef%Xh%lx)
121 facet = this%facet(i)
125 x(k) = this%bla(zc(idx(1), idx(2), idx(3), idx(4)), &
126 this%delta, this%uinf(1))
131 y(k) = this%bla(xc(idx(1), idx(2), idx(3), idx(4)), &
132 this%delta, this%uinf(2))
137 z(k) = this%bla(yc(idx(1), idx(2), idx(3), idx(4)), &
138 this%delta, this%uinf(3))
146 class(
blasius_t),
intent(inout),
target :: this
150 real(kind=rp),
intent(in),
optional :: t
151 integer,
intent(in),
optional :: tstep
152 integer :: i, m, k, idx(4), facet
153 integer(c_size_t) :: s
154 real(kind=rp),
allocatable :: bla_x(:), bla_y(:), bla_z(:)
156 associate(xc => this%coef%dof%x, yc => this%coef%dof%y, &
157 zc => this%coef%dof%z, nx => this%coef%nx, ny => this%coef%ny, &
158 nz => this%coef%nz, lx => this%coef%Xh%lx , blax_d => this%blax_d,&
159 blay_d => this%blay_d, blaz_d => this%blaz_d)
165 if (.not. c_associated(blax_d))
then
166 allocate(bla_x(m), bla_y(m), bla_z(m))
168 if (rp .eq. real32)
then
170 else if (rp .eq. real64)
then
174 call device_alloc(blax_d, s)
175 call device_alloc(blay_d, s)
176 call device_alloc(blaz_d, s)
180 facet = this%facet(i)
184 bla_x(i) = this%bla(zc(idx(1), idx(2), idx(3), idx(4)), &
185 this%delta, this%uinf(1))
190 bla_y(i) = this%bla(xc(idx(1), idx(2), idx(3), idx(4)), &
191 this%delta, this%uinf(2))
196 bla_z(i) = this%bla(yc(idx(1), idx(2), idx(3), idx(4)), &
197 this%delta, this%uinf(3))
201 call device_memcpy(bla_x, blax_d, m, host_to_device, sync=.false.)
202 call device_memcpy(bla_y, blay_d, m, host_to_device, sync=.false.)
203 call device_memcpy(bla_z, blaz_d, m, host_to_device, sync=.true.)
205 deallocate(bla_x, bla_y, bla_z)
208 call device_inhom_dirichlet_apply_vector(this%msk_d, x_d, y_d, z_d, &
209 blax_d, blay_d, blaz_d, m)
218 real(kind=rp),
intent(in) :: uinf(3)
219 real(kind=rp),
intent(in) :: delta
220 character(len=*) :: type
224 select case(trim(type))
226 this%bla => blasius_linear
228 this%bla => blasius_quadratic
230 this%bla => blasius_cubic
232 this%bla => blasius_quartic
234 this%bla => blasius_sin
236 call neko_error(
'Invalid Blasius approximation')
__device__ void nonlinear_index(const int idx, const int lx, int *index)
Abstract interface for computing a Blasius flow profile.
Defines a boundary condition.
Defines a Blasius profile dirichlet condition.
subroutine blasius_apply_vector(this, x, y, z, n, t, tstep)
Apply blasius conditions (vector valued)
subroutine blasius_apply_vector_dev(this, x_d, y_d, z_d, t, tstep)
Apply blasius conditions (vector valued) (device version)
subroutine blasius_apply_scalar_dev(this, x_d, t, tstep)
No-op scalar apply (device version)
subroutine blasius_apply_scalar(this, x, n, t, tstep)
No-op scalar apply.
subroutine blasius_free(this)
subroutine blasius_set_params(this, uinf, delta, type)
Set Blasius parameters.
Device abstraction, common interface for various accelerators.
subroutine, public device_free(x_d)
Deallocate memory on the device.
integer, parameter, public rp
Global precision used in computations.
Base type for a boundary condition.
Blasius profile for inlet (vector valued)
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...