Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
bc_list.f90
Go to the documentation of this file.
1! Copyright (c) 2024-2025, 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!
34module bc_list
36 use num_types, only : rp
37 use field, only : field_t
39 use utils, only : neko_error
40 use, intrinsic :: iso_c_binding, only : c_ptr
41 use bc, only : bc_t, bc_ptr_t
42 use time_state, only : time_state_t
43 implicit none
44 private
45
48 type, public :: bc_list_t
49 ! The items of the list.
50 class(bc_ptr_t), allocatable, private :: items(:)
52 integer, private :: size_
55 integer, private :: capacity
56 contains
58 procedure, pass(this) :: init => bc_list_init
60 procedure, pass(this) :: free => bc_list_free
61
63 procedure, pass(this) :: append => bc_list_append
65 procedure, pass(this) :: get => bc_list_get
66
68 procedure, pass(this) :: is_empty => bc_list_is_empty
70 procedure, pass(this) :: strong => bc_list_strong
72 procedure :: size => bc_list_size
73
75 generic :: apply => apply_scalar, apply_vector, &
76 apply_scalar_device, apply_vector_device, &
77 apply_scalar_field, apply_vector_field
79 procedure, pass(this) :: apply_scalar => bc_list_apply_scalar_array
81 procedure, pass(this) :: apply_vector => bc_list_apply_vector_array
83 procedure, pass(this) :: apply_scalar_device => bc_list_apply_scalar_device
85 procedure, pass(this) :: apply_vector_device => bc_list_apply_vector_device
87 procedure, pass(this) :: apply_scalar_field => bc_list_apply_scalar_field
89 procedure, pass(this) :: apply_vector_field => bc_list_apply_vector_field
90 end type bc_list_t
91
92contains
93
96 subroutine bc_list_init(this, capacity)
97 class(bc_list_t), intent(inout), target :: this
98 integer, optional :: capacity
99 integer :: n
100
101 call this%free()
102
103 n = 1
104 if (present(capacity)) n = capacity
105
106 allocate(this%items(n))
107
108 this%size_ = 0
109 this%capacity = n
110
111 end subroutine bc_list_init
112
116 subroutine bc_list_free(this)
117 class(bc_list_t), intent(inout) :: this
118 integer :: i
119
120 if (allocated(this%items)) then
121 do i = 1, this%size_
122 this%items(i)%ptr => null()
123 end do
124
125 deallocate(this%items)
126 end if
127
128 this%size_ = 0
129 this%capacity = 0
130 end subroutine bc_list_free
131
135 subroutine bc_list_append(this, bc)
136 class(bc_list_t), intent(inout) :: this
137 class(bc_t), intent(inout), target :: bc
138 type(bc_ptr_t), allocatable :: tmp(:)
139
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)
145 end if
146
147 this%size_ = this%size_ + 1
148 this%items(this%size_)%ptr => bc
149
150 end subroutine bc_list_append
151
155 function bc_list_get(this, i) result(bc)
156 class(bc_list_t), intent(in) :: this
157 class(bc_t), pointer :: bc
158 integer, intent(in) :: i
159
160 if (i .lt. 1 .or. i .gt. this%size_) then
161 call neko_error("Index out of bounds in bc_list_get")
162 end if
163
164 bc => this%items(i)%ptr
165
166 end function bc_list_get
167
175 subroutine bc_list_apply_scalar_array(this, x, n, time, strong, strm)
176 class(bc_list_t), intent(inout) :: this
177 integer, intent(in) :: n
178 real(kind=rp), intent(inout), dimension(n) :: x
179 type(time_state_t), intent(in), optional :: time
180 logical, intent(in), optional :: strong
181 type(c_ptr), intent(inout), optional :: strm
182 type(c_ptr) :: x_d
183 integer :: i
184
185 if (neko_bcknd_device .eq. 1) then
186
187 x_d = device_get_ptr(x)
188
189 call this%apply_scalar_device(x_d, time = time, &
190 strong = strong, strm = strm)
191 else
192 do i = 1, this%size_
193 call this%items(i)%ptr%apply_scalar(x, n, time = time, &
194 strong = strong)
195 end do
196 end if
197 end subroutine bc_list_apply_scalar_array
198
208 subroutine bc_list_apply_vector_array(this, x, y, z, n, time, strong, strm)
209 class(bc_list_t), intent(inout) :: this
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
214 type(time_state_t), intent(in), optional :: time
215 logical, intent(in), optional :: strong
216 type(c_ptr), intent(inout), optional :: strm
217 type(c_ptr) :: x_d
218 type(c_ptr) :: y_d
219 type(c_ptr) :: z_d
220 integer :: i
221
222 if (neko_bcknd_device .eq. 1) then
223
224 x_d = device_get_ptr(x)
225 y_d = device_get_ptr(y)
226 z_d = device_get_ptr(z)
227
228 call this%apply_vector_device(x_d, y_d, z_d, time = time, &
229 strong = strong, strm = strm)
230 else
231 do i = 1, this%size_
232 call this%items(i)%ptr%apply_vector(x, y, z, n, time = time, &
233 strong = strong)
234 end do
235 end if
236
237 end subroutine bc_list_apply_vector_array
238
245 subroutine bc_list_apply_scalar_device(this, x_d, time, strong, strm)
246 class(bc_list_t), intent(inout) :: this
247 type(c_ptr), intent(inout) :: x_d
248 type(time_state_t), intent(in), optional :: time
249 logical, intent(in), optional :: strong
250 type(c_ptr), intent(inout), optional :: strm
251 type(c_ptr) :: strm_
252 integer :: i
253
254 if (present(strm)) then
255 strm_ = strm
256 else
257 strm_ = glb_cmd_queue
258 end if
259
260 do i = 1, this%size_
261 call this%items(i)%ptr%apply_scalar_dev(x_d, time = time, &
262 strong = strong, strm = strm_)
263 end do
264
265 end subroutine bc_list_apply_scalar_device
266
275 subroutine bc_list_apply_vector_device(this, x_d, y_d, z_d, time, strong, &
276 strm)
277 class(bc_list_t), intent(inout) :: this
278 type(c_ptr), intent(inout) :: x_d
279 type(c_ptr), intent(inout) :: y_d
280 type(c_ptr), intent(inout) :: z_d
281 type(time_state_t), intent(in), optional :: time
282 logical, intent(in), optional :: strong
283 type(c_ptr), intent(inout), optional :: strm
284 type(c_ptr) :: strm_
285 integer :: i
286
287 if (present(strm)) then
288 strm_ = strm
289 else
290 strm_ = glb_cmd_queue
291 end if
292
293 do i = 1, this%size_
294 call this%items(i)%ptr%apply_vector_dev(x_d, y_d, z_d, time = time, &
295 strong = strong, strm = strm_)
296 end do
297
298 end subroutine bc_list_apply_vector_device
299
306 subroutine bc_list_apply_scalar_field(this, x, time, strong, strm)
307 class(bc_list_t), intent(inout) :: this
308 type(field_t), intent(inout) :: x
309 type(time_state_t), intent(in), optional :: time
310 logical, intent(in), optional :: strong
311 type(c_ptr), intent(inout), optional :: strm
312 integer :: i
313
314 do i = 1, this%size_
315 call this%items(i)%ptr%apply_scalar_generic(x, time = time, &
316 strong = strong, strm = strm)
317 end do
318
319 end subroutine bc_list_apply_scalar_field
320
329 subroutine bc_list_apply_vector_field(this, x, y, z, time, strong, strm)
330 class(bc_list_t), intent(inout) :: this
331 type(field_t), intent(inout) :: x
332 type(field_t), intent(inout) :: y
333 type(field_t), intent(inout) :: z
334 type(time_state_t), intent(in), optional :: time
335 logical, intent(in), optional :: strong
336 type(c_ptr), intent(inout), optional :: strm
337 integer :: i
338
339 do i = 1, this%size_
340 call this%items(i)%ptr%apply_vector_generic(x, y, z, time = time, &
341 strong = strong, strm = strm)
342 end do
343
344 end subroutine bc_list_apply_vector_field
345
347 pure function bc_list_strong(this, i) result(strong)
348 class(bc_list_t), intent(in), target :: this
349 integer, intent(in) :: i
350 logical :: strong
351
352 strong = this%items(i)%ptr%strong
353 end function bc_list_strong
354
356 function bc_list_is_empty(this) result(is_empty)
357 class(bc_list_t), intent(in), target :: this
358 logical :: is_empty
359 integer :: i
360
361 is_empty = .true.
362 do i = 1, this%size_
363
364 if (.not. allocated(this%items(i)%ptr%msk)) then
365 call neko_error("bc not finalized, error in bc_list%is_empty")
366 end if
367
368 if (this%items(i)%ptr%msk(0) > 0) is_empty = .false.
369
370 end do
371 end function bc_list_is_empty
372
374 pure function bc_list_size(this) result(size)
375 class(bc_list_t), intent(in), target :: this
376 integer :: size
377
378 size = this%size_
379 end function bc_list_size
380
381end module bc_list
Return the device pointer for an associated Fortran array.
Definition device.F90:96
Defines a list of bc_t.
Definition bc_list.f90:34
pure logical function bc_list_strong(this, i)
Return whether the bc is strong or not.
Definition bc_list.f90:348
subroutine bc_list_apply_vector_array(this, x, y, z, n, time, strong, strm)
Apply a list of boundary conditions to a vector field.
Definition bc_list.f90:209
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.
Definition bc_list.f90:277
class(bc_t) function, pointer bc_list_get(this, i)
Get the item at the given index.
Definition bc_list.f90:156
subroutine bc_list_apply_scalar_array(this, x, n, time, strong, strm)
Apply a list of boundary conditions to a scalar field.
Definition bc_list.f90:176
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.
Definition bc_list.f90:246
pure integer function bc_list_size(this)
Return the number of items in the list.
Definition bc_list.f90:375
subroutine bc_list_append(this, bc)
Append a condition to the end of the list.
Definition bc_list.f90:136
subroutine bc_list_init(this, capacity)
Constructor.
Definition bc_list.f90:97
subroutine bc_list_apply_vector_field(this, x, y, z, time, strong, strm)
Apply a list of boundary conditions to a vector field.
Definition bc_list.f90:330
subroutine bc_list_free(this)
Destructor.
Definition bc_list.f90:117
subroutine bc_list_apply_scalar_field(this, x, time, strong, strm)
Apply a list of boundary conditions to a scalar field.
Definition bc_list.f90:307
logical function bc_list_is_empty(this)
Return whether the list is empty.
Definition bc_list.f90:357
Defines a boundary condition.
Definition bc.f90:34
Device abstraction, common interface for various accelerators.
Definition device.F90:34
type(c_ptr), bind(C), public glb_cmd_queue
Global command queue.
Definition device.F90:51
Defines a field.
Definition field.f90:34
Build configurations.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Module with things related to the simulation time.
Utilities.
Definition utils.f90:35
Pointer to a `bc_t`.
Definition bc.f90:128
Base type for a boundary condition.
Definition bc.f90:61
A list of allocatable `bc_t`. Follows the standard interface of lists.
Definition bc_list.f90:48
A struct that contains all info about the time, expand as needed.