Neko  0.9.0
A portable framework for high-order spectral element flow simulations
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 field, only : field_t
37  use dofmap, only : dofmap_t
38  use utils, only : neko_error
39  use htable, only : h_cptr_t
40  use utils, only: neko_error
41  implicit none
42  private
43 
46  type(field_t), private, allocatable :: fields(:)
48  integer, private :: n
50  integer, private :: expansion_size
51  contains
52  procedure, private, pass(this) :: expand
54  procedure, pass(this) :: init => field_registry_init
56  procedure, pass(this) :: free => field_registry_free
58  procedure, pass(this) :: add_field
60  procedure, pass(this) :: n_fields
62  procedure, pass(this) :: get_field_by_index
64  procedure, pass(this) :: get_field_by_name
66  procedure, pass(this) :: get_expansion_size
68  procedure, pass(this) :: get_size
70  procedure, pass(this) :: field_exists
71  generic :: get_field => get_field_by_index, get_field_by_name
72  end type field_registry_t
73 
75  type(field_registry_t), public, target :: neko_field_registry
76 
77 contains
81  subroutine field_registry_init(this, size, expansion_size)
82  class(field_registry_t), intent(inout):: this
83  integer, optional, intent(in) :: size
84  integer, optional, intent(in) :: expansion_size
85 
86  call this%free()
87 
88  if (present(size)) then
89  allocate (this%fields(size))
90  else
91  allocate (this%fields(50))
92  end if
93 
94  if (present(expansion_size)) then
95  this%expansion_size = expansion_size
96  else
97  this%expansion_size = 50
98  end if
99 
100  this%n = 0
101  end subroutine field_registry_init
102 
104  subroutine field_registry_free(this)
105  class(field_registry_t), intent(inout):: this
106  integer :: i
107  if (allocated(this%fields)) then
108  do i=1, this%n_fields()
109  call this%fields(i)%free()
110  end do
111  deallocate(this%fields)
112  end if
113  this%n = 0
114  this%expansion_size = 0
115  end subroutine field_registry_free
116 
118  subroutine expand(this)
119  class(field_registry_t), intent(inout) :: this
120  type(field_t), allocatable :: temp(:)
121 
122  allocate(temp(this%n + this%expansion_size))
123  temp(1:this%n) = this%fields(1:this%n)
124  call move_alloc(temp, this%fields)
125 
126 
127  end subroutine expand
128 
134  subroutine add_field(this, dof, fld_name, ignore_existing)
135  class(field_registry_t), intent(inout) :: this
136  type(dofmap_t), target, intent(in) :: dof
137  character(len=*), target, intent(in) :: fld_name
138  logical, optional, intent(in) :: ignore_existing
139 
140  if (this%field_exists(fld_name)) then
141  if (present(ignore_existing) .and. ignore_existing .eqv. .true.) then
142  return
143  else
144  call neko_error("Field with name " // fld_name // &
145  " is already registered")
146  end if
147  end if
148 
149  if (this%n_fields() == size(this%fields)) then
150  call this%expand()
151  end if
152 
153  this%n = this%n + 1
154 
155  ! initialize the field at the appropraite index
156  call this%fields(this%n)%init( dof, fld_name)
157 
158  ! generate a key for the name lookup map and assign it to the index
159  ! key%ptr = c_loc(fld_name)
160  ! call this%name_index_map%set(key, this%n)
161 
162  ! write(*,*) "HTABLE DATA, ", this%name_index_map%get(key, i)
163  end subroutine add_field
164 
166  pure function n_fields(this) result(n)
167  class(field_registry_t), intent(in) :: this
168  integer :: n
169 
170  n = this%n
171  end function n_fields
172 
174  pure function get_size(this) result(n)
175  class(field_registry_t), intent(in) :: this
176  integer :: n
177 
178  n = size(this%fields)
179  end function get_size
180 
182  pure function get_expansion_size(this) result(n)
183  class(field_registry_t), intent(in) :: this
184  integer :: n
185 
186  n = this%expansion_size
187  end function get_expansion_size
188 
190  function get_field_by_index(this, i) result(f)
191  class(field_registry_t), target, intent(in) :: this
192  integer, intent(in) :: i
193  type(field_t), pointer :: f
194 
195  if (i < 1) then
196  call neko_error("Field index must be > 1")
197  else if (i > this%n_fields()) then
198  call neko_error("Field index exceeds number of stored fields")
199  endif
200 
201  f => this%fields(i)
202  end function get_field_by_index
203 
205  function get_field_by_name(this, name) result(f)
206  class(field_registry_t), target, intent(in) :: this
207  character(len=*), intent(in) ::name
208  type(field_t), pointer :: f
209  logical :: found
210  integer :: i
211 
212  found = .false.
213 
214  do i=1, this%n_fields()
215  if (this%fields(i)%name == name) then
216  f => this%fields(i)
217  found = .true.
218  exit
219  end if
220  end do
221 
222  if (.not. found) then
223  call neko_error("Field " // name // &
224  " could not be found in the registry")
225  end if
226  end function get_field_by_name
227 
229  function field_exists(this, name) result(found)
230  class(field_registry_t), target, intent(in) :: this
231  character(len=*), intent(in) ::name
232  logical :: found
233  integer :: i
234 
235  found = .false.
236  do i=1, this%n_fields()
237  if (this%fields(i)%name == name) then
238  found = .true.
239  exit
240  end if
241  end do
242  end function field_exists
243 
244 
245 
246 end module field_registry
Defines a mapping of the degrees of freedom.
Definition: dofmap.f90:35
Defines a registry for storing solution fields.
subroutine field_registry_free(this)
Destructor.
subroutine expand(this)
Expand the fields array so as to accomodate more fields.
pure integer function get_expansion_size(this)
Get the expansion size.
type(field_registry_t), target, public neko_field_registry
Global field registry.
pure integer function get_size(this)
Get the size of the fields array.
pure integer function n_fields(this)
Get the number of fields stored in the registry.
logical function field_exists(this, name)
Check if a field with a given name is already in the registry.
type(field_t) function, pointer get_field_by_index(this, i)
Get pointer to a stored field by index.
subroutine field_registry_init(this, size, expansion_size)
Constructor.
type(field_t) function, pointer get_field_by_name(this, name)
Get pointer to a stored field by field name.
subroutine add_field(this, dof, fld_name, ignore_existing)
Add a field to the registry.
Defines a field.
Definition: field.f90:34
Implements a hash table ADT.
Definition: htable.f90:36
Utilities.
Definition: utils.f90:35