43 use json_module,
only : json_file, json_core, json_value
51 integer,
private :: n = 0
53 integer,
private :: expansion_size
56 procedure,
private, pass(this) ::
expand
98 type(json_file),
intent(inout) :: json
99 type(
mesh_t),
target,
intent(inout) :: msh
100 integer,
optional,
intent(in) :: expansion_size
103 type(json_core) :: core
105 type(json_value),
pointer :: source_object, source_pointer
107 character(len=:),
allocatable :: buffer
109 type(json_file) :: source_subdict
111 integer :: n_zones, i, izone
112 character(len=:),
allocatable :: type_name
120 call json_get(json,
'case.numerics.polynomial_order', order)
123 if (msh%gdim .eq. 2)
then
124 call xh%init(
gll, order, order)
126 call xh%init(
gll, order, order, order)
128 call dof%init(msh, xh)
132 if (
present(expansion_size))
then
133 this%expansion_size = expansion_size
135 this%expansion_size = 10
143 if (json%valid_path(
'case.point_zones'))
then
145 call json%get_core(core)
146 call json%get(
'case.point_zones', source_object, found)
148 n_zones = core%count(source_object)
151 allocate(this%point_zones(n_zones))
158 call core%get_child(source_object, i, source_pointer, found)
159 call core%print_to_string(source_pointer, buffer)
160 call source_subdict%load_from_string(buffer)
162 call json_get(source_subdict,
"geometry", type_name)
163 if (trim(type_name) .ne.
"combine")
then
164 call point_zone_factory(this%point_zones(izone)%pz, &
174 call core%get_child(source_object, i, source_pointer, found)
175 call core%print_to_string(source_pointer, buffer)
176 call source_subdict%load_from_string(buffer)
178 call json_get(source_subdict,
"geometry", type_name)
179 if (trim(type_name) .eq.
"combine")
then
197 class(
point_zone_t),
allocatable,
target,
intent(inout) :: object
198 type(json_file),
intent(inout) :: json
199 type(
dofmap_t),
intent(inout) :: dof
202 integer :: i, i_external
207 call object%init(json, dof%size())
217 do i = cpz%n_internal_zones + 1, cpz%n_zones
223 call object%finalize()
232 if (
allocated(this%point_zones))
then
234 do i = 1, this%n_point_zones()
235 call this%point_zones(i)%pz%free()
238 deallocate(this%point_zones)
243 this%expansion_size = 0
252 allocate(temp(this%n + this%expansion_size))
253 temp(1:this%n) = this%point_zones(1:this%n)
254 call move_alloc(temp, this%point_zones)
263 type(json_file),
intent(inout) :: json
264 type(
dofmap_t),
target,
intent(inout) :: dof
266 character(len=:),
allocatable :: str_read
273 if (.not.
allocated(this%point_zones))
then
274 allocate(this%point_zones(this%expansion_size))
277 call json_get(json,
"name", str_read)
280 if (this%point_zone_exists(trim(str_read)))
then
281 call neko_error(
"Field with name " // trim(str_read) // &
282 " is already registered")
289 if (this%n_point_zones() .eq. this%get_size())
then
296 call point_zone_factory(this%point_zones(this%n)%pz, json, dof)
321 n =
size(this%point_zones)
330 n = this%expansion_size
338 integer,
intent(in) :: i
343 else if (i > this%n_point_zones())
then
344 call neko_error(
"Field index exceeds number of stored point_zones")
347 pz => this%point_zones(i)%pz
354 character(len=*),
intent(in) :: name
360 do i = 1, this%n_point_zones()
361 if (trim(this%point_zones(i)%pz%name) .eq. trim(name))
then
362 pz => this%point_zones(i)%pz
368 if (.not. found)
then
369 call neko_error(
"Point zone " // trim(name) // &
370 " could not be found in the registry")
378 character(len=*),
intent(in) :: name
383 do i = 1, this%n_point_zones()
384 if (trim(this%point_zones(i)%pz%name) .eq. trim(name))
then
Retrieves a parameter by name or throws an error.
Defines a mapping of the degrees of freedom.
Utilities for retrieving parameters from the case files.
subroutine build_combine_point_zone(object, json, dof)
Constructs a combine_point_zone_t object.
subroutine expand(this)
Expand the point_zones array so as to accomodate more point_zones.
subroutine point_zone_registry_free(this)
Destructor.
pure integer function n_point_zones(this)
Returns the number of point zones in the registry.
subroutine point_zone_registry_init(this, json, msh, expansion_size)
Constructor, reading from json point zones.
logical function point_zone_exists(this, name)
Checks if a point zone exists in the registry.
pure integer function get_size(this)
Returns the total size of the point_zones array (not the number of point zones in the registry!...
type(point_zone_registry_t), target, public neko_point_zone_registry
Global point_zone registry.
subroutine add_point_zone_from_json(this, json, dof)
Adds a point zone object to the registry from a json object.
class(point_zone_t) function, pointer get_point_zone_by_name(this, name)
Retrieves a point zone in the registry by its name.
pure integer function get_expansion_size(this)
Returns the expansion size with which the point_zone_registry_t was initialized.
class(point_zone_t) function, pointer get_point_zone_by_index(this, i)
Retrieves a point zone in the registry by its index in the point_zones array.
Defines a function space.
integer, parameter, public gll
A point zone that combines different point zones.
Base abstract type for point zones.
A helper type to build a list of polymorphic point_zones.
The function space for the SEM solution fields.