Neko 1.99.1
A portable framework for high-order spectral element flow simulations
Loading...
Searching...
No Matches
json_utils.f90
Go to the documentation of this file.
1! Copyright (c) 2019-2024, 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!
35 use num_types, only : rp, dp, sp
36 use json_module, only : json_file, json_value, json_core
37 use utils, only : neko_error
38 implicit none
39 private
40
43
45 logical :: json_no_defaults = .false.
46
53 end interface json_get
54
61 end interface json_get_or_default
62
65 end interface json_extract_item
66contains
67
72 subroutine json_get_real(json, name, value)
73 type(json_file), intent(inout) :: json
74 character(len=*), intent(in) :: name
75 real(kind=sp), intent(out) :: value
76
77 if (.not. json%valid_path(name)) then
78 call neko_error("Parameter " // name // " missing from the case file")
79 end if
80
81 call json%get(name, value)
82 end subroutine json_get_real
83
88 subroutine json_get_double(json, name, value)
89 type(json_file), intent(inout) :: json
90 character(len=*), intent(in) :: name
91 real(kind=dp), intent(out) :: value
92
93 if (.not. json%valid_path(name)) then
94 call neko_error("Parameter " // name // " missing from the case file")
95 end if
96
97 call json%get(name, value)
98 end subroutine json_get_double
99
104 subroutine json_get_integer(json, name, value)
105 type(json_file), intent(inout) :: json
106 character(len=*), intent(in) :: name
107 integer, intent(out) :: value
108
109 if (.not. json%valid_path(name)) then
110 call neko_error("Parameter " // name // " missing from the case file")
111 end if
112
113 call json%get(name, value)
114 end subroutine json_get_integer
115
120 subroutine json_get_logical(json, name, value)
121 type(json_file), intent(inout) :: json
122 character(len=*), intent(in) :: name
123 logical, intent(out) :: value
124
125 if (.not. json%valid_path(name)) then
126 call neko_error("Parameter " // name // " missing from the case file")
127 end if
128
129 call json%get(name, value)
130 end subroutine json_get_logical
131
136 subroutine json_get_string(json, name, value)
137 type(json_file), intent(inout) :: json
138 character(len=*), intent(in) :: name
139 character(len=:), allocatable, intent(out) :: value
140
141 if (.not. json%valid_path(name)) then
142 call neko_error("Parameter " // name // " missing from the case file")
143 end if
144
145 call json%get(name, value)
146 end subroutine json_get_string
147
152 subroutine json_get_real_array(json, name, value)
153 type(json_file), intent(inout) :: json
154 character(len=*), intent(in) :: name
155 real(kind=sp), allocatable, intent(out) :: value(:)
156
157 if (.not. json%valid_path(name)) then
158 call neko_error("Parameter " // name // " missing from the case file")
159 end if
160
161 call json%get(name, value)
162 end subroutine json_get_real_array
163
168 subroutine json_get_double_array(json, name, value)
169 type(json_file), intent(inout) :: json
170 character(len=*), intent(in) :: name
171 real(kind=dp), allocatable, intent(out) :: value(:)
172
173 if (.not. json%valid_path(name)) then
174 call neko_error("Parameter " // name // " missing from the case file")
175 end if
176
177 call json%get(name, value)
178 end subroutine json_get_double_array
179
184 subroutine json_get_integer_array(json, name, value)
185 type(json_file), intent(inout) :: json
186 character(len=*), intent(in) :: name
187 integer, allocatable, intent(out) :: value(:)
188
189 if (.not. json%valid_path(name)) then
190 call neko_error("Parameter " // name // " missing from the case file")
191 end if
192
193 call json%get(name, value)
194 end subroutine json_get_integer_array
195
200 subroutine json_get_logical_array(json, name, value)
201 type(json_file), intent(inout) :: json
202 character(len=*), intent(in) :: name
203 logical, allocatable, intent(out) :: value(:)
204
205 if (.not. json%valid_path(name)) then
206 call neko_error("Parameter " // name // " missing from the case file")
207 end if
208
209 call json%get(name, value)
210 end subroutine json_get_logical_array
211
217 subroutine json_get_string_array(json, name, value, filler)
218 type(json_file), intent(inout) :: json
219 character(len=*), intent(in) :: name
220 character(len=*), allocatable, intent(out) :: value(:)
221 character(len=*), optional, intent(in) :: filler
222 logical :: found
223 type(json_value), pointer :: json_val, val_ptr
224 type(json_core) :: core
225 character(len=:), allocatable :: string_value
226 integer :: i, n_children
227
228 if (.not. json%valid_path(name)) then
229 call neko_error("Parameter " // name // " missing from the case file")
230 end if
231 call json%info(name, n_children = n_children)
232
233 if (.not. allocated(value)) then
234 allocate(value(n_children))
235 else if (len(value) .lt. n_children) then
236 deallocate(value)
237 allocate(value(n_children))
238 end if
239
240 call json%get(name, json_val, found)
241 call json%get_core(core)
242
243 do i = 1, n_children
244 call core%get_child(json_val, i, val_ptr, found)
245 call core%get(val_ptr, string_value)
246
247 if (len(string_value) .gt. 0) then
248 value(i) = string_value
249 else if (present(filler)) then
250 value(i) = filler
251 end if
252 end do
253
254 end subroutine json_get_string_array
255
257 subroutine json_get_subdict(json, key, output)
258 type(json_file), intent(inout) :: json
259 character(len=*), intent(in) :: key
260 type(json_file), intent(out) :: output
261
262 type(json_value), pointer :: child
263 logical :: valid
264
265 valid = .false.
266 call json%get(key, child, valid)
267 if (.not. valid) then
268 call neko_error('Parameter "' // &
269 trim(key) // '" missing from the case file')
270 end if
271
272 call output%initialize()
273 call output%add(child)
274 nullify(child)
275
276 end subroutine json_get_subdict
277
283 subroutine json_get_or_default_real(json, name, value, default)
284 type(json_file), intent(inout) :: json
285 character(len=*), intent(in) :: name
286 real(kind=sp), intent(out) :: value
287 real(kind=sp), intent(in) :: default
288 logical :: found
289
290 call json%get(name, value, found)
291
292 if ((.not. found) .and. (json_no_defaults .eqv. .false.)) then
293 value = default
294 call json%add(name, value)
295 else if (.not. found) then
296 call neko_error("Parameter " // name // " missing from the case file")
297 end if
298 end subroutine json_get_or_default_real
299
305 subroutine json_get_or_default_double(json, name, value, default)
306 type(json_file), intent(inout) :: json
307 character(len=*), intent(in) :: name
308 real(kind=dp), intent(out) :: value
309 real(kind=dp), intent(in) :: default
310 logical :: found
311
312 call json%get(name, value, found)
313
314 if ((.not. found) .and. (json_no_defaults .eqv. .false.)) then
315 value = default
316 call json%add(name, value)
317 else if (.not. found) then
318 call neko_error("Parameter " // name // " missing from the case file")
319 end if
320 end subroutine json_get_or_default_double
321
327 subroutine json_get_or_default_integer(json, name, value, default)
328 type(json_file), intent(inout) :: json
329 character(len=*), intent(in) :: name
330 integer, intent(out) :: value
331 integer, intent(in) :: default
332 logical :: found
333
334 call json%get(name, value, found)
335
336 if ((.not. found) .and. (json_no_defaults .eqv. .false.)) then
337 value = default
338 call json%add(name, value)
339 else if (.not. found) then
340 call neko_error("Parameter " // name // " missing from the case file")
341 end if
342 end subroutine json_get_or_default_integer
343
349 subroutine json_get_or_default_logical(json, name, value, default)
350 type(json_file), intent(inout) :: json
351 character(len=*), intent(in) :: name
352 logical, intent(out) :: value
353 logical, intent(in) :: default
354 logical :: found
355
356 call json%get(name, value, found)
357
358 if ((.not. found) .and. (json_no_defaults .eqv. .false.)) then
359 value = default
360 call json%add(name, value)
361 else if (.not. found) then
362 call neko_error("Parameter " // name // " missing from the case file")
363 end if
364 end subroutine json_get_or_default_logical
365
371 subroutine json_get_or_default_string(json, name, value, default)
372 type(json_file), intent(inout) :: json
373 character(len=*), intent(in) :: name
374 character(len=:), allocatable, intent(out) :: value
375 character(len=*), intent(in) :: default
376 logical :: found
377
378 call json%get(name, value, found)
379
380 if ((.not. found) .and. (json_no_defaults .eqv. .false.)) then
381 value = default
382 call json%add(name, value)
383 else if (.not. found) then
384 call neko_error("Parameter " // name // " missing from the case file")
385 end if
386 end subroutine json_get_or_default_string
387
393 subroutine json_extract_item_from_array(core, array, i, item)
394 type(json_core), intent(inout) :: core
395 type(json_value), pointer, intent(in) :: array
396 integer, intent(in) :: i
397 type(json_file), intent(inout) :: item
398 type(json_value), pointer :: ptr
399 logical :: found
400 character(len=:), allocatable :: buffer
401
402 call core%get_child(array, i, ptr, found)
403 call core%print_to_string(ptr, buffer)
404 call item%load_from_string(buffer)
405
406 end subroutine json_extract_item_from_array
407
413 subroutine json_extract_item_from_name(json, name, i, item)
414 type(json_file), intent(inout) :: json
415 character(len=*), intent(in) :: name
416 integer, intent(in) :: i
417 type(json_file), intent(out) :: item
418
419 type(json_core) :: core
420 type(json_value), pointer :: array
421 type(json_value), pointer :: ptr
422 logical :: found
423 character(len=:), allocatable :: buffer
424
425 call json%get_core(core)
426 call json%get(name, array, found)
427
428 if (.not. found) then
429 call neko_error("Parameter " // name // " missing from the case file")
430 end if
431
432 call core%get_child(array, i, ptr, found)
433 call core%print_to_string(ptr, buffer)
434 call item%load_from_string(buffer)
435
436 end subroutine json_extract_item_from_name
437
442 subroutine json_extract_object(json, name, object)
443 type(json_file), intent(inout) :: json
444 character(len=*), intent(in) :: name
445 type(json_file), intent(inout) :: object
446
447 type(json_value), pointer :: ptr
448 type(json_core) :: core
449 logical :: found
450 character(len=:), allocatable :: buffer
451
452 call json%get_core(core)
453 call json%get(name, ptr, found)
454
455 if (.not. found) then
456 call neko_error("Object " // name // " missing from the case file")
457 end if
458
459 call core%print_to_string(ptr, buffer)
460 call object%load_from_string(buffer)
461
462 end subroutine json_extract_object
463
464end module json_utils
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.
Generic buffer that is extended with buffers of varying rank.
Definition buffer.F90:34
Utilities for retrieving parameters from the case files.
subroutine json_extract_item_from_name(json, name, i, item)
Extract ith item from a JSON array as a separate JSON object.
subroutine json_get_logical(json, name, value)
Retrieves a logical parameter by name or throws an error.
subroutine json_get_or_default_string(json, name, value, default)
Retrieves a string parameter by name or assigns a provided default value. In the latter case also add...
subroutine json_get_real_array(json, name, value)
Retrieves a real array parameter by name or throws an error.
subroutine, public json_extract_object(json, name, object)
Extract object as a separate JSON dictionary.
subroutine json_get_subdict(json, key, output)
Extract a sub-object from a json object.
subroutine json_extract_item_from_array(core, array, i, item)
Extract ith item from a JSON array as a separate JSON object.
subroutine json_get_string(json, name, value)
Retrieves a string parameter by name or throws an error.
subroutine json_get_or_default_real(json, name, value, default)
Retrieves a real parameter by name or assigns a provided default value. In the latter case also adds ...
subroutine json_get_or_default_double(json, name, value, default)
Retrieves a real parameter by name or assigns a provided default value. In the latter case also adds ...
subroutine json_get_or_default_logical(json, name, value, default)
Retrieves a logical parameter by name or assigns a provided default value. In the latter case also ad...
subroutine json_get_double_array(json, name, value)
Retrieves a real array parameter by name or throws an error.
subroutine json_get_or_default_integer(json, name, value, default)
Retrieves an integer parameter by name or assigns a provided default value. In the latter case also a...
subroutine json_get_double(json, name, value)
Retrieves a double precision real parameter by name or throws an error.
subroutine json_get_string_array(json, name, value, filler)
Retrieves a string array parameter by name or throws an error.
subroutine json_get_logical_array(json, name, value)
Retrieves a logical array parameter by name or throws an error.
subroutine json_get_real(json, name, value)
Retrieves a real parameter by name or throws an error.
logical, public json_no_defaults
If true, the json_get_or_default routines will not add missing parameters.
subroutine json_get_integer(json, name, value)
Retrieves an integer parameter by name or throws an error.
subroutine json_get_integer_array(json, name, value)
Retrieves a integer array parameter by name or throws an error.
integer, parameter, public dp
Definition num_types.f90:9
integer, parameter, public sp
Definition num_types.f90:8
integer, parameter, public rp
Global precision used in computations.
Definition num_types.f90:12
Defines an output.
Definition output.f90:34
Utilities.
Definition utils.f90:35