Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
point_zone.f90
Go to the documentation of this file.
1! Copyright (c) 2019-2024, The Neko Authors
2! All rights reserved.
3!
4! Redistribution and use in source and binary forms, with or without
5! modification, are permitted provided that the following conditions
6! are met:
7!
8! * Redistributions of source code must retain the above copyright
9! notice, this list of conditions and the following disclaimer.
10!
11! * Redistributions in binary form must reproduce the above
12! copyright notice, this list of conditions and the following
13! disclaimer in the documentation and/or other materials provided
14! with the distribution.
15!
16! * Neither the name of the authors nor the names of its
17! contributors may be used to endorse or promote products derived
18! from this software without specific prior written permission.
19!
20! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23! FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24! COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25! INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26! BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30! ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31! POSSIBILITY OF SUCH DAMAGE.
32!
33! Implements a zone as a subset of GLL points in the mesh
35 use stack, only: stack_i4_t
36 use num_types, only: rp
38 use dofmap, only: dofmap_t
39 use json_module, only: json_file
41 use mask, only: mask_t
43 use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr, c_associated
44 implicit none
45 private
46
48 type, public, abstract :: point_zone_t
50 type(mask_t) :: mask
52 type(stack_i4_t), private :: scratch
54 integer :: size = 0
57 logical, private :: finalized = .false.
59 character(len=80) :: name
61 logical :: invert = .false.
62 contains
64 procedure, pass(this) :: init_base => point_zone_init_base
66 procedure, pass(this) :: free_base => point_zone_free_base
68 procedure, pass(this) :: finalize => point_zone_finalize
70 procedure, pass(this) :: add => point_zone_add
73 procedure, pass(this) :: map => point_zone_map
75 procedure(point_zone_init), pass(this), deferred :: init
77 procedure(point_zone_free), pass(this), deferred :: free
79 procedure(point_zone_criterion), pass(this), deferred :: criterion
80 end type point_zone_t
81
83 type, public :: point_zone_wrapper_t
84 class(point_zone_t), allocatable :: pz
86
88 type, public :: point_zone_pointer_t
89 class(point_zone_t), pointer :: pz => null()
91
92 abstract interface
93
101 pure function point_zone_criterion(this, x, y, z, j, k, l, e) &
102 result(is_inside)
103 import :: point_zone_t
104 import :: rp
105 class(point_zone_t), intent(in) :: this
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
113 logical :: is_inside
114 end function point_zone_criterion
115 end interface
116
117 abstract interface
118
121 subroutine point_zone_init(this, json, size)
122 import :: point_zone_t
123 import :: json_file
124 import :: dofmap_t
125 class(point_zone_t), intent(inout) :: this
126 type(json_file), intent(inout) :: json
127 integer, intent(in) :: size
128 end subroutine point_zone_init
129 end interface
130
131 abstract interface
132
133 subroutine point_zone_free(this)
134 import :: point_zone_t
135 class(point_zone_t), intent(inout) :: this
136 end subroutine point_zone_free
137 end interface
138
139 interface
140
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
150 end interface
151
152 interface
153
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
160 end interface
161
162 !
163 ! Machinery for injecting user-defined types
164 !
165
169 abstract interface
170 subroutine point_zone_allocate(obj)
171 import point_zone_t
172 class(point_zone_t), allocatable, intent(inout) :: obj
173 end subroutine point_zone_allocate
174 end interface
175
176 interface
177
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
182 end interface
183
184 ! A name-allocator pair for user-defined types. A helper type to define a
185 ! registry of custom allocators.
186 type allocator_entry
187 character(len=20) :: type_name
188 procedure(point_zone_allocate), pointer, nopass :: allocator
189 end type allocator_entry
190
192 type(allocator_entry), allocatable :: point_zone_registry(:)
193
195 integer :: point_zone_registry_size = 0
196
197 public :: point_zone_factory, point_zone_allocator, register_point_zone, &
198 point_zone_allocate
199
200contains
201
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
212
213 call point_zone_free_base(this)
214
215 if (present(size)) then
216 call this%scratch%init(size)
217 else
218 call this%scratch%init()
219 end if
220
221 this%name = trim(name)
222 this%invert = invert
223
224 end subroutine point_zone_init_base
225
227 subroutine point_zone_free_base(this)
228 class(point_zone_t), intent(inout) :: this
229
230 this%finalized = .false.
231 this%size = 0
232
233 call this%scratch%free()
234 call this%mask%free()
235
236 end subroutine point_zone_free_base
237
239 subroutine point_zone_finalize(this)
240 class(point_zone_t), intent(inout) :: this
241 integer, pointer :: tp(:)
242
243 if (.not. this%finalized) then
244
245 if (this%scratch%size() .ne. 0) then
246
247 tp => this%scratch%array()
248 this%size = this%scratch%size()
249 call this%mask%init(tp, this%size)
250
251 call this%scratch%clear()
252 else
253
254 this%size = 0
255 tp => this%scratch%array()
256 call this%mask%init(tp, this%size)
257
258 call this%scratch%clear()
259
260 end if
261
262 this%finalized = .true.
263
264 end if
265
266 end subroutine point_zone_finalize
267
272 subroutine point_zone_add(this, idx)
273 class(point_zone_t), intent(inout) :: this
274 integer, intent(inout) :: idx
275
276 if (this%finalized) then
277 call neko_error('Point zone already finalized')
278 end if
279
280 call this%scratch%push(idx)
281
282 end subroutine point_zone_add
283
287 subroutine point_zone_map(this, dof)
288 class(point_zone_t), intent(inout) :: this
289 type(dofmap_t), intent(in) :: dof
290
291 integer :: i, ix, iy, iz, ie, nlindex(4), lx, idx
292 real(kind=rp) :: x, y, z
293
294 lx = dof%Xh%lx
295
296 do i = 1, dof%size()
297 nlindex = nonlinear_index(i, lx, lx, lx)
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))
301 ix = nlindex(1)
302 iy = nlindex(2)
303 iz = nlindex(3)
304 ie = nlindex(4)
305
306 if (this%invert .neqv. this%criterion(x, y, z, ix, iy, iz, ie)) then
307 idx = i
308 call this%add(idx)
309 end if
310 end do
311
312 end subroutine point_zone_map
313
314end module point_zone
__inline__ __device__ void nonlinear_index(const int idx, const int lx, int *index)
Definition bc_utils.h:44
Map a Fortran array to a device (allocate and associate)
Definition device.F90:72
Copy data between host and device (or device and device)
Definition device.F90:66
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.
Definition device.F90:34
subroutine, public device_free(x_d)
Deallocate memory on the device.
Definition device.F90:214
Defines a mapping of the degrees of freedom.
Definition dofmap.f90:35
NEKTON map.
Definition map.f90:3
Object for handling masks in Neko.
Definition mask.f90:34
Build configurations.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
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.
Definition stack.f90:35
Utilities.
Definition utils.f90:35
Type for consistently handling masks in Neko. This type encapsulates the mask array and its associate...
Definition mask.f90:51
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.
Integer based stack.
Definition stack.f90:63