Neko  0.9.0
A portable framework for high-order spectral element flow simulations
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 !
34 module json_utils
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  interface json_get
46  module procedure json_get_real, json_get_double, json_get_integer, &
50  end interface json_get
51 
58  end interface json_get_or_default
59 
62  end interface json_extract_item
63 contains
64 
69  subroutine json_get_real(json, name, value)
70  type(json_file), intent(inout) :: json
71  character(len=*), intent(in) :: name
72  real(kind=sp), intent(out) :: value
73 
74  if (.not. json%valid_path(name)) then
75  call neko_error("Parameter " // name // " missing from the case file")
76  end if
77 
78  call json%get(name, value)
79  end subroutine json_get_real
80 
85  subroutine json_get_double(json, name, value)
86  type(json_file), intent(inout) :: json
87  character(len=*), intent(in) :: name
88  real(kind=dp), intent(out) :: value
89 
90  if (.not. json%valid_path(name)) then
91  call neko_error("Parameter " // name // " missing from the case file")
92  end if
93 
94  call json%get(name, value)
95  end subroutine json_get_double
96 
101  subroutine json_get_integer(json, name, value)
102  type(json_file), intent(inout) :: json
103  character(len=*), intent(in) :: name
104  integer, intent(out) :: value
105 
106  if (.not. json%valid_path(name)) then
107  call neko_error("Parameter " // name // " missing from the case file")
108  end if
109 
110  call json%get(name, value)
111  end subroutine json_get_integer
112 
117  subroutine json_get_logical(json, name, value)
118  type(json_file), intent(inout) :: json
119  character(len=*), intent(in) :: name
120  logical, intent(out) :: value
121 
122  if (.not. json%valid_path(name)) then
123  call neko_error("Parameter " // name // " missing from the case file")
124  end if
125 
126  call json%get(name, value)
127  end subroutine json_get_logical
128 
133  subroutine json_get_string(json, name, value)
134  type(json_file), intent(inout) :: json
135  character(len=*), intent(in) :: name
136  character(len=:), allocatable, intent(out) :: value
137 
138  if (.not. json%valid_path(name)) then
139  call neko_error("Parameter " // name // " missing from the case file")
140  end if
141 
142  call json%get(name, value)
143  end subroutine json_get_string
144 
149  subroutine json_get_real_array(json, name, value)
150  type(json_file), intent(inout) :: json
151  character(len=*), intent(in) :: name
152  real(kind=sp), allocatable, intent(out) :: value(:)
153 
154  if (.not. json%valid_path(name)) then
155  call neko_error("Parameter " // name // " missing from the case file")
156  end if
157 
158  call json%get(name, value)
159  end subroutine json_get_real_array
160 
165  subroutine json_get_double_array(json, name, value)
166  type(json_file), intent(inout) :: json
167  character(len=*), intent(in) :: name
168  real(kind=dp), allocatable, intent(out) :: value(:)
169 
170  if (.not. json%valid_path(name)) then
171  call neko_error("Parameter " // name // " missing from the case file")
172  end if
173 
174  call json%get(name, value)
175  end subroutine json_get_double_array
176 
181  subroutine json_get_integer_array(json, name, value)
182  type(json_file), intent(inout) :: json
183  character(len=*), intent(in) :: name
184  integer, allocatable, intent(out) :: value(:)
185 
186  if (.not. json%valid_path(name)) then
187  call neko_error("Parameter " // name // " missing from the case file")
188  end if
189 
190  call json%get(name, value)
191  end subroutine json_get_integer_array
192 
197  subroutine json_get_logical_array(json, name, value)
198  type(json_file), intent(inout) :: json
199  character(len=*), intent(in) :: name
200  logical, allocatable, intent(out) :: value(:)
201 
202  if (.not. json%valid_path(name)) then
203  call neko_error("Parameter " // name // " missing from the case file")
204  end if
205 
206  call json%get(name, value)
207  end subroutine json_get_logical_array
208 
214  subroutine json_get_string_array(json, name, value, filler)
215  type(json_file), intent(inout) :: json
216  character(len=*), intent(in) :: name
217  character(len=*), allocatable, intent(out) :: value(:)
218  character(len=*), optional, intent(in) :: filler
219  logical :: found
220  type(json_value), pointer :: json_val, val_ptr
221  type(json_core) :: core
222  character(len=:), allocatable :: string_value
223  integer :: i, n_children
224 
225  if (.not. json%valid_path(name)) then
226  call neko_error("Parameter " // name // " missing from the case file")
227  end if
228  call json%info(name, n_children = n_children)
229 
230  if (.not. allocated(value)) then
231  allocate(value(n_children))
232  else if (len(value) .lt. n_children) then
233  deallocate(value)
234  allocate(value(n_children))
235  end if
236 
237  call json%get(name, json_val, found)
238  call json%get_core(core)
239 
240  do i = 1, n_children
241  call core%get_child(json_val, i, val_ptr, found)
242  call core%get(val_ptr, string_value)
243 
244  if (len(string_value) .gt. 0) then
245  value(i) = string_value
246  else if (present(filler)) then
247  value(i) = filler
248  end if
249  end do
250 
251  end subroutine json_get_string_array
252 
254  subroutine json_get_subdict(json, key, output)
255  type(json_file), intent(inout) :: json
256  character(len=*), intent(in) :: key
257  type(json_file), intent(out) :: output
258 
259  type(json_value), pointer :: child
260  logical :: valid
261 
262  valid = .false.
263  call json%get(key, child, valid)
264  if (.not. valid) then
265  call neko_error('Parameter "' // &
266  trim(key) // '" missing from the case file')
267  end if
268 
269  call output%initialize()
270  call output%add(child)
271  nullify(child)
272 
273  end subroutine json_get_subdict
274 
280  subroutine json_get_or_default_real(json, name, value, default)
281  type(json_file), intent(inout) :: json
282  character(len=*), intent(in) :: name
283  real(kind=sp), intent(out) :: value
284  real(kind=sp), intent(in) :: default
285  logical :: found
286 
287  call json%get(name, value, found)
288 
289  if (.not. found) then
290  value = default
291  call json%add(name, value)
292  end if
293  end subroutine json_get_or_default_real
294 
300  subroutine json_get_or_default_double(json, name, value, default)
301  type(json_file), intent(inout) :: json
302  character(len=*), intent(in) :: name
303  real(kind=dp), intent(out) :: value
304  real(kind=dp), intent(in) :: default
305  logical :: found
306 
307  call json%get(name, value, found)
308 
309  if (.not. found) then
310  value = default
311  call json%add(name, value)
312  end if
313  end subroutine json_get_or_default_double
314 
320  subroutine json_get_or_default_integer(json, name, value, default)
321  type(json_file), intent(inout) :: json
322  character(len=*), intent(in) :: name
323  integer, intent(out) :: value
324  integer, intent(in) :: default
325  logical :: found
326 
327  call json%get(name, value, found)
328 
329  if (.not. found) then
330  value = default
331  call json%add(name, value)
332  end if
333  end subroutine json_get_or_default_integer
334 
340  subroutine json_get_or_default_logical(json, name, value, default)
341  type(json_file), intent(inout) :: json
342  character(len=*), intent(in) :: name
343  logical, intent(out) :: value
344  logical, intent(in) :: default
345  logical :: found
346 
347  call json%get(name, value, found)
348 
349  if (.not. found) then
350  value = default
351  call json%add(name, value)
352  end if
353  end subroutine json_get_or_default_logical
354 
360  subroutine json_get_or_default_string(json, name, value, default)
361  type(json_file), intent(inout) :: json
362  character(len=*), intent(in) :: name
363  character(len=:), allocatable, intent(out) :: value
364  character(len=*), intent(in) :: default
365  logical :: found
366 
367  call json%get(name, value, found)
368 
369  if (.not. found) then
370  value = default
371  call json%add(name, value)
372  end if
373  end subroutine json_get_or_default_string
374 
380  subroutine json_extract_item_from_array(core, array, i, item)
381  type(json_core), intent(inout) :: core
382  type(json_value), pointer, intent(in) :: array
383  integer, intent(in) :: i
384  type(json_file), intent(inout) :: item
385  type(json_value), pointer :: ptr
386  logical :: found
387  character(len=:), allocatable :: buffer
388 
389  call core%get_child(array, i, ptr, found)
390  call core%print_to_string(ptr, buffer)
391  call item%load_from_string(buffer)
392 
393  end subroutine json_extract_item_from_array
394 
400  subroutine json_extract_item_from_name(json, name, i, item)
401  type(json_file), intent(inout) :: json
402  character(len=*), intent(in) :: name
403  integer, intent(in) :: i
404  type(json_file), intent(out) :: item
405 
406  type(json_core) :: core
407  type(json_value), pointer :: array
408  type(json_value), pointer :: ptr
409  logical :: found
410  character(len=:), allocatable :: buffer
411 
412  call json%get_core(core)
413  call json%get(name, array, found)
414 
415  if (.not. found) then
416  call neko_error("Parameter " // name // " missing from the case file")
417  end if
418 
419  call core%get_child(array, i, ptr, found)
420  call core%print_to_string(ptr, buffer)
421  call item%load_from_string(buffer)
422 
423  end subroutine json_extract_item_from_name
424 
429  subroutine json_extract_object(json, name, object)
430  type(json_file), intent(inout) :: json
431  character(len=*), intent(in) :: name
432  type(json_file), intent(inout) :: object
433 
434  type(json_value), pointer :: ptr
435  type(json_core) :: core
436  logical :: found
437  character(len=:), allocatable :: buffer
438 
439  call json%get_core(core)
440  call json%get(name, ptr, found)
441 
442  if (.not. found) then
443  call neko_error("Object " // name // " missing from the case file")
444  end if
445 
446  call core%print_to_string(ptr, buffer)
447  call object%load_from_string(buffer)
448 
449  end subroutine json_extract_object
450 
451 end module json_utils
Retrieves a parameter by name or assigns a provided default value. In the latter case also adds the m...
Definition: json_utils.f90:54
Retrieves a parameter by name or throws an error.
Definition: json_utils.f90:45
Utilities for retrieving parameters from the case files.
Definition: json_utils.f90:34
subroutine json_extract_item_from_name(json, name, i, item)
Extract ith item from a JSON array as a separate JSON object.
Definition: json_utils.f90:401
subroutine json_get_logical(json, name, value)
Retrieves a logical parameter by name or throws an error.
Definition: json_utils.f90:118
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...
Definition: json_utils.f90:361
subroutine json_get_real_array(json, name, value)
Retrieves a real array parameter by name or throws an error.
Definition: json_utils.f90:150
subroutine, public json_extract_object(json, name, object)
Extract object as a separate JSON dictionary.
Definition: json_utils.f90:430
subroutine json_get_subdict(json, key, output)
Extract a sub-object from a json object.
Definition: json_utils.f90:255
subroutine json_extract_item_from_array(core, array, i, item)
Extract ith item from a JSON array as a separate JSON object.
Definition: json_utils.f90:381
subroutine json_get_string(json, name, value)
Retrieves a string parameter by name or throws an error.
Definition: json_utils.f90:134
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 ...
Definition: json_utils.f90:281
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 ...
Definition: json_utils.f90:301
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...
Definition: json_utils.f90:341
subroutine json_get_double_array(json, name, value)
Retrieves a real array parameter by name or throws an error.
Definition: json_utils.f90:166
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...
Definition: json_utils.f90:321
subroutine json_get_double(json, name, value)
Retrieves a double precision real parameter by name or throws an error.
Definition: json_utils.f90:86
subroutine json_get_string_array(json, name, value, filler)
Retrieves a string array parameter by name or throws an error.
Definition: json_utils.f90:215
subroutine json_get_logical_array(json, name, value)
Retrieves a logical array parameter by name or throws an error.
Definition: json_utils.f90:198
subroutine json_get_real(json, name, value)
Retrieves a real parameter by name or throws an error.
Definition: json_utils.f90:70
subroutine json_get_integer(json, name, value)
Retrieves an integer parameter by name or throws an error.
Definition: json_utils.f90:102
subroutine json_get_integer_array(json, name, value)
Retrieves a integer array parameter by name or throws an error.
Definition: json_utils.f90:182
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