Neko 0.9.99
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, 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
35 use neko_config
36 use num_types, only : rp
37 use device
38 use utils, only : neko_error
39 use, intrinsic :: iso_c_binding, only : c_ptr
40 use bc, only : bc_t, bc_ptr_t
41 implicit none
42 private
43
46 type, public :: bc_list_t
47 ! The items of the list.
48 class(bc_ptr_t), allocatable :: items(:)
50 integer :: size
53 integer :: capacity
54 contains
56 procedure, pass(this) :: init => bc_list_init
58 procedure, pass(this) :: free => bc_list_free
60 procedure, pass(this) :: append => bc_list_append
62 generic :: apply => apply_scalar, apply_vector
64 procedure, pass(this) :: apply_scalar => bc_list_apply_scalar
66 procedure, pass(this) :: apply_vector => bc_list_apply_vector
68 procedure, pass(this) :: is_empty => bc_list_is_empty
69 end type bc_list_t
70
71contains
72
75 subroutine bc_list_init(this, size)
76 class(bc_list_t), intent(inout), target :: this
77 integer, optional :: size
78 integer :: n
79
80 call this%free()
81
82 if (present(size)) then
83 n = size
84 else
85 n = 1
86 end if
87
88 allocate(this%items(n))
89
90 this%size = 0
91 this%capacity = n
92
93 end subroutine bc_list_init
94
98 subroutine bc_list_free(this)
99 class(bc_list_t), intent(inout) :: this
100 integer :: i
101
102 if (allocated(this%items)) then
103 do i =1, this%size
104 this%items(i)%ptr => null()
105 end do
106
107 deallocate(this%items)
108 end if
109
110 this%size = 0
111 this%capacity = 0
112 end subroutine bc_list_free
113
116 subroutine bc_list_append(this, bc)
117 class(bc_list_t), intent(inout) :: this
118 class(bc_t), intent(inout), target :: bc
119 type(bc_ptr_t), allocatable :: tmp(:)
120
122 if(bc%marked_facet%size() .eq. 0) return
123
124 if (this%size .ge. this%capacity) then
125 this%capacity = this%capacity * 2
126 allocate(tmp(this%capacity))
127 tmp(1:this%size) = this%items
128 call move_alloc(tmp, this%items)
129 end if
130
131 this%size = this%size + 1
132 this%items(this%size)%ptr => bc
133
134 end subroutine bc_list_append
135
141 subroutine bc_list_apply_scalar(this, x, n, t, tstep)
142 class(bc_list_t), intent(inout) :: this
143 integer, intent(in) :: n
144 real(kind=rp), intent(inout), dimension(n) :: x
145 real(kind=rp), intent(in), optional :: t
146 integer, intent(in), optional :: tstep
147 type(c_ptr) :: x_d
148 integer :: i
149
150 if (neko_bcknd_device .eq. 1) then
151 x_d = device_get_ptr(x)
152 do i = 1, this%size
153 call this%items(i)%ptr%apply_scalar_dev(x_d, t, tstep)
154 end do
155 else
156 do i = 1, this%size
157 call this%items(i)%ptr%apply_scalar(x, n, t, tstep)
158 end do
159 end if
160 end subroutine bc_list_apply_scalar
161
169 subroutine bc_list_apply_vector(this, x, y, z, n, t, tstep)
170 class(bc_list_t), intent(inout) :: this
171 integer, intent(in) :: n
172 real(kind=rp), intent(inout), dimension(n) :: x
173 real(kind=rp), intent(inout), dimension(n) :: y
174 real(kind=rp), intent(inout), dimension(n) :: z
175 real(kind=rp), intent(in), optional :: t
176 integer, intent(in), optional :: tstep
177 type(c_ptr) :: x_d
178 type(c_ptr) :: y_d
179 type(c_ptr) :: z_d
180 integer :: i
181
182 if (neko_bcknd_device .eq. 1) then
183 x_d = device_get_ptr(x)
184 y_d = device_get_ptr(y)
185 z_d = device_get_ptr(z)
186 do i = 1, this%size
187 call this%items(i)%ptr%apply_vector_dev(x_d, y_d, z_d, t, tstep)
188 end do
189 else
190 do i = 1, this%size
191 call this%items(i)%ptr%apply_vector(x, y, z, n, t, tstep)
192 end do
193 end if
194
195 end subroutine bc_list_apply_vector
196
198 function bc_list_is_empty(this) result(is_empty)
199 class(bc_list_t), intent(in), target :: this
200 logical :: is_empty
201 integer :: i
202
203 is_empty = .true.
204 do i = 1, this%size
205
206 if (.not. allocated(this%items(i)%ptr%msk)) then
207 call neko_error("bc not finalized, error in bc_list%is_empty")
208 end if
209
210 if (this%items(i)%ptr%msk(0) > 0) is_empty = .false.
211
212 end do
213 end function bc_list_is_empty
214
215end module bc_list
Return the device pointer for an associated Fortran array.
Definition device.F90:81
Defines a list of bc_t.
Definition bc_list.f90:34
subroutine bc_list_apply_vector(this, x, y, z, n, t, tstep)
Apply a list of boundary conditions to a vector field.
Definition bc_list.f90:170
subroutine bc_list_init(this, size)
Constructor.
Definition bc_list.f90:76
subroutine bc_list_append(this, bc)
Append a condition to the end of the list.
Definition bc_list.f90:117
subroutine bc_list_free(this)
Destructor.
Definition bc_list.f90:99
logical function bc_list_is_empty(this)
Return whether the list is empty.
Definition bc_list.f90:199
subroutine bc_list_apply_scalar(this, x, n, t, tstep)
Apply a list of boundary conditions to a scalar field.
Definition bc_list.f90:142
Defines a boundary condition.
Definition bc.f90:34
Device abstraction, common interface for various accelerators.
Definition device.F90:34
Build configurations.
integer, parameter neko_bcknd_device
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Utilities.
Definition utils.f90:35
Pointer to boundary condtiion.
Definition bc.f90:99
Base type for a boundary condition.
Definition bc.f90:51
A list of allocatable `bc_t`. Follows the standard interface of lists.
Definition bc_list.f90:46