Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
scratch_registry.f90
Go to the documentation of this file.
1! Copyright (c) 2018-2023, 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!
38 use field, only : field_t, field_ptr_t
39 use field_math, only : field_rzero
40 use dofmap, only : dofmap_t
41 implicit none
42 private
43
44
45 type, public :: scratch_registry_t
47 type(field_ptr_t), private, allocatable :: fields(:)
49 logical, private, allocatable :: inuse(:)
51 integer, private :: nfields
53 integer, private :: nfields_inuse
55 integer, private :: expansion_size
57 type(dofmap_t), pointer :: dof => null()
58 contains
59 procedure, private, pass(this) :: expand
61 procedure, pass(this) :: init => scratch_registry_init
63 procedure, pass(this) :: free => scratch_registry_free
65 procedure, pass(this) :: get_nfields
67 procedure, pass(this) :: get_nfields_inuse
69 procedure, pass(this) :: get_expansion_size
71 procedure, pass(this) :: get_size
73 procedure, pass(this) :: get_inuse
75 procedure, pass(this) :: request_field
76 procedure, pass(this) :: relinquish_field_single
77 procedure, pass(this) :: relinquish_field_multiple
79 generic :: relinquish_field => relinquish_field_single, &
81 end type scratch_registry_t
82
85
86contains
87
90 subroutine scratch_registry_init(this, dof, size, expansion_size)
91 class(scratch_registry_t), intent(inout) :: this
92 type(dofmap_t), target, intent(in) :: dof
93 integer, optional, intent(in) :: size
94 integer, optional, intent(in) :: expansion_size
95 integer :: i
96
97 call this%free()
98
99 this%dof => dof
100
101 if (present(size)) then
102 allocate (this%fields(size))
103 do i= 1, size
104 allocate(this%fields(i)%ptr)
105 end do
106 allocate (this%inuse(size))
107 else
108 allocate (this%fields(10))
109 allocate (this%inuse(10))
110 end if
111
112 this%inuse(:) = .false.
113 if (present(expansion_size)) then
114 this%expansion_size = expansion_size
115 else
116 this%expansion_size = 10
117 end if
118
119 this%nfields = 0
120 this%nfields_inuse = 0
121 end subroutine scratch_registry_init
122
124 subroutine scratch_registry_free(this)
125 class(scratch_registry_t), intent(inout):: this
126 integer :: i
127
128 if (allocated(this%fields)) then
129 do i=1, this%nfields
130 call this%fields(i)%ptr%free()
131 deallocate(this%fields(i)%ptr)
132 end do
133
134 deallocate(this%fields)
135 deallocate(this%inuse)
136 end if
137
138 if (associated(this%dof)) then
139 nullify(this%dof)
140 end if
141
142 end subroutine scratch_registry_free
143
144
146 pure function get_nfields(this) result(n)
147 class(scratch_registry_t), intent(in) :: this
148 integer :: n
149
150 n = this%nfields
151 end function get_nfields
152
153 pure function get_nfields_inuse(this) result(n)
154 class(scratch_registry_t), intent(in) :: this
155 integer :: n, i
156
157 n = 0
158 do i=1,this%get_size()
159 if (this%inuse(i)) n = n + 1
160 end do
161 end function get_nfields_inuse
162
164 pure function get_size(this) result(n)
165 class(scratch_registry_t), intent(in) :: this
166 integer :: n
167
168 n = size(this%fields)
169 end function get_size
170
172 pure function get_expansion_size(this) result(n)
173 class(scratch_registry_t), intent(in) :: this
174 integer :: n
175
176 n = this%expansion_size
177 end function get_expansion_size
178
179 subroutine expand(this)
180 class(scratch_registry_t), intent(inout) :: this
181 type(field_ptr_t), allocatable :: temp(:)
182 logical, allocatable :: temp2(:)
183 integer :: i
184
185 allocate(temp(this%get_size() + this%expansion_size))
186 temp(1:this%nfields) = this%fields(1:this%nfields)
187
188 do i=this%nfields +1, size(temp)
189 allocate(temp(i)%ptr)
190 enddo
191
192 call move_alloc(temp, this%fields)
193
194 allocate(temp2(this%get_size() + this%expansion_size))
195 temp2(1:this%nfields) = this%inuse(1:this%nfields)
196 temp2(this%nfields+1:) = .false.
197 this%inuse = temp2
198 end subroutine expand
199
200
202 subroutine request_field(this, f, index)
203 class(scratch_registry_t), target, intent(inout) :: this
204 type(field_t), pointer, intent(inout) :: f
205 integer, intent(inout) :: index
206 character(len=10) :: name
207
208
209 associate(nfields => this%nfields, nfields_inuse => this%nfields_inuse)
210
211 do index = 1, this%get_size()
212 if (this%inuse(index) .eqv. .false.) then
213 write(name, "(A3,I0.3)") "wrk", index
214
215 if (.not. allocated(this%fields(index)%ptr%x)) then
216 call this%fields(index)%ptr%init(this%dof, trim(name))
217 nfields = nfields + 1
218 end if
219 f => this%fields(index)%ptr
220 call field_rzero(f)
221 this%inuse(index) = .true.
222 this%nfields_inuse = this%nfields_inuse + 1
223 return
224 end if
225 end do
226 ! all existing fields in use, we need to expand to add a new one
227 index = nfields +1
228 call this%expand()
229 nfields = nfields + 1
230 nfields_inuse = nfields_inuse + 1
231 this%inuse(nfields) = .true.
232 write (name, "(A3,I0.3)") "wrk", index
233 call this%fields(nfields)%ptr%init(this%dof, trim(name))
234 f => this%fields(nfields)%ptr
235
236 end associate
237 end subroutine request_field
238
240 subroutine relinquish_field_single(this, index)
241 class(scratch_registry_t), target, intent(inout) :: this
242 integer, intent(inout) :: index
243
244 this%inuse(index) = .false.
245 this%nfields_inuse = this%nfields_inuse - 1
246 end subroutine relinquish_field_single
247
248 subroutine relinquish_field_multiple(this, indices)
249 class(scratch_registry_t), target, intent(inout) :: this
250 integer, intent(inout) :: indices(:)
251 integer :: i
252
253 do i=1, size(indices)
254 this%inuse(indices(i)) = .false.
255 end do
256 this%nfields_inuse = this%nfields_inuse - size(indices)
257 end subroutine relinquish_field_multiple
258
259 logical function get_inuse(this, index)
260 class(scratch_registry_t), target, intent(inout) :: this
261 integer, intent(inout) :: index
262
263 get_inuse = this%inuse(index)
264 end function get_inuse
265
266end module scratch_registry
Defines a mapping of the degrees of freedom.
Definition dofmap.f90:35
subroutine, public field_rzero(a, n)
Zero a real vector.
Defines a field.
Definition field.f90:34
Defines a registry for storing and requesting temporary fields This can be used when you have a funct...
logical function get_inuse(this, index)
pure integer function get_nfields_inuse(this)
subroutine scratch_registry_free(this)
Destructor.
subroutine scratch_registry_init(this, dof, size, expansion_size)
Constructor, optionally taking initial registry and expansion size as argument.
subroutine relinquish_field_single(this, index)
Relinquish the use of a field in the registry.
pure integer function get_size(this)
Get the size of the fields array.
subroutine relinquish_field_multiple(this, indices)
type(scratch_registry_t), target, public neko_scratch_registry
Global scratch registry.
subroutine request_field(this, f, index)
Get a field from the registry by assigning it to a pointer.
subroutine expand(this)
pure integer function get_nfields(this)
Get the number of fields stored in the registry.
pure integer function get_expansion_size(this)
Get the expansion size.
field_ptr_t, To easily obtain a pointer to a field
Definition field.f90:81