39 use json_module,
only : json_file
46 use,
intrinsic :: iso_c_binding
64 real(kind=
rp),
allocatable :: s(:, :, :, :)
67 type(c_ptr) :: s_d = c_null_ptr
73 compute_vector_ => null()
78 procedure, pass(this) :: init_from_components => &
93 real(kind=
rp),
intent(in) :: t
107 real(kind=
rp),
intent(inout) :: s
108 integer,
intent(in) :: j
109 integer,
intent(in) :: k
110 integer,
intent(in) :: l
111 integer,
intent(in) :: e
112 real(kind=
rp),
intent(in) :: t
124 type(json_file),
intent(inout) :: json
126 type(
coef_t),
intent(inout),
target :: coef
128 call neko_error(
"The user scalar source term &
129 &should be init from components")
141 source_term_type, eval_vector, eval_pointwise)
144 type(
coef_t),
intent(inout) :: coef
145 character(len=*) :: source_term_type
150 call this%init_base(fields, coef, 0.0_rp, huge(0.0_rp))
152 this%dm => fields%dof(1)
154 allocate(this%s(this%dm%Xh%lx, this%dm%Xh%ly, this%dm%Xh%lz, &
160 call device_map(this%s, this%s_d, this%dm%size())
164 if (trim(source_term_type) .eq.
'user_pointwise' .and. &
165 present(eval_pointwise))
then
168 &supported on accelerators')
171 this%compute_pw_ => eval_pointwise
172 else if (trim(source_term_type) .eq.
'user_vector' .and. &
173 present(eval_vector))
then
174 this%compute_vector_ => eval_vector
176 call neko_error(
'Invalid fluid source term '//source_term_type)
184 if (
allocated(this%s))
deallocate(this%s)
186 if (c_associated(this%s_d))
call device_free(this%s_d)
188 nullify(this%compute_vector_)
189 nullify(this%compute_pw_)
192 call this%free_base()
200 real(kind=
rp),
intent(in) :: t
201 integer,
intent(in) :: tstep
204 if (t .ge. this%start_time .and. t .le. this%end_time)
then
205 call this%compute_vector_(this, t)
206 n = this%fields%item_size(1)
211 call add2(this%fields%items(1)%ptr%x, this%s, n)
220 real(kind=
rp),
intent(in) :: t
221 integer :: j, k, l, e
222 integer :: jj, kk, ll, ee
226 do e = 1,
size(this%s, 4)
228 do l = 1,
size(this%s, 3)
230 do k = 1,
size(this%s, 2)
232 do j = 1,
size(this%s, 1)
234 call this%compute_pw_(this%s(j,k,l,e), jj, kk, ll, ee, t)
240 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.
subroutine, public add2(a, b, n)
Vector addition .
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Implements the scalar_user_source_term_t type.
subroutine pointwise_eval_driver(this, t)
Driver for all pointwise source term evaluatons.
subroutine scalar_user_source_term_init_from_components(this, fields, coef, source_term_type, eval_vector, eval_pointwise)
Constructor from components.
subroutine scalar_user_source_term_free(this)
Destructor.
subroutine scalar_user_source_term_init(this, json, fields, coef)
Constructor from JSON.
subroutine scalar_user_source_term_compute(this, t, tstep)
Computes the source term and adds the result to fields.
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 scalar, with procedure pointers pointing to the actual implementation in the us...
Base abstract type for source terms.