39 use json_module,
only: json_file
43 use,
intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr, c_associated
57 logical,
private :: finalized = .false.
59 character(len=80) :: name
61 logical :: invert = .false.
106 real(kind=
rp),
intent(in) :: x
107 real(kind=
rp),
intent(in) :: y
108 real(kind=
rp),
intent(in) :: z
109 integer,
intent(in) :: j
110 integer,
intent(in) :: k
111 integer,
intent(in) :: l
112 integer,
intent(in) :: e
126 type(json_file),
intent(inout) :: json
127 integer,
intent(in) :: size
145 module subroutine point_zone_factory(object, json, dof)
146 class(point_zone_t),
allocatable,
intent(inout) :: object
147 type(json_file),
intent(inout) :: json
148 type(
dofmap_t),
intent(inout),
optional :: dof
149 end subroutine point_zone_factory
156 module subroutine point_zone_allocator(object, type_name)
157 class(point_zone_t),
allocatable,
intent(inout) :: object
158 character(len=:),
allocatable,
intent(in) :: type_name
159 end subroutine point_zone_allocator
170 subroutine point_zone_allocate(obj)
172 class(point_zone_t),
allocatable,
intent(inout) :: obj
173 end subroutine point_zone_allocate
178 module subroutine register_point_zone(type_name, allocator)
179 character(len=*),
intent(in) :: type_name
180 procedure(point_zone_allocate),
pointer,
intent(in) :: allocator
181 end subroutine register_point_zone
187 character(len=20) :: type_name
188 procedure(point_zone_allocate),
pointer,
nopass :: allocator
189 end type allocator_entry
195 integer :: point_zone_registry_size = 0
197 public :: point_zone_factory, point_zone_allocator, register_point_zone, &
207 subroutine point_zone_init_base(this, size, name, invert)
208 class(point_zone_t),
intent(inout) :: this
209 integer,
intent(in),
optional :: size
210 character(len=*),
intent(in) :: name
211 logical,
intent(in) :: invert
213 call point_zone_free_base(this)
215 if (
present(size))
then
216 call this%scratch%init(size)
218 call this%scratch%init()
221 this%name = trim(name)
224 end subroutine point_zone_init_base
227 subroutine point_zone_free_base(this)
228 class(point_zone_t),
intent(inout) :: this
230 this%finalized = .false.
233 call this%scratch%free()
234 call this%mask%free()
236 end subroutine point_zone_free_base
239 subroutine point_zone_finalize(this)
240 class(point_zone_t),
intent(inout) :: this
241 integer,
pointer :: tp(:)
243 if (.not. this%finalized)
then
245 if (this%scratch%size() .ne. 0)
then
247 tp => this%scratch%array()
248 this%size = this%scratch%size()
249 call this%mask%init(tp, this%size)
251 call this%scratch%clear()
255 tp => this%scratch%array()
256 call this%mask%init(tp, this%size)
258 call this%scratch%clear()
262 this%finalized = .true.
266 end subroutine point_zone_finalize
272 subroutine point_zone_add(this, idx)
273 class(point_zone_t),
intent(inout) :: this
274 integer,
intent(inout) :: idx
276 if (this%finalized)
then
277 call neko_error(
'Point zone already finalized')
280 call this%scratch%push(idx)
282 end subroutine point_zone_add
287 subroutine point_zone_map(this, dof)
288 class(point_zone_t),
intent(inout) :: this
291 integer :: i, ix, iy, iz, ie, nlindex(4), lx, idx
292 real(kind=
rp) :: x, y, z
298 x = dof%x(nlindex(1), nlindex(2), nlindex(3), nlindex(4))
299 y = dof%y(nlindex(1), nlindex(2), nlindex(3), nlindex(4))
300 z = dof%z(nlindex(1), nlindex(2), nlindex(3), nlindex(4))
306 if (this%invert .neqv. this%criterion(x, y, z, ix, iy, iz, ie))
then
312 end subroutine point_zone_map
__inline__ __device__ void nonlinear_index(const int idx, const int lx, int *index)
Map a Fortran array to a device (allocate and associate)
Copy data between host and device (or device and device)
Defines the criterion of selection of a GLL point to the point_zone.
The common constructor using a JSON object.
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.
Object for handling masks in Neko.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
subroutine point_zone_free_base(this)
Destructor for the point_zone_t base type.
subroutine point_zone_add(this, idx)
Adds a point's linear index to the scratch stack.
subroutine point_zone_finalize(this)
Builds the mask from the scratch stack.
subroutine point_zone_init_base(this, size, name, invert)
Constructor for the point_zone_t base type.
subroutine point_zone_map(this, dof)
Maps the GLL points that verify a point_zone's criterion by adding them to the stack.
Implements a dynamic stack ADT.
Type for consistently handling masks in Neko. This type encapsulates the mask array and its associate...
A helper type to build a list of pointers to point_zones.
Base abstract type for point zones.
A helper type to build a list of polymorphic point_zones.