39 use json_module,
only : json_file
46 use,
intrinsic :: iso_c_binding
64 real(kind=
rp),
allocatable :: u(:, :, :, :)
66 real(kind=
rp),
allocatable :: v(:, :, :, :)
68 real(kind=
rp),
allocatable :: w(:, :, :, :)
71 type(c_ptr) :: u_d = c_null_ptr
73 type(c_ptr) :: v_d = c_null_ptr
75 type(c_ptr) :: w_d = c_null_ptr
86 procedure, pass(this) :: init_from_components => &
101 real(kind=
rp),
intent(in) :: t
117 real(kind=
rp),
intent(inout) :: u
118 real(kind=
rp),
intent(inout) :: v
119 real(kind=
rp),
intent(inout) :: w
120 integer,
intent(in) :: j
121 integer,
intent(in) :: k
122 integer,
intent(in) :: l
123 integer,
intent(in) :: e
124 real(kind=
rp),
intent(in) :: t
136 type(json_file),
intent(inout) :: json
138 type(
coef_t),
intent(inout),
target :: coef
140 call neko_error(
"The user fluid source term should be init from components")
152 source_term_type, eval_vector, eval_pointwise)
155 type(
coef_t),
intent(inout),
target :: coef
156 character(len=*) :: source_term_type
161 call this%init_base(fields, coef, 0.0_rp, huge(0.0_rp))
163 this%dm => fields%dof(1)
165 allocate(this%u(this%dm%Xh%lx, this%dm%Xh%ly, this%dm%Xh%lz, &
167 allocate(this%v(this%dm%Xh%lx, this%dm%Xh%ly, this%dm%Xh%lz, &
169 allocate(this%w(this%dm%Xh%lx, this%dm%Xh%ly, this%dm%Xh%lz, &
177 call device_map(this%u, this%u_d, this%dm%size())
178 call device_map(this%v, this%v_d, this%dm%size())
179 call device_map(this%w, this%w_d, this%dm%size())
183 if (trim(source_term_type) .eq.
'user_pointwise' .and. &
184 present(eval_pointwise))
then
187 ¬ supported on accelerators')
190 this%compute_pw_ => eval_pointwise
191 else if (trim(source_term_type) .eq.
'user_vector' .and. &
192 present(eval_vector))
then
193 this%compute_vector_ => eval_vector
195 call neko_error(
'Invalid fluid source term '//source_term_type)
203 if (
allocated(this%u))
deallocate(this%u)
204 if (
allocated(this%v))
deallocate(this%v)
205 if (
allocated(this%w))
deallocate(this%w)
207 if (c_associated(this%u_d))
call device_free(this%u_d)
208 if (c_associated(this%v_d))
call device_free(this%v_d)
209 if (c_associated(this%w_d))
call device_free(this%w_d)
211 nullify(this%compute_vector_)
212 nullify(this%compute_pw_)
215 call this%free_base()
223 real(kind=
rp),
intent(in) :: t
224 integer,
intent(in) :: tstep
227 if (t .ge. this%start_time .and. t .le. this%end_time)
then
228 call this%compute_vector_(this, t)
229 n = this%fields%item_size(1)
236 call add2(this%fields%items(1)%ptr%x, this%u, n)
237 call add2(this%fields%items(2)%ptr%x, this%v, n)
238 call add2(this%fields%items(3)%ptr%x, this%w, n)
247 real(kind=
rp),
intent(in) :: t
248 integer :: j, k, l, e
249 integer :: jj, kk, ll, ee
253 do e = 1,
size(this%u, 4)
255 do l = 1,
size(this%u, 3)
257 do k = 1,
size(this%u, 2)
259 do j = 1,
size(this%u, 1)
261 call this%compute_pw_(this%u(j,k,l,e), &
270 call neko_error(
'Incorrect source type in pointwise eval driver!')
Map a Fortran array to a device (allocate and associate)
Computes the source term at a single point.
Computes the source term and adds the result to fields.
subroutine, public device_add2(a_d, b_d, n)
Vector addition .
Device abstraction, common interface for various accelerators.
subroutine, public device_free(x_d)
Deallocate memory on the device.
Defines a mapping of the degrees of freedom.
Implements the fluid_user_source_term_t type.
subroutine pointwise_eval_driver(this, t)
Driver for all pointwise source term evaluatons.
subroutine fluid_user_source_term_compute(this, t, tstep)
Computes the source term and adds the result to fields.
subroutine fluid_user_source_term_init(this, json, fields, coef)
Costructor from JSON.
subroutine fluid_user_source_term_init_from_components(this, fields, coef, source_term_type, eval_vector, eval_pointwise)
Costructor from components.
subroutine fluid_user_source_term_free(this)
Destructor.
subroutine, public add2(a, b, n)
Vector addition .
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Implements the source_term_t type and a wrapper source_term_wrapper_t.
Coefficients defined on a given (mesh, ) tuple. Arrays use indices (i,j,k,e): element e,...
field_list_t, To be able to group fields together
A source-term for the fluid, with procedure pointers pointing to the actual implementation in the use...
Base abstract type for source terms.