Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
field_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!
34!
36 use, intrinsic :: iso_fortran_env, only: error_unit
37 use field, only : field_t
38 use dofmap, only : dofmap_t
39 use utils, only : neko_error
40 use htable, only : h_cptr_t
41 use utils, only: neko_error
42 use comm, only : pe_rank
43 use json_module, only : json_file
44 use json_utils, only : json_get
45 implicit none
46 private
47
48 type, public :: field_registry_t
50 type(field_t), private, allocatable :: fields(:)
52 type(json_file), private, allocatable :: aliases(:)
54 integer, private :: n_fields_
56 integer, private :: n_aliases_
58 integer, private :: expansion_size
59 contains
61 procedure, private, pass(this) :: expand => field_registry_expand
63 procedure, private, pass(this) :: expand_aliases => &
66 procedure, pass(this) :: init => field_registry_init
68 procedure, pass(this) :: free => field_registry_free
70 procedure, pass(this) :: add_field => field_registry_add_field
72 procedure, pass(this) :: add_alias => field_registry_add_alias
74 procedure, pass(this) :: n_fields => field_registry_n_fields
76 procedure, pass(this) :: n_aliases => field_registry_n_aliases
78 procedure, pass(this) :: get_field_by_index => &
81 procedure, pass(this) :: get_field_by_name => &
84 procedure, pass(this) :: get_expansion_size => &
87 procedure, pass(this) :: get_size => field_registry_get_size
89 procedure, pass(this) :: field_exists => field_registry_field_exists
90 generic :: get_field => get_field_by_index, get_field_by_name
91 end type field_registry_t
92
94 type(field_registry_t), public, target :: neko_field_registry
95
96contains
100 subroutine field_registry_init(this, size, expansion_size)
101 class(field_registry_t), intent(inout):: this
102 integer, optional, intent(in) :: size
103 integer, optional, intent(in) :: expansion_size
104
105 call this%free()
106
107 if (present(size)) then
108 allocate (this%fields(size))
109 allocate (this%aliases(size))
110 else
111 allocate (this%fields(50))
112 allocate (this%aliases(50))
113 end if
114
115 if (present(expansion_size)) then
116 this%expansion_size = expansion_size
117 else
118 this%expansion_size = 50
119 end if
120
121 this%n_fields_ = 0
122 this%n_aliases_ = 0
123 end subroutine field_registry_init
124
126 subroutine field_registry_free(this)
127 class(field_registry_t), intent(inout):: this
128 integer :: i
129 if (allocated(this%fields)) then
130 do i = 1, this%n_fields()
131 call this%fields(i)%free()
132 end do
133 deallocate(this%fields)
134 end if
135
136 if (allocated(this%aliases)) then
137 deallocate(this%aliases)
138 end if
139
140 this%n_fields_ = 0
141 this%n_aliases_ = 0
142 this%expansion_size = 0
143 end subroutine field_registry_free
144
146 subroutine field_registry_expand(this)
147 class(field_registry_t), intent(inout) :: this
148 type(field_t), allocatable :: temp(:)
149
150 allocate(temp(this%n_fields_ + this%expansion_size))
151 temp(1:this%n_fields_) = this%fields(1:this%n_fields_)
152 call move_alloc(temp, this%fields)
153 end subroutine field_registry_expand
154
157 class(field_registry_t), intent(inout) :: this
158 type(json_file), allocatable :: temp(:)
159
160 allocate(temp(this%n_aliases() + this%expansion_size))
161 temp(1:this%n_aliases()) = this%aliases(1:this%n_fields_)
162 call move_alloc(temp, this%aliases)
163 end subroutine field_registry_expand_aliases
164
170 subroutine field_registry_add_field(this, dof, fld_name, ignore_existing)
171 class(field_registry_t), intent(inout) :: this
172 type(dofmap_t), target, intent(in) :: dof
173 character(len=*), target, intent(in) :: fld_name
174 logical, optional, intent(in) :: ignore_existing
175
176 if (this%field_exists(fld_name)) then
177 if (present(ignore_existing) .and. ignore_existing .eqv. .true.) then
178 return
179 else
180 call neko_error("Field with name " // fld_name // &
181 " is already registered")
182 end if
183 end if
184
185 if (this%n_fields() == size(this%fields)) then
186 call this%expand()
187 end if
188
189 this%n_fields_ = this%n_fields_ + 1
190
191 ! initialize the field at the appropraite index
192 call this%fields(this%n_fields_)%init( dof, fld_name)
193
194 end subroutine field_registry_add_field
195
199 subroutine field_registry_add_alias(this, alias, fld_name)
200 class(field_registry_t), intent(inout) :: this
201 character(len=*), target, intent(in) :: alias
202 character(len=*), target, intent(in) :: fld_name
203
204 if (this%field_exists(alias)) then
205 call neko_error("Cannot create alias. Field " // alias // &
206 " already exists in the registry")
207 end if
208
209 if (this%field_exists(fld_name)) then
210 if (this%n_aliases_ == size(this%aliases)) then
211 call this%expand_aliases()
212 end if
213
214 this%n_aliases_ = this%n_aliases_ + 1
215
216 call this%aliases(this%n_aliases_)%initialize()
217 call this%aliases(this%n_aliases_)%add("alias", alias)
218 call this%aliases(this%n_aliases_)%add("target", fld_name)
219 else
220 call neko_error("Cannot create alias. Field " // fld_name // &
221 " could not be found in the registry")
222 end if
223 end subroutine field_registry_add_alias
224
226 pure function field_registry_n_fields(this) result(n)
227 class(field_registry_t), intent(in) :: this
228 integer :: n
229
230 n = this%n_fields_
231 end function field_registry_n_fields
232
234 pure function field_registry_n_aliases(this) result(n)
235 class(field_registry_t), intent(in) :: this
236 integer :: n
237
238 n = this%n_aliases_
239 end function field_registry_n_aliases
240
242 pure function field_registry_get_size(this) result(n)
243 class(field_registry_t), intent(in) :: this
244 integer :: n
245
246 n = size(this%fields)
247 end function field_registry_get_size
248
250 pure function field_registry_get_expansion_size(this) result(n)
251 class(field_registry_t), intent(in) :: this
252 integer :: n
253
254 n = this%expansion_size
256
258 function field_registry_get_field_by_index(this, i) result(f)
259 class(field_registry_t), target, intent(in) :: this
260 integer, intent(in) :: i
261 type(field_t), pointer :: f
262
263 if (i < 1) then
264 call neko_error("Field index must be > 1")
265 else if (i > this%n_fields()) then
266 call neko_error("Field index exceeds number of stored fields")
267 endif
268
269 f => this%fields(i)
271
273 recursive function field_registry_get_field_by_name(this, name) result(f)
274 class(field_registry_t), target, intent(in) :: this
275 character(len=*), intent(in) :: name
276 character(len=:), allocatable :: alias
277 character(len=:), allocatable :: alias_target
278 type(field_t), pointer :: f
279 logical :: found
280 integer :: i
281 type(json_file), pointer :: alias_json ! need this for some reason
282
283 found = .false.
284
285 do i = 1, this%n_fields()
286 if (this%fields(i)%name == trim(name)) then
287 f => this%fields(i)
288 found = .true.
289 exit
290 end if
291 end do
292
293 do i = 1, this%n_aliases()
294 alias_json => this%aliases(i)
295 call json_get(alias_json, "alias", alias)
296 if (alias == trim(name)) then
297 call json_get(alias_json, "target", alias_target)
298 f => this%get_field_by_name(alias_target)
299 found = .true.
300 exit
301 end if
302 end do
303
304 if (.not. found) then
305 if (pe_rank .eq. 0) then
306 write(error_unit,*) "Current field_registry contents:"
307
308 do i=1, this%n_fields()
309 write(error_unit,*) "- ", this%fields(i)%name
310 end do
311 end if
312 call neko_error("Field " // name // &
313 " could not be found in the registry")
314 end if
316
318 function field_registry_field_exists(this, name) result(found)
319 class(field_registry_t), target, intent(in) :: this
320 character(len=*), intent(in) :: name
321 character(len=:), allocatable :: alias
322 logical :: found
323 integer :: i
324 type(json_file), pointer :: alias_json
325
326 found = .false.
327 do i=1, this%n_fields()
328 if (this%fields(i)%name == name) then
329 found = .true.
330 exit
331 end if
332 end do
333
334 do i=1, this%n_aliases()
335 alias_json => this%aliases(i)
336 call json_get(alias_json, "alias", alias)
337 if (alias == name) then
338 found = .true.
339 exit
340 end if
341 end do
342 end function field_registry_field_exists
343
344end module field_registry
Retrieves a parameter by name or throws an error.
Definition comm.F90:1
integer, public pe_rank
MPI rank.
Definition comm.F90:55
Defines a mapping of the degrees of freedom.
Definition dofmap.f90:35
Defines a registry for storing solution fields.
subroutine field_registry_add_field(this, dof, fld_name, ignore_existing)
Add a field to the registry.
pure integer function field_registry_n_aliases(this)
Get the number of aliases stored in the registry.
subroutine field_registry_add_alias(this, alias, fld_name)
Add an alias for an existing field in the registry.
pure integer function field_registry_get_size(this)
Get the size of the fields array.
logical function field_registry_field_exists(this, name)
Check if a field with a given name is already in the registry.
subroutine field_registry_free(this)
Destructor.
pure integer function field_registry_get_expansion_size(this)
Get the expansion size.
type(field_registry_t), target, public neko_field_registry
Global field registry.
type(field_t) function, pointer field_registry_get_field_by_index(this, i)
Get pointer to a stored field by index.
subroutine field_registry_expand(this)
Expand the fields array so as to accomodate more fields.
pure integer function field_registry_n_fields(this)
Get the number of fields stored in the registry.
subroutine field_registry_init(this, size, expansion_size)
Constructor.
subroutine field_registry_expand_aliases(this)
Expand the aliases array so as to accomodate more aliases.
recursive type(field_t) function, pointer field_registry_get_field_by_name(this, name)
Get pointer to a stored field by field name.
Defines a field.
Definition field.f90:34
Implements a hash table ADT.
Definition htable.f90:36
Utilities for retrieving parameters from the case files.
Utilities.
Definition utils.f90:35