40 use,
intrinsic :: iso_c_binding, only : c_ptr
50 class(
bc_ptr_t),
allocatable,
private :: items(:)
52 integer,
private :: size_
55 integer,
private :: capacity
75 generic :: apply => apply_scalar, apply_vector, &
76 apply_scalar_device, apply_vector_device, &
77 apply_scalar_field, apply_vector_field
97 class(
bc_list_t),
intent(inout),
target :: this
98 integer,
optional :: capacity
104 if (
present(capacity)) n = capacity
106 allocate(this%items(n))
120 if (
allocated(this%items))
then
122 this%items(i)%ptr => null()
125 deallocate(this%items)
137 class(
bc_t),
intent(inout),
target :: bc
138 type(
bc_ptr_t),
allocatable :: tmp(:)
140 if (this%size_ .ge. this%capacity)
then
141 this%capacity = this%capacity * 2
142 allocate(tmp(this%capacity))
143 tmp(1:this%size_) = this%items
144 call move_alloc(tmp, this%items)
147 this%size_ = this%size_ + 1
148 this%items(this%size_)%ptr =>
bc
157 class(
bc_t),
pointer ::
bc
158 integer,
intent(in) :: i
160 if (i .lt. 1 .or. i .gt. this%size_)
then
161 call neko_error(
"Index out of bounds in bc_list_get")
164 bc => this%items(i)%ptr
177 integer,
intent(in) :: n
178 real(kind=
rp),
intent(inout),
dimension(n) :: x
180 logical,
intent(in),
optional :: strong
181 type(c_ptr),
intent(inout),
optional :: strm
189 call this%apply_scalar_device(x_d, time = time, &
190 strong = strong, strm = strm)
193 call this%items(i)%ptr%apply_scalar(x, n, time = time, &
210 integer,
intent(in) :: n
211 real(kind=
rp),
intent(inout),
dimension(n) :: x
212 real(kind=
rp),
intent(inout),
dimension(n) :: y
213 real(kind=
rp),
intent(inout),
dimension(n) :: z
215 logical,
intent(in),
optional :: strong
216 type(c_ptr),
intent(inout),
optional :: strm
228 call this%apply_vector_device(x_d, y_d, z_d, time = time, &
229 strong = strong, strm = strm)
232 call this%items(i)%ptr%apply_vector(x, y, z, n, time = time, &
247 type(c_ptr),
intent(inout) :: x_d
249 logical,
intent(in),
optional :: strong
250 type(c_ptr),
intent(inout),
optional :: strm
254 if (
present(strm))
then
261 call this%items(i)%ptr%apply_scalar_dev(x_d, time = time, &
262 strong = strong, strm = strm_)
278 type(c_ptr),
intent(inout) :: x_d
279 type(c_ptr),
intent(inout) :: y_d
280 type(c_ptr),
intent(inout) :: z_d
282 logical,
intent(in),
optional :: strong
283 type(c_ptr),
intent(inout),
optional :: strm
287 if (
present(strm))
then
294 call this%items(i)%ptr%apply_vector_dev(x_d, y_d, z_d, time = time, &
295 strong = strong, strm = strm_)
308 type(
field_t),
intent(inout) :: x
310 logical,
intent(in),
optional :: strong
311 type(c_ptr),
intent(inout),
optional :: strm
315 call this%items(i)%ptr%apply_scalar_generic(x, time = time, &
316 strong = strong, strm = strm)
331 type(
field_t),
intent(inout) :: x
332 type(
field_t),
intent(inout) :: y
333 type(
field_t),
intent(inout) :: z
335 logical,
intent(in),
optional :: strong
336 type(c_ptr),
intent(inout),
optional :: strm
340 call this%items(i)%ptr%apply_vector_generic(x, y, z, time = time, &
341 strong = strong, strm = strm)
348 class(
bc_list_t),
intent(in),
target :: this
349 integer,
intent(in) :: i
352 strong = this%items(i)%ptr%strong
357 class(
bc_list_t),
intent(in),
target :: this
364 if (.not.
allocated(this%items(i)%ptr%msk))
then
365 call neko_error(
"bc not finalized, error in bc_list%is_empty")
368 if (this%items(i)%ptr%msk(0) > 0) is_empty = .false.
375 class(
bc_list_t),
intent(in),
target :: this
Return the device pointer for an associated Fortran array.
pure logical function bc_list_strong(this, i)
Return whether the bc is strong or not.
subroutine bc_list_apply_vector_array(this, x, y, z, n, time, strong, strm)
Apply a list of boundary conditions to a vector field.
subroutine bc_list_apply_vector_device(this, x_d, y_d, z_d, time, strong, strm)
Apply a list of boundary conditions to a vector field on the device.
class(bc_t) function, pointer bc_list_get(this, i)
Get the item at the given index.
subroutine bc_list_apply_scalar_array(this, x, n, time, strong, strm)
Apply a list of boundary conditions to a scalar field.
subroutine bc_list_apply_scalar_device(this, x_d, time, strong, strm)
Apply a list of boundary conditions to a scalar field on the device.
pure integer function bc_list_size(this)
Return the number of items in the list.
subroutine bc_list_append(this, bc)
Append a condition to the end of the list.
subroutine bc_list_init(this, capacity)
Constructor.
subroutine bc_list_apply_vector_field(this, x, y, z, time, strong, strm)
Apply a list of boundary conditions to a vector field.
subroutine bc_list_free(this)
Destructor.
subroutine bc_list_apply_scalar_field(this, x, time, strong, strm)
Apply a list of boundary conditions to a scalar field.
logical function bc_list_is_empty(this)
Return whether the list is empty.
Defines a boundary condition.
Device abstraction, common interface for various accelerators.
type(c_ptr), bind(C), public glb_cmd_queue
Global command queue.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Module with things related to the simulation time.
Base type for a boundary condition.
A list of allocatable `bc_t`. Follows the standard interface of lists.
A struct that contains all info about the time, expand as needed.