42 use json_module,
only : json_file, json_core, json_value
55 character(len=80),
allocatable :: names(:)
57 integer :: n_zones = 0
59 integer :: n_external_zones = 0
61 integer :: n_internal_zones = 0
64 character(len=:),
allocatable :: operator
82 type(json_file),
intent(inout) :: json
83 integer,
intent(in) :: size
86 type(json_core) :: core
88 type(json_value),
pointer :: source_object, source_pointer
90 character(len=:),
allocatable :: buffer
92 type(json_file) :: source_subdict
93 character(len=:),
allocatable :: type_name
94 character(len=:),
allocatable :: type_string
96 character(len=:),
allocatable :: str_read
97 integer :: i, n_zones, i_internal, i_external
98 logical :: found, invert
100 call json_get(json,
"name", str_read)
102 call this%init_base(
size, trim(str_read), invert)
104 call json%get_core(core)
105 call json%get(
'subsets', source_object, found)
107 if (.not. found)
call neko_error(
"No subsets found")
109 this%n_zones = core%count(source_object)
112 if (this%n_zones .gt. 0)
then
113 allocate(this%zones(this%n_zones))
118 do i = 1, this%n_zones
120 call core%get_child(source_object, i, source_pointer, found)
121 call core%print_to_string(source_pointer, buffer)
122 call source_subdict%load_from_string(buffer)
124 if (.not. source_subdict%valid_path(
"geometry"))
then
125 this%n_external_zones = this%n_external_zones + 1
129 this%n_internal_zones = this%n_zones - this%n_external_zones
130 if (this%n_external_zones .gt. 0) &
131 allocate(this%names(this%n_external_zones))
132 if (this%n_internal_zones .gt. 0) &
133 allocate(this%internal_zones(this%n_internal_zones))
140 do i = 1, this%n_zones
143 call core%get_child(source_object, i, source_pointer, found)
144 call core%print_to_string(source_pointer, buffer)
145 call source_subdict%load_from_string(buffer)
147 if (source_subdict%valid_path(
"geometry"))
then
148 call point_zone_factory(this%internal_zones(i_internal)%pz, &
151 this%internal_zones(i_internal)%pz)
152 i_internal = i_internal + 1
154 call json_get(source_subdict,
"name", type_name)
155 this%names(i_external) = trim(type_name)
156 i_external = i_external + 1
162 call json_get(json,
"operator", this%operator)
163 select case (trim(this%operator))
168 call neko_error(
"Unknown operator " // trim(this%operator))
187 if (
allocated(this%zones))
then
188 do i = 1, this%n_zones
189 nullify(this%zones(i)%pz)
191 deallocate(this%zones)
194 if (
allocated(this%internal_zones))
then
195 do i = 1, this%n_internal_zones
196 call this%internal_zones(i)%pz%free
198 deallocate(this%internal_zones)
201 if (
allocated(this%names))
deallocate(this%names)
204 this%n_internal_zones = 0
205 this%n_external_zones = 0
206 call this%free_base()
222 real(kind=
rp),
intent(in) :: x
223 real(kind=
rp),
intent(in) :: y
224 real(kind=
rp),
intent(in) :: z
225 integer,
intent(in) :: j
226 integer,
intent(in) :: k
227 integer,
intent(in) :: l
228 integer,
intent(in) :: e
233 is_inside = this%zones(1)%pz%criterion(x, &
234 y, z, j, k, l, e) .neqv. this%zones(1)%pz%invert
236 do i = 2, this%n_zones
237 select case (trim(this%operator))
239 is_inside = is_inside .or. (this%zones(i)%pz%criterion(x, &
240 y, z, j, k, l, e) .neqv. this%zones(i)%pz%invert)
243 is_inside = is_inside .and. (this%zones(i)%pz%criterion(x, &
244 y, z, j, k, l, e) .neqv. this%zones(i)%pz%invert)
247 is_inside = is_inside .neqv. (this%zones(i)%pz%criterion(x, &
248 y, z, j, k, l, e).neqv. this%zones(i)%pz%invert)
Retrieves a parameter by name or assigns a provided default value. In the latter case also adds the m...
Retrieves a parameter by name or throws an error.
subroutine combine_point_zone_free(this)
Destructor.
subroutine assign_point_zone(pt, tgt)
subroutine combine_point_zone_init_from_json(this, json, size)
Constructor from json object file. Reads.
pure logical function combine_point_zone_criterion(this, x, y, z, j, k, l, e)
Defines the criterion of selection of a GLL point in the combined point zone.
Implements a cylinder geometry subset.
Utilities for retrieving parameters from the case files.
type(log_t), public neko_log
Global log stream.
integer, parameter, public rp
Global precision used in computations.
character(:) function, allocatable, public concat_string_array(array, sep, prepend)
Concatenate an array of strings into one string with array items separated by spaces.
A point zone that combines different point zones.
A cylindrical point zone.
A helper type to build a list of pointers to point_zones.
Base abstract type for point zones.
A helper type to build a list of polymorphic point_zones.
A sphere-shaped point zone.