JSON/json_module [ Modules ]
NAME
json_module
DESCRIPTION
JSON-FORTRAN: A Fortran 2008 JSON (JavaScript Object Notation) API.
NOTES
-Based on fson by Joseph A. Levin (see License below)
-The original F95 code was split into four files:
fson_path_m.f95, fson_string_m.f95, fson_value_m.f95, fson.f95
-The code has been extensively modified and combined into this
one module (json_module.f90).
-Some Fortran 2003/2008 features are now used
(e.g., allocatable strings, associate, newunit, generic, class,
and abstract interface)
-The headers in this file follow the ROBODoc conventions.
Compile with: robodoc --src ./ --doc ./doc --multidoc --html
--tabsize 4 --ignore_case_when_linking
--syntaxcolors --source_line_numbers --index
HISTORY
Joseph A. Levin : March 2012
Jacob Williams : 2/8/2013 : Extensive modifications to the original code.
SEE ALSO
[1] http://github.com/jacobwilliams/json-fortran [json-fortran development site] [2] http://jacobwilliams.github.io/json-fortran [json-fortran online documentation] [3] http://www.json.org/ [JSON website] [4] http://jsonlint.com/ [JSON validator]
COPYRIGHT
-------------------------------------------------------------------------------------
json-fortran License:
JSON-FORTRAN: A Fortran 2003/2008 JSON API
http://github.com/jacobwilliams/json-fortran
Copyright (c) 2014, Jacob Williams
All rights reserved.
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice, this
list of conditions and the following disclaimer in the documentation and/or
other materials provided with the distribution.
* The names of its contributors may not be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-------------------------------------------------------------------------------------
Original FSON License:
http://github.com/josephalevin/fson [FSON code retrieved on 12/2/2013]
Copyright (c) 2012 Joseph A. Levin
Permission is hereby granted, free of charge, to any person obtaining a copy of this
software and associated documentation files (the "Software"), to deal in the Software
without restriction, including without limitation the rights to use, copy, modify, merge,
publish, distribute, sublicense, and/or sell copies of the Software, and to permit
persons to whom the Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or
substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT
OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
DEALINGS IN THE SOFTWARE.
json_module/destroy_json_data_non_polymorphic [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
destroy_json_data_non_polymorphic
USAGE
call me%destroy()
DESCRIPTION
Destroy the nonpolymorphic data type.
AUTHOR
Jacob Williams
SOURCE
344 subroutine destroy_json_data_non_polymorphic(me) 345 346 implicit none 347 348 class(json_data_non_polymorphic),intent(inout) :: me 349 350 me%var_type = 0 351 352 if (allocated(me%log_value)) deallocate(me%log_value) 353 if (allocated(me%int_value)) deallocate(me%int_value) 354 if (allocated(me%dbl_value)) deallocate(me%dbl_value) 355 if (allocated(me%str_value)) deallocate(me%str_value) 356 357 end subroutine destroy_json_data_non_polymorphic
json_module/destroy_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
destroy_json_file
USAGE
call me%destroy()
DESCRIPTION
Destroy the JSON file.
AUTHOR
Jacob Williams : 12/9/2013
SOURCE
377 subroutine destroy_json_file(me) 378 379 implicit none 380 381 class(json_file),intent(inout) :: me 382 383 if (associated(me%p)) call json_value_destroy(me%p) 384 385 end subroutine destroy_json_file
json_module/escape_string [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
escape_string
DESCRIPTION
Add the escape characters to a string for adding to JSON.
AUTHOR
Jacob Williams : 1/21/2014
SOURCE
1439 subroutine escape_string(str_in, str_out) 1440 1441 implicit none 1442 1443 character(len=*),intent(in) :: str_in 1444 character(len=:),allocatable,intent(out) :: str_out 1445 1446 integer :: i 1447 character(len=1) :: c 1448 1449 str_out = '' 1450 1451 !go through the string and look for special characters: 1452 do i=1,len(str_in) 1453 1454 c = str_in(i:i) !get next character in the input string 1455 1456 select case(c) 1457 case(quotation_mark,backslash,slash) 1458 str_out = str_out//backslash//c 1459 case(bspace) 1460 str_out = str_out//'\b' 1461 case(formfeed) 1462 str_out = str_out//'\f' 1463 case(newline) 1464 str_out = str_out//'\n' 1465 case(carriage_return) 1466 str_out = str_out//'\r' 1467 case(horizontal_tab) 1468 str_out = str_out//'\t' 1469 case default 1470 str_out = str_out//c 1471 end select 1472 1473 end do 1474 1475 end subroutine escape_string
json_module/get_by_index [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_by_index
DESCRIPTION
Returns a child in the object given the index.
SOURCE
1608 subroutine get_by_index(this, idx, p) 1609 1610 implicit none 1611 1612 type(json_value),pointer,intent(in) :: this 1613 integer,intent(in) :: idx 1614 type(json_value), pointer :: p 1615 1616 integer :: i 1617 1618 if (.not. exception_thrown) then 1619 1620 nullify(p) 1621 1622 if (associated(this%children)) then 1623 1624 p => this%children 1625 1626 do i = 1, idx - 1 1627 1628 if (associated(p%next)) then 1629 p => p%next 1630 else 1631 call throw_exception('Error in get_by_index:'//& 1632 ' p%next is not associated.') 1633 return 1634 end if 1635 1636 end do 1637 1638 else 1639 1640 call throw_exception('Error in get_by_index:'//& 1641 ' this%children is not associated.') 1642 1643 end if 1644 1645 end if 1646 1647 end subroutine get_by_index
json_module/get_by_name_chars [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_by_name_chars
DESCRIPTION
Returns a child in the object given the name string.
SOURCE
1661 subroutine get_by_name_chars(this, name, p) 1662 1663 implicit none 1664 1665 type(json_value),pointer,intent(in) :: this 1666 character(len=*),intent(in) :: name 1667 type(json_value),pointer :: p 1668 1669 integer :: i 1670 1671 if (.not. exception_thrown) then 1672 1673 if (associated(this)) then 1674 1675 nullify(p) 1676 1677 if (this%data%var_type==json_object) then 1678 do i=1, json_value_count(this) 1679 call json_value_get(this, i, p) 1680 if (allocated(p%name)) then 1681 if (p%name == name) return 1682 end if 1683 end do 1684 end if 1685 1686 !did not find anything: 1687 nullify(p) 1688 1689 else 1690 call throw_exception('Error in get_by_name_chars: pointer is not associated.') 1691 end if 1692 1693 end if 1694 1695 end subroutine get_by_name_chars
json_module/get_char_vec_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_char_vec_from_json_file
USAGE
call me%get(path,vec)
DESCRIPTION
Get a char vector from a JSON file.
AUTHOR
Jacob Williams : 1/19/2014
SOURCE
815 subroutine get_char_vec_from_json_file(me, path, vec, found) 816 817 implicit none 818 819 class(json_file),intent(inout) :: me 820 character(len=*),intent(in) :: path 821 character(len=*),dimension(:),allocatable,intent(out) :: vec 822 logical,intent(out),optional :: found 823 824 call json_get(me%p, path, vec, found) 825 826 end subroutine get_char_vec_from_json_file
json_module/get_chars_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_chars_from_json_file
USAGE
call me%get(path,val)
DESCRIPTION
Get a character string from a json file.
Note: val is an allocatable character string.
AUTHOR
Jacob Williams : 12/9/2013
SOURCE
784 subroutine get_chars_from_json_file(me, path, val, found) 785 786 implicit none 787 788 class(json_file),intent(inout) :: me 789 character(len=*),intent(in) :: path 790 character(len=:),allocatable,intent(out) :: val 791 logical,intent(out),optional :: found 792 793 call json_get(me%p, path=path, value=val, found=found) 794 795 end subroutine get_chars_from_json_file
json_module/get_current_line_from_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_current_line_from_file
DESCRIPTION
Rewind the file to the beginning of the current line, and return this line.
The file is assumed to be opened.
AUTHOR
Jacob Williams
SOURCE
3124 subroutine get_current_line_from_file(iunit,line) 3125 3126 implicit none 3127 3128 integer,intent(in) :: iunit 3129 character(len=:),allocatable,intent(out) :: line 3130 3131 integer,parameter :: n_chunk = 256 !chunk size [arbitrary] 3132 character(len=*),parameter :: nfmt = '(A256)' !corresponding format statement 3133 3134 character(len=n_chunk) :: chunk 3135 integer :: istat,isize 3136 3137 !initialize: 3138 line = '' 3139 3140 !rewind to beginning of the current record: 3141 backspace(iunit, iostat=istat) 3142 3143 !loop to read in all the characters in the current record. 3144 ![the line is read in chunks until the end of the line is reached] 3145 if (istat==0) then 3146 do 3147 read(iunit,fmt=nfmt,advance='NO',size=isize,iostat=istat) chunk 3148 if (istat==0) then 3149 line = line//chunk 3150 else 3151 if (isize>0) line = line//chunk(1:isize) 3152 exit 3153 end if 3154 end do 3155 end if 3156 3157 end subroutine get_current_line_from_file
json_module/get_double_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_double_from_json_file
USAGE
call me%get(path,val,found)
DESCRIPTION
Get a double from a JSON file.
AUTHOR
Jacob Williams : 12/9/2013
SOURCE
659 subroutine get_double_from_json_file (me, path, val, found) 660 661 implicit none 662 663 class(json_file),intent(inout) :: me 664 character(len=*),intent(in) :: path 665 real(wp),intent(out) :: val 666 logical,intent(out),optional :: found 667 668 call json_get(me%p, path=path, value=val, found=found) 669 670 end subroutine get_double_from_json_file
json_module/get_double_vec_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_double_vec_from_json_file
USAGE
call me%get(path,vec,found)
DESCRIPTION
Get a double vector from a JSON file.
AUTHOR
Jacob Williams : 1/19/2014
SOURCE
690 subroutine get_double_vec_from_json_file(me, path, vec, found) 691 692 implicit none 693 694 class(json_file),intent(inout) :: me 695 character(len=*),intent(in) :: path 696 real(wp),dimension(:),allocatable,intent(out) :: vec 697 logical,intent(out),optional :: found 698 699 call json_get(me%p, path, vec, found) 700 701 end subroutine get_double_vec_from_json_file
json_module/get_integer_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_integer_from_json_file
USAGE
call me%get(path,val)
DESCRIPTION
Get an integer from a JSON file.
AUTHOR
Jacob Williams : 12/9/2013
SOURCE
596 subroutine get_integer_from_json_file(me, path, val, found) 597 598 implicit none 599 600 class(json_file),intent(inout) :: me 601 character(len=*),intent(in) :: path 602 integer,intent(out) :: val 603 logical,intent(out),optional :: found 604 605 call json_get(me%p, path=path, value=val, found=found) 606 607 end subroutine get_integer_from_json_file
json_module/get_integer_vec_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_integer_vec_from_json_file
USAGE
call me%get(path,vec)
DESCRIPTION
Get an integer vector from a JSON file.
AUTHOR
Jacob Williams : 1/20/2014
SOURCE
627 subroutine get_integer_vec_from_json_file(me, path, vec, found) 628 629 implicit none 630 631 class(json_file),intent(inout) :: me 632 character(len=*),intent(in) :: path 633 integer,dimension(:),allocatable,intent(out) :: vec 634 logical,intent(out),optional :: found 635 636 637 call json_get(me%p, path, vec, found) 638 639 end subroutine get_integer_vec_from_json_file
json_module/get_logical_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_logical_from_json_file
USAGE
call me%get(path,val,found)
DESCRIPTION
Get an logical from a JSON file.
AUTHOR
Jacob Williams : 12/9/2013
SOURCE
721 subroutine get_logical_from_json_file(me,path,val,found) 722 723 implicit none 724 725 class(json_file),intent(inout) :: me 726 character(len=*),intent(in) :: path 727 logical,intent(out) :: val 728 logical,intent(out),optional :: found 729 730 call json_get(me%p, path=path, value=val, found=found) 731 732 end subroutine get_logical_from_json_file
json_module/get_logical_vec_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_logical_vec_from_json_file
USAGE
call me%get(path,vec)
DESCRIPTION
Get a logical vector from a JSON file.
AUTHOR
Jacob Williams : 1/20/2014
SOURCE
752 subroutine get_logical_vec_from_json_file(me, path, vec, found) 753 754 implicit none 755 756 class(json_file),intent(inout) :: me 757 character(len=*),intent(in) :: path 758 logical,dimension(:),allocatable,intent(out) :: vec 759 logical,intent(out),optional :: found 760 761 call json_get(me%p, path, vec, found) 762 763 end subroutine get_logical_vec_from_json_file
json_module/get_object_from_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
get_object_from_json_file
USAGE
call me%get(path,p,found)
DESCRIPTION
Get a pointer to an object from a JSON file.
AUTHOR
Jacob Williams : 2/3/2014
SOURCE
565 subroutine get_object_from_json_file(me, path, p, found) 566 567 implicit none 568 569 class(json_file),intent(inout) :: me 570 character(len=*),intent(in) :: path 571 type(json_value),pointer,intent(out) :: p 572 logical,intent(out),optional :: found 573 574 call json_get_by_path(me%p, path=path, p=p, found=found) 575 576 end subroutine get_object_from_json_file
json_module/integer_to_string [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
integer_to_string
DESCRIPTION
Convert an integer to a string.
AUTHOR
Jacob Williams : 12/4/2013
SOURCE
4078 subroutine integer_to_string(ival,str) 4079 4080 implicit none 4081 4082 integer,intent(in) :: ival 4083 character(len=*),intent(out) :: str 4084 4085 integer :: istat 4086 4087 write(str,fmt=int_fmt,iostat=istat) ival 4088 4089 if (istat==0) then 4090 str = adjustl(str) 4091 else 4092 str = repeat('*',len(str)) 4093 end if 4094 4095 end subroutine integer_to_string
json_module/json_check_for_errors [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_check_for_errors
DESCRIPTION
Retrieve error code from the module.
This should be called after json_parse to check for errors.
If an error is thrown, before using the module again, json_initialize
should be called to clean up before it is used again.
AUTHOR
Jacob Williams : 12/4/2013
SOURCE
944 subroutine json_check_for_errors(status_ok, error_msg) 945 946 implicit none 947 948 logical,intent(out) :: status_ok 949 character(len=:),allocatable,intent(out) :: error_msg 950 951 status_ok = .not. exception_thrown 952 953 if (.not. status_ok) then 954 if (allocated(err_message)) then 955 error_msg = err_message 956 else 957 error_msg = 'Unknown Error' 958 end if 959 else 960 error_msg = '' 961 end if 962 963 end subroutine json_check_for_errors
json_module/json_clear_exceptions [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_clear_exceptions
DESCRIPTION
Clear exceptions in the JSON module.
AUTHOR
Jacob Williams : 12/4/2013
SOURCE
875 subroutine json_clear_exceptions() 876 877 implicit none 878 879 !clear the flag and message: 880 exception_thrown = .false. 881 err_message = '' 882 883 end subroutine json_clear_exceptions
json_module/json_failed [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_failed
DESCRIPTION
Logical function to indicate if an exception has been thrown.
USAGE
if (json_failed()) then
!do something about it
call json_clear_exceptions()
end if
AUTHOR
Jacob Williams : 12/5/2013
SOURCE
986 function json_failed() result(failed) 987 988 implicit none 989 990 logical :: failed 991 992 failed = exception_thrown 993 994 end function json_failed
json_module/json_file [ Classes ]
[ Top ] [ json_module ] [ Classes ]
NAME
json_file
DESCRIPTION
The json_file is the main public class that is
used to open a file and get data from it.
EXAMPLE
type(json_file) :: json
call json%load_file(filename)
call json%print_file()
call json%get('var.i',ival,found)
call json%get('var.d',rval,found)
call json%get('var.c',cval,found)
call json%destroy()
AUTHOR
Jacob Williams : 12/9/2013
SOURCE
207 private 208 209 type(json_value), pointer :: p => null() !the JSON structure read from the file 210 211 contains 212 213 procedure,public :: load_file => load_json_file 214 procedure,public :: print_file => print_json_file 215 procedure,public :: destroy => destroy_json_file 216 217 procedure,public :: info => variable_info_in_file 218 219 generic,public :: get => get_pointer,& 220 get_integer,& 221 get_double,& 222 get_logical,& 223 get_chars,& 224 get_double_vec,& 225 get_char_vec,& 226 get_integer_vec,& 227 get_logical_vec 228 229 !scalars: 230 procedure :: get_pointer => get_object_from_json_file 231 procedure :: get_integer => get_integer_from_json_file 232 procedure :: get_double => get_double_from_json_file 233 procedure :: get_logical => get_logical_from_json_file 234 procedure :: get_chars => get_chars_from_json_file 235 236 !vectors: 237 procedure :: get_integer_vec => get_integer_vec_from_json_file 238 procedure :: get_double_vec => get_double_vec_from_json_file 239 procedure :: get_logical_vec => get_logical_vec_from_json_file 240 procedure :: get_char_vec => get_char_vec_from_json_file
json_module/json_get_array [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_array
DESCRIPTION
Get an array from an json_value. This routine calls the user-supplied array_callback subroutine for each element in the array.
SOURCE
2933 subroutine json_get_array(this, path, array_callback, found) 2934 2935 implicit none 2936 2937 type(json_value),pointer,intent(in) :: this 2938 character(len=*),intent(in),optional :: path 2939 procedure(array_callback_func) :: array_callback 2940 logical,intent(out),optional :: found 2941 2942 type(json_value), pointer :: element,p 2943 integer :: i, count 2944 2945 if (.not. exception_thrown) then 2946 2947 nullify(p) 2948 2949 ! resolve the path to the value 2950 if (present(path)) then 2951 call json_get_by_path(this=this, path=path, p=p) 2952 else 2953 p => this 2954 end if 2955 2956 if (.not.associated(p)) then 2957 2958 call throw_exception('Error in json_get_array:'//& 2959 ' Unable to resolve path: '//trim(path)) 2960 2961 else 2962 2963 !associate (d => p%data) 2964 select case (p%data%var_type) 2965 case (json_array) 2966 count = json_value_count(p) 2967 do i = 1, count 2968 call json_value_get(p, i, element) 2969 call array_callback(element, i, count) 2970 end do 2971 case default 2972 call throw_exception('Error in json_get_array:'//& 2973 ' Resolved value is not an array. '//trim(path)) 2974 end select 2975 !end associate 2976 2977 !cleanup: 2978 if (associated(p)) nullify(p) 2979 if (associated(element)) nullify(element) 2980 2981 end if 2982 2983 if (exception_thrown) then 2984 if (present(found)) then 2985 found = .false. 2986 call json_clear_exceptions() 2987 end if 2988 else 2989 if (present(found)) found = .true. 2990 end if 2991 2992 else 2993 if (present(found)) found = .false. 2994 end if 2995 2996 end subroutine json_get_array
json_module/json_get_by_path [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_by_path
DESCRIPTION
NOTES
$ root
@ this
. child object member
[] or () child array element
SOURCE
2012 subroutine json_get_by_path(this, path, p, found) 2013 2014 implicit none 2015 2016 type(json_value),pointer,intent(in) :: this 2017 character(len=*),intent(in) :: path 2018 type(json_value),pointer,intent(out) :: p 2019 logical,intent(out),optional :: found 2020 2021 integer :: i, length, child_i 2022 character(len=1) :: c 2023 logical :: array 2024 type(json_value),pointer :: tmp 2025 2026 if (.not. exception_thrown) then 2027 2028 nullify(p) 2029 2030 ! default to assuming relative to this 2031 p => this 2032 2033 child_i = 1 2034 2035 array = .false. 2036 2037 length = len_trim(path) 2038 2039 do i=1, length 2040 2041 c = path(i:i) 2042 2043 select case (c) 2044 case ('$') 2045 2046 ! root 2047 do while (associated (p % parent)) 2048 p => p % parent 2049 end do 2050 child_i = i + 1 2051 2052 case ('@') 2053 2054 ! this 2055 p => this 2056 child_i = i + 1 2057 2058 case ('.') 2059 2060 ! get child member from p 2061 if (child_i < i) then 2062 nullify(tmp) 2063 call json_value_get(p, path(child_i:i-1), tmp) 2064 p => tmp 2065 nullify(tmp) 2066 else 2067 child_i = i + 1 2068 cycle 2069 end if 2070 2071 if (.not.associated(p)) then 2072 call throw_exception('Error in json_get_by_path:'//& 2073 ' Error getting child member.') 2074 exit 2075 end if 2076 2077 child_i = i+1 2078 2079 case ('[','(') 2080 2081 !....Modified to allow for 'var[3]' style syntax 2082 !Note: jmozmoz/fson has a slightly different version of this... 2083 2084 ! start looking for the array element index 2085 array = .true. 2086 2087 ! get child member from p 2088 if (child_i < i) then 2089 nullify(tmp) 2090 call json_value_get(p, path(child_i:i-1), tmp) 2091 p => tmp 2092 nullify(tmp) 2093 else 2094 child_i = i + 1 2095 cycle 2096 end if 2097 if (.not.associated(p)) then 2098 call throw_exception('Error in json_get_by_path:'//& 2099 ' Error getting array element') 2100 exit 2101 end if 2102 child_i = i + 1 2103 2104 case (']',')') 2105 2106 if (.not.array) then 2107 call throw_exception('Error in json_get_by_path: Unexpected ]') 2108 exit 2109 end if 2110 array = .false. 2111 child_i = string_to_integer(path(child_i:i-1)) 2112 2113 nullify(tmp) 2114 call json_value_get(p, child_i, tmp) 2115 p => tmp 2116 nullify(tmp) 2117 2118 child_i= i + 1 2119 2120 end select 2121 2122 end do 2123 2124 if (exception_thrown) then 2125 2126 if (present(found)) then 2127 found = .false. 2128 call json_clear_exceptions() 2129 end if 2130 2131 else 2132 2133 ! grab the last child if present in the path 2134 if (child_i <= length) then 2135 nullify(tmp) 2136 call json_value_get(p, path(child_i:i-1), tmp) 2137 p => tmp 2138 nullify(tmp) 2139 end if 2140 if (associated(p)) then 2141 if (present(found)) found = .true. !everything seems to be ok 2142 else 2143 call throw_exception('Error in json_get_by_path:'//& 2144 ' variable not found: '//trim(path)) 2145 if (present(found)) then 2146 found = .false. 2147 call json_clear_exceptions() 2148 end if 2149 end if 2150 2151 end if 2152 2153 else 2154 if (present(found)) found = .false. 2155 end if 2156 2157 end subroutine json_get_by_path
json_module/json_get_char_vec [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_char_vec
DESCRIPTION
Get a char vector from a JSON file.
AUTHOR
Jacob Williams : 5/14/2014
SOURCE
2869 subroutine json_get_char_vec(me, path, vec, found) 2870 2871 implicit none 2872 2873 type(json_value),pointer,intent(in) :: me 2874 character(len=*),intent(in) :: path 2875 character(len=*),dimension(:),allocatable,intent(out) :: vec 2876 logical,intent(out),optional :: found 2877 2878 logical :: initialized 2879 2880 initialized = .false. 2881 2882 if (allocated(vec)) deallocate(vec) 2883 2884 !the callback function is called for each element of the array: 2885 call json_get(me, path=path, array_callback=get_chars_from_array, found=found) 2886 2887 contains 2888 2889 ! callback function for chars 2890 subroutine get_chars_from_array(element, i, count) 2891 2892 implicit none 2893 2894 type(json_value),pointer,intent(in) :: element 2895 integer,intent(in) :: i !index 2896 integer,intent(in) :: count !size of array 2897 2898 character(len=:),allocatable :: cval 2899 2900 !size the output array: 2901 if (.not. initialized) then 2902 allocate(vec(count)) 2903 initialized = .true. 2904 end if 2905 2906 !populate the elements: 2907 call json_get(element, value=cval) 2908 if (allocated(cval)) then 2909 vec(i) = cval 2910 deallocate(cval) 2911 else 2912 vec(i) = '' 2913 end if 2914 2915 end subroutine get_chars_from_array 2916 2917 end subroutine json_get_char_vec
json_module/json_get_chars [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_chars
DESCRIPTION
Get a character string from a json_value.
SOURCE
2655 subroutine json_get_chars(this, path, value, found) 2656 2657 implicit none 2658 2659 type(json_value),pointer,intent(in) :: this 2660 character(len=*),intent(in),optional :: path 2661 character(len=:),allocatable,intent(out) :: value 2662 logical,intent(out),optional :: found 2663 2664 type(json_value), pointer :: p 2665 character(len=:),allocatable :: s,pre,post 2666 integer :: j,jprev,n 2667 character(len=1) :: c 2668 2669 if (.not. exception_thrown) then 2670 2671 nullify(p) 2672 2673 if (present(path)) then 2674 call json_get_by_path(this=this, path=path, p=p) 2675 else 2676 p => this 2677 end if 2678 2679 if (.not.associated(p)) then 2680 2681 call throw_exception('Error in json_get_chars:'//& 2682 ' Unable to resolve path: '//trim(path)) 2683 2684 else 2685 2686 !associate (d => p%data) 2687 select case (p%data%var_type) 2688 case (json_string) 2689 if (allocated(p%data%str_value)) then 2690 2691 !get the value as is: 2692 s = p%data%str_value 2693 2694 ! Now, have to remove the escape characters: 2695 ! 2696 ! '\"' quotation mark 2697 ! '\\' reverse solidus 2698 ! '\/' solidus 2699 ! '\b' backspace 2700 ! '\f' formfeed 2701 ! '\n' newline (LF) 2702 ! '\r' carriage return (CR) 2703 ! '\t' horizontal tab 2704 ! '\uXXXX' 4 hexadecimal digits 2705 ! 2706 2707 !initialize: 2708 n = len(s) 2709 j = 1 2710 2711 do 2712 2713 jprev = j !initialize 2714 j = index(s(j:n),backslash) !look for an escape character 2715 2716 if (j>0) then !an escape character was found 2717 2718 !index in full string of the escape character: 2719 j = j + (jprev-1) 2720 2721 if (j<n) then 2722 2723 !save the bit before the escape character: 2724 if (j>1) then 2725 pre = s( 1 : j-1 ) 2726 else 2727 pre = '' 2728 end if 2729 2730 !character after the escape character: 2731 c = s( j+1 : j+1 ) 2732 2733 select case (c) 2734 case(quotation_mark,backslash,slash,& 2735 'b','f','n','r','t') 2736 2737 !save the bit after the escape characters: 2738 if (j+2<n) then 2739 post = s(j+2:n) 2740 else 2741 post = '' 2742 end if 2743 2744 select case(c) 2745 case(quotation_mark,backslash,slash) 2746 !use c as is 2747 case('b') 2748 c = bspace 2749 case('f') 2750 c = formfeed 2751 case('n') 2752 c = newline 2753 case('r') 2754 c = carriage_return 2755 case('t') 2756 c = horizontal_tab 2757 end select 2758 2759 s = pre//c//post 2760 2761 n = n-1 !backslash character has been 2762 ! removed from the string 2763 2764 case('u') !expecting 4 hexadecimal digits after 2765 ! the escape character [\uXXXX] 2766 2767 !for now, we are just printing them as is 2768 ![not checking to see if it is a valid hex value] 2769 2770 if (j+5<=n) then 2771 j=j+4 2772 else 2773 call throw_exception(& 2774 'Error in json_get_chars:'//& 2775 ' Invalid hexadecimal sequence'//& 2776 ' in string: '//trim(c)) 2777 exit 2778 end if 2779 2780 case default 2781 !unknown escape character 2782 call throw_exception('Error in json_get_chars:'//& 2783 ' unknown escape sequence in string "'//& 2784 trim(s)//'" ['//backslash//c//']') 2785 exit 2786 end select 2787 2788 j=j+1 !go to the next character 2789 2790 if (j>=n) exit !finished 2791 2792 else 2793 !an escape character is the last character in 2794 ! the string [this may not be valid syntax, 2795 ! but just keep it] 2796 exit 2797 end if 2798 2799 else 2800 exit !no more escape characters in the string 2801 end if 2802 2803 end do 2804 2805 if (exception_thrown) then 2806 if (allocated(value)) deallocate(value) 2807 else 2808 value = s 2809 end if 2810 2811 else 2812 call throw_exception('Error in json_get_chars:'//& 2813 ' p%data%value not allocated') 2814 end if 2815 2816 !class default 2817 case default 2818 2819 call throw_exception('Error in json_get_chars:'//& 2820 ' Unable to resolve value to characters: '//& 2821 trim(path)) 2822 2823 ! Note: for the other cases, we could do val to string conversions. 2824 2825 end select 2826 !end associate 2827 2828 end if 2829 2830 if (allocated(value) .and. .not. exception_thrown) then 2831 if (present(found)) found = .true. 2832 else 2833 if (present(found)) then 2834 found = .false. 2835 call json_clear_exceptions() 2836 end if 2837 end if 2838 2839 !cleanup: 2840 if (associated(p)) nullify(p) 2841 if (allocated(s)) deallocate(s) 2842 if (allocated(pre)) deallocate(pre) 2843 if (allocated(post)) deallocate(post) 2844 2845 else 2846 2847 value = '' 2848 found = .false. 2849 2850 end if 2851 2852 end subroutine json_get_chars
json_module/json_get_double [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_double
DESCRIPTION
Get a double value from an json_value.
SOURCE
2387 subroutine json_get_double(this, path, value, found) 2388 2389 implicit none 2390 2391 type(json_value), pointer :: this 2392 character(len=*), optional :: path 2393 real(wp),intent(out) :: value 2394 logical,intent(out),optional :: found 2395 2396 type(json_value), pointer :: p 2397 2398 if (.not. exception_thrown) then 2399 2400 nullify(p) 2401 2402 if (present(path)) then 2403 call json_get_by_path(this=this, path=path, p=p) 2404 else 2405 p => this 2406 end if 2407 2408 if (.not.associated(p)) then 2409 2410 call throw_exception('Error in json_get_double:'//& 2411 ' Unable to resolve path: '//trim(path)) 2412 2413 else 2414 2415 !associate (d => p%data) 2416 select case (p%data%var_type) 2417 case (json_integer) 2418 value = p%data%int_value 2419 case (json_real) 2420 value = p%data%dbl_value 2421 case (json_logical) 2422 if (p%data%log_value) then 2423 value = 1.0_wp 2424 else 2425 value = 0.0_wp 2426 end if 2427 case default 2428 call throw_exception('Error in json_get_double:'//& 2429 ' Unable to resolve value to double: '//& 2430 trim(path)) 2431 end select 2432 !end associate 2433 2434 nullify(p) 2435 2436 end if 2437 2438 if (exception_thrown) then 2439 if (present(found)) then 2440 found = .false. 2441 call json_clear_exceptions() 2442 end if 2443 else 2444 if (present(found)) found = .true. 2445 end if 2446 2447 else 2448 2449 value = 0.0_wp 2450 if (present(found)) found = .false. 2451 2452 end if 2453 2454 end subroutine json_get_double
json_module/json_get_double_vec [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_double_vec
DESCRIPTION
Get a double vector from a JSON value.
AUTHOR
Jacob Williams : 5/14/2014
SOURCE
2471 subroutine json_get_double_vec(me, path, vec, found) 2472 2473 implicit none 2474 2475 type(json_value), pointer :: me 2476 character(len=*),intent(in) :: path 2477 real(wp),dimension(:),allocatable,intent(out) :: vec 2478 logical,intent(out),optional :: found 2479 2480 logical :: initialized 2481 2482 initialized = .false. 2483 2484 if (allocated(vec)) deallocate(vec) 2485 2486 !the callback function is called for each element of the array: 2487 call json_get(me, path=path, array_callback=get_double_from_array, found=found) 2488 2489 contains 2490 2491 ! callback function for double 2492 subroutine get_double_from_array(element, i, count) 2493 implicit none 2494 2495 type(json_value),pointer,intent(in) :: element 2496 integer,intent(in) :: i !index 2497 integer,intent(in) :: count !size of array 2498 2499 !size the output array: 2500 if (.not. initialized) then 2501 allocate(vec(count)) 2502 initialized = .true. 2503 end if 2504 2505 !populate the elements: 2506 call json_get(element, value=vec(i)) 2507 2508 end subroutine get_double_from_array 2509 2510 end subroutine json_get_double_vec
json_module/json_get_integer [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_integer
DESCRIPTION
Get an integer value from an json_value.
SOURCE
2250 subroutine json_get_integer(this, path, value, found) 2251 2252 implicit none 2253 2254 type(json_value),pointer,intent(in) :: this 2255 character(len=*),optional :: path 2256 integer,intent(out) :: value 2257 logical,intent(out),optional :: found 2258 2259 type(json_value), pointer :: p 2260 2261 if (.not. exception_thrown) then 2262 2263 nullify(p) 2264 if (present(path)) then 2265 call json_get_by_path(this=this, path=path, p=p) 2266 else 2267 p => this 2268 end if 2269 2270 if (.not.associated(p)) then 2271 2272 call throw_exception('Error in json_get_integer:'//& 2273 ' Unable to resolve path: '// trim(path)) 2274 2275 else 2276 2277 !associate (d => p%data) 2278 select case(p%data%var_type) 2279 case (json_integer) 2280 value = p%data%int_value 2281 case (json_real) 2282 value = int(p%data%dbl_value) 2283 case (json_logical) 2284 if (p%data%log_value) then 2285 value = 1 2286 else 2287 value = 0 2288 end if 2289 case default 2290 call throw_exception('Error in get_integer:'//& 2291 ' Unable to resolve value to integer: '//& 2292 trim(path)) 2293 end select 2294 !end associate 2295 2296 nullify(p) 2297 2298 end if 2299 2300 if (exception_thrown) then 2301 if (present(found)) then 2302 found = .false. 2303 call json_clear_exceptions() 2304 end if 2305 else 2306 if (present(found)) found = .true. 2307 end if 2308 2309 else 2310 2311 value = 0 2312 if (present(found)) found = .false. 2313 2314 end if 2315 2316 end subroutine json_get_integer
json_module/json_get_integer_vec [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_integer_vec
DESCRIPTION
Get an integer vector from a JSON value.
AUTHOR
Jacob Williams : 5/14/2014
SOURCE
2333 subroutine json_get_integer_vec(me, path, vec, found) 2334 2335 implicit none 2336 2337 type(json_value), pointer :: me 2338 character(len=*),intent(in) :: path 2339 integer,dimension(:),allocatable,intent(out) :: vec 2340 logical,intent(out),optional :: found 2341 2342 logical :: initialized 2343 2344 initialized = .false. 2345 2346 if (allocated(vec)) deallocate(vec) 2347 2348 !the callback function is called for each element of the array: 2349 call json_get(me, path=path, array_callback=get_int_from_array, found=found) 2350 2351 contains 2352 2353 ! callback function for integer 2354 subroutine get_int_from_array(element, i, count) 2355 implicit none 2356 2357 type(json_value),pointer,intent(in) :: element 2358 integer,intent(in) :: i !index 2359 integer,intent(in) :: count !size of array 2360 2361 !size the output array: 2362 if (.not. initialized) then 2363 allocate(vec(count)) 2364 initialized = .true. 2365 end if 2366 2367 !populate the elements: 2368 call json_get(element, value=vec(i)) 2369 2370 end subroutine get_int_from_array
json_module/json_get_logical [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_logical
DESCRIPTION
Get a logical value from an json_value.
SOURCE
2524 subroutine json_get_logical(this, path, value, found) 2525 2526 implicit none 2527 2528 type(json_value),pointer,intent(in) :: this 2529 character(len=*),optional :: path 2530 logical :: value 2531 logical,intent(out),optional :: found 2532 2533 type(json_value), pointer :: p 2534 2535 if (.not. exception_thrown) then 2536 2537 nullify(p) 2538 2539 if (present(path)) then 2540 call json_get_by_path(this=this, path=path, p=p) 2541 else 2542 p => this 2543 end if 2544 2545 if (.not.associated(p)) then 2546 2547 call throw_exception('Error in json_get_logical:'//& 2548 ' Unable to resolve path: '//trim(path)) 2549 2550 else 2551 2552 !associate (d => p%data) 2553 select case (p%data%var_type) 2554 case (json_integer) 2555 value = (p%data%int_value > 0) 2556 case (json_logical) 2557 value = p%data % log_value 2558 case default 2559 call throw_exception('Error in json_get_logical:'//& 2560 ' Unable to resolve value to logical: '//& 2561 trim(path)) 2562 end select 2563 !end associate 2564 2565 nullify(p) 2566 2567 end if 2568 2569 if (exception_thrown) then 2570 if (present(found)) then 2571 found = .false. 2572 call json_clear_exceptions() 2573 end if 2574 else 2575 if (present(found)) found = .true. 2576 end if 2577 2578 else 2579 2580 value = .false. 2581 if (present(found)) found = .false. 2582 2583 end if 2584 2585 end subroutine json_get_logical
json_module/json_get_logical_vec [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_get_logical_vec
DESCRIPTION
Get a logical vector from a JSON value.
AUTHOR
Jacob Williams : 5/14/2014
SOURCE
2602 subroutine json_get_logical_vec(me, path, vec, found) 2603 2604 implicit none 2605 2606 type(json_value),pointer,intent(in) :: me 2607 character(len=*),intent(in) :: path 2608 logical,dimension(:),allocatable,intent(out) :: vec 2609 logical,intent(out),optional :: found 2610 2611 logical :: initialized 2612 2613 initialized = .false. 2614 2615 if (allocated(vec)) deallocate(vec) 2616 2617 !the callback function is called for each element of the array: 2618 call json_get(me, path=path, array_callback=get_logical_from_array, found=found) 2619 2620 contains 2621 2622 ! callback function for logical 2623 subroutine get_logical_from_array(element, i, count) 2624 implicit none 2625 2626 type(json_value),pointer,intent(in) :: element 2627 integer,intent(in) :: i !index 2628 integer,intent(in) :: count !size of array 2629 2630 !size the output array: 2631 if (.not. initialized) then 2632 allocate(vec(count)) 2633 initialized = .true. 2634 end if 2635 2636 !populate the elements: 2637 call json_get(element, value=vec(i)) 2638 2639 end subroutine get_logical_from_array 2640 2641 end subroutine json_get_logical_vec
json_module/json_info [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_info
USAGE
call me%info(path,found,var_type,n_children)
DESCRIPTION
Returns information about a json_value
AUTHOR
Jacob Williams : 2/13/2014
SOURCE
534 subroutine json_info(p,var_type,n_children) 535 536 implicit none 537 538 type(json_value),pointer :: p 539 integer,intent(out),optional :: var_type 540 integer,intent(out),optional :: n_children 541 542 if (present(var_type)) var_type = p%data%var_type !variable type 543 if (present(n_children)) n_children = json_value_count(p) !number of children 544 545 end subroutine json_info
json_module/json_initialize [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_initialize
DESCRIPTION
Initialize the module.
Should be called before the routines are used.
It can also be called after using the module and encountering exceptions.
AUTHOR
Jacob Williams : 12/4/2013
SOURCE
845 subroutine json_initialize() 846 847 implicit none 848 849 !clear any errors from previous runs: 850 call json_clear_exceptions() 851 852 !Just in case, clear these global variables also: 853 pushed_index = 0 854 pushed_char = '' 855 char_count = 0 856 line_count = 1 857 858 end subroutine json_initialize
json_module/json_parse [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_parse
DESCRIPTION
Parse the JSON file and populate the json_value tree.
NOTES
When calling this routine, any exceptions thrown from previous
calls will automatically be cleared.
SOURCE
3014 subroutine json_parse(file, p, unit) 3015 3016 implicit none 3017 3018 character(len=*),intent(in) :: file 3019 type(json_value),pointer :: p 3020 integer,intent(in),optional :: unit 3021 3022 integer :: iunit, istat 3023 character(len=:),allocatable :: line, arrow_str 3024 character(len=10) :: line_str, char_str 3025 logical :: is_open 3026 3027 !clean any exceptions and initialize: 3028 call json_initialize() 3029 3030 if (present(unit)) then 3031 3032 iunit = unit 3033 3034 !check to see if the file is already open 3035 ! if it is, then use it, otherwise open the file. 3036 inquire(unit=iunit, opened=is_open, iostat=istat) 3037 if (istat==0 .and. .not. is_open) then 3038 ! open the file 3039 open ( unit = iunit, & 3040 file = file, & 3041 status = 'OLD', & 3042 action = 'READ', & 3043 form = 'FORMATTED', & 3044 position = 'REWIND', & 3045 iostat = istat) 3046 end if 3047 3048 else 3049 3050 ! open the file with a new unit number: 3051 open ( newunit = iunit, & 3052 file = file, & 3053 status = 'OLD', & 3054 action = 'READ', & 3055 form = 'FORMATTED', & 3056 position = 'REWIND', & 3057 iostat = istat) 3058 3059 end if 3060 3061 if (istat==0) then 3062 3063 ! create the value and associate the pointer 3064 call json_value_create(p) 3065 3066 !add the file name as the name of the overall structure: 3067 p%name = trim(file) 3068 3069 ! parse as a value 3070 call parse_value(unit = iunit, value = p) 3071 3072 ! 3073 ! If there was an error reading the file, then 3074 ! can print the line where the error occurred: 3075 ! 3076 if (exception_thrown) then 3077 3078 call get_current_line_from_file(iunit,line) 3079 3080 !the counters for the current line and the last character read: 3081 call integer_to_string(line_count, line_str) 3082 call integer_to_string(char_count, char_str) 3083 3084 !draw the arrow string that points to the current character: 3085 arrow_str = repeat('-',max( 0, char_count - 1) )//'^' 3086 3087 !create the error message: 3088 err_message = err_message//newline//& 3089 'line: '//trim(adjustl(line_str))//', '//& 3090 'character: '//trim(adjustl(char_str))//newline//& 3091 trim(line)//newline//arrow_str 3092 3093 if (allocated(line)) deallocate(line) 3094 3095 end if 3096 3097 ! close the file 3098 close (iunit, iostat=istat) 3099 3100 else 3101 3102 call throw_exception('Error in json_parse: Error opening file: '//trim(file)) 3103 3104 end if 3105 3106 end subroutine json_parse
json_module/json_print [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_print
DESCRIPTION
Print the JSON structure to a file
AUTHOR
Jacob Williams, 6/20/2014
SOURCE
1739 subroutine json_print(me,iunit) 1740 1741 implicit none 1742 1743 type(json_value),pointer,intent(in) :: me 1744 integer,intent(in) :: iunit !must be non-zero 1745 1746 character(len=:),allocatable :: dummy 1747 1748 if (iunit/=0) then 1749 call json_value_print(me,iunit,str=dummy) 1750 else 1751 call throw_exception('Error in json_print: iunit must be nonzero.') 1752 end if 1753 1754 end subroutine json_print
json_module/json_value [ Classes ]
[ Top ] [ json_module ] [ Classes ]
NAME
json_value
DESCRIPTION
Type used to construct the linked-list json structure
SOURCE
165 type,public :: json_value 166 167 !variable name: 168 character(len=:),allocatable :: name 169 170 !the data for this variable: 171 type(json_data_non_polymorphic) :: data 172 173 !for the linked list: 174 type(json_value), pointer :: next => null() 175 type(json_value), pointer :: parent => null() 176 type(json_value), pointer :: children => null() 177 178 end type json_value
json_module/json_value_add_integer [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_integer
DESCRIPTION
Add an integer value to the structure.
These routines are part of the public API that can be
used to build a json structure using data.
AUTHOR
Jacob Williams : 1/20/2014
SOURCE
1226 subroutine json_value_add_integer(me, name, val) 1227 1228 implicit none 1229 1230 type(json_value), pointer :: me 1231 character(len=*),intent(in) :: name 1232 integer,intent(in) :: val 1233 1234 type(json_value),pointer :: var 1235 1236 !create the variable: 1237 call json_value_create(var) 1238 call to_integer(var,val,name) 1239 1240 !add it: 1241 call json_value_add(me, var) 1242 1243 !cleanup: 1244 nullify(var) 1245 1246 end subroutine json_value_add_integer
json_module/json_value_add_integer_vec [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_integer_vec
DESCRIPTION
Add an integer vector to the structure.
These routines are part of the public API that can be
used to build a json structure using data.
AUTHOR
Jacob Williams : 1/20/2014
SOURCE
1266 subroutine json_value_add_integer_vec(me, name, val) 1267 1268 implicit none 1269 1270 type(json_value), pointer :: me 1271 character(len=*),intent(in) :: name 1272 integer,dimension(:),intent(in) :: val 1273 1274 type(json_value),pointer :: var 1275 integer :: i !counter 1276 1277 !create the variable as an array: 1278 call json_value_create(var) 1279 call to_array(var,name) 1280 1281 !populate the array: 1282 do i=1,size(val) 1283 call json_value_add(var, '', val(i)) 1284 end do 1285 1286 !add it: 1287 call json_value_add(me, var) 1288 1289 !cleanup: 1290 nullify(var) 1291 1292 end subroutine json_value_add_integer_vec
json_module/json_value_add_logical [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_logical
DESCRIPTION
Add a logical value to the structure.
These routines are part of the public API that can be
used to build a json structure using data.
AUTHOR
Jacob Williams : 1/20/2014
SOURCE
1312 subroutine json_value_add_logical(me, name, val) 1313 1314 implicit none 1315 1316 type(json_value), pointer :: me 1317 character(len=*),intent(in) :: name 1318 logical,intent(in) :: val 1319 1320 type(json_value),pointer :: var 1321 1322 !create the variable: 1323 call json_value_create(var) 1324 call to_logical(var,val,name) 1325 1326 !add it: 1327 call json_value_add(me, var) 1328 1329 !cleanup: 1330 nullify(var) 1331 1332 end subroutine json_value_add_logical
json_module/json_value_add_logical_vec [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_logical_vec
DESCRIPTION
Add a logical vector to the structure.
These routines are part of the public API that can be
used to build a json structure using data.
AUTHOR
Jacob Williams : 1/20/2014
SOURCE
1352 subroutine json_value_add_logical_vec(me, name, val) 1353 1354 implicit none 1355 1356 type(json_value), pointer :: me 1357 character(len=*),intent(in) :: name 1358 logical,dimension(:),intent(in) :: val 1359 1360 type(json_value),pointer :: var 1361 integer :: i !counter 1362 1363 !create the variable as an array: 1364 call json_value_create(var) 1365 call to_array(var,name) 1366 1367 !populate the array: 1368 do i=1,size(val) 1369 call json_value_add(var, '', val(i)) 1370 end do 1371 1372 !add it: 1373 call json_value_add(me, var) 1374 1375 !cleanup: 1376 nullify(var) 1377 1378 end subroutine json_value_add_logical_vec
json_module/json_value_add_member [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_member
DESCRIPTION
Adds the member to the linked list
SOURCE
1084 subroutine json_value_add_member(this, member) 1085 1086 implicit none 1087 1088 type(json_value), pointer :: this, member 1089 1090 type(json_value), pointer :: p 1091 1092 if (.not. exception_thrown) then 1093 1094 nullify(p) 1095 1096 ! associate the parent 1097 member % parent => this 1098 1099 ! add to linked list 1100 if (associated(this % children)) then 1101 1102 ! get to the tail of the linked list 1103 p => this % children 1104 do while (associated(p % next)) 1105 p => p % next 1106 end do 1107 1108 p % next => member 1109 1110 nullify(p) !cleanup 1111 1112 else 1113 1114 this % children => member 1115 1116 end if 1117 1118 end if 1119 1120 end subroutine json_value_add_member
json_module/json_value_add_real [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_real
DESCRIPTION
Add a real value to the structure.
These routines are part of the public API that can be
used to build a json structure using data.
AUTHOR
Jacob Williams : 1/19/2014
SOURCE
1140 subroutine json_value_add_real(me, name, val) 1141 1142 implicit none 1143 1144 type(json_value), pointer :: me 1145 character(len=*),intent(in) :: name 1146 real(wp),intent(in) :: val 1147 1148 type(json_value),pointer :: var 1149 1150 !create the variable: 1151 call json_value_create(var) 1152 call to_real(var,val,name) 1153 1154 !add it: 1155 call json_value_add(me, var) 1156 1157 !cleanup: 1158 nullify(var) 1159 1160 end subroutine json_value_add_real
json_module/json_value_add_real_vec [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_real_vec
DESCRIPTION
Add a real vector to the structure.
These routines are part of the public API that can be
used to build a json structure using data.
AUTHOR
Jacob Williams : 1/20/2014
SOURCE
1180 subroutine json_value_add_real_vec(me, name, val) 1181 1182 implicit none 1183 1184 type(json_value), pointer :: me 1185 character(len=*),intent(in) :: name 1186 real(wp),dimension(:),intent(in) :: val 1187 1188 type(json_value),pointer :: var 1189 integer :: i 1190 1191 !create the variable as an array: 1192 call json_value_create(var) 1193 call to_array(var,name) 1194 1195 !populate the array: 1196 do i=1,size(val) 1197 call json_value_add(var, '', val(i)) 1198 end do 1199 1200 !add it: 1201 call json_value_add(me, var) 1202 1203 !cleanup: 1204 nullify(var) 1205 1206 end subroutine json_value_add_real_vec
json_module/json_value_add_string [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_string
DESCRIPTION
Add a character string the structure.
These routines are part of the public API that can be
used to build a json structure using data.
AUTHOR
Jacob Williams : 1/19/2014
SOURCE
1398 subroutine json_value_add_string(me, name, val) 1399 1400 implicit none 1401 1402 type(json_value), pointer :: me 1403 character(len=*),intent(in) :: name 1404 character(len=*),intent(in) :: val 1405 1406 type(json_value),pointer :: var 1407 character(len=:),allocatable :: str 1408 1409 !add escape characters if necessary: 1410 call escape_string(val, str) 1411 1412 !create the variable: 1413 call json_value_create(var) 1414 call to_string(var,str,name) 1415 1416 !add it: 1417 call json_value_add(me, var) 1418 1419 !cleanup: 1420 nullify(var) 1421 1422 end subroutine json_value_add_string
json_module/json_value_add_string_vec [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_add_string_vec
DESCRIPTION
Add an array of character string to the structure.
These routines are part of the public API that can be
used to build a json structure using data.
AUTHOR
Jacob Williams : 1/19/2014
SOURCE
1495 subroutine json_value_add_string_vec(me, name, val, trim_str, adjustl_str) 1496 1497 implicit none 1498 1499 type(json_value), pointer :: me 1500 character(len=*),intent(in) :: name 1501 character(len=*),dimension(:),intent(in) :: val 1502 logical,intent(in),optional :: trim_str 1503 logical,intent(in),optional :: adjustl_str 1504 1505 type(json_value),pointer :: var 1506 integer :: i 1507 logical :: trim_string, adjustl_string 1508 character(len=:),allocatable :: str 1509 1510 !if the string is to be trimmed or not: 1511 if (present(trim_str)) then 1512 trim_string = trim_str 1513 else 1514 trim_string = .false. 1515 end if 1516 if (present(adjustl_str)) then 1517 adjustl_string = adjustl_str 1518 else 1519 adjustl_string = .false. 1520 end if 1521 1522 !create the variable as an array: 1523 call json_value_create(var) 1524 call to_array(var,name) 1525 1526 !populate the array: 1527 do i=1,size(val) 1528 1529 !the string to write: 1530 str = val(i) 1531 if (adjustl_string) str = adjustl(str) 1532 if (trim_string) str = trim(str) 1533 1534 !write it: 1535 call json_value_add(var, '', str) 1536 1537 !cleanup 1538 deallocate(str) 1539 1540 end do 1541 1542 !add it: 1543 call json_value_add(me, var) 1544 1545 !cleanup: 1546 nullify(var) 1547 1548 end subroutine json_value_add_string_vec
json_module/json_value_count [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_count
DESCRIPTION
Count the number of children.
SOURCE
1562 function json_value_count(this) result(count) 1563 1564 implicit none 1565 1566 integer :: count 1567 type(json_value),pointer,intent(in) :: this 1568 1569 type(json_value), pointer :: p 1570 1571 if (.not. exception_thrown) then 1572 1573 count = 0 1574 1575 if (associated(this)) then 1576 1577 if (associated(this%children)) then 1578 1579 p => this%children 1580 1581 do while (associated(p)) 1582 count = count + 1 1583 p => p%next 1584 end do 1585 1586 nullify(p) 1587 1588 end if 1589 1590 end if 1591 1592 end if 1593 1594 end function json_value_count
json_module/json_value_create [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_create
DESCRIPTION
Allocate a json_value pointer variable. This should be called before adding data to it. Example: type(json_value),pointer :: var call json_value_create(var) call to_real(var,1.0d0)
NOTES
This routine does not check for exceptions.
The pointer should not already be allocated.
SOURCE
1017 subroutine json_value_create(p) 1018 1019 implicit none 1020 1021 type(json_value), pointer :: p 1022 1023 nullify(p) 1024 allocate(p) 1025 1026 end subroutine json_value_create
json_module/json_value_destroy [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_destroy
DESCRIPTION
Destroy a json_value linked-list structure.
NOTES
This routine does not check for exceptions.
I believe the original version of this routine was not
properly freeing the memory. It has been rewritten.
AUTHOR
Jacob Williams : 1/22/2014
SOURCE
1048 recursive subroutine json_value_destroy(this) 1049 1050 implicit none 1051 1052 type(json_value),pointer :: this 1053 1054 if (associated(this)) then 1055 1056 if (allocated(this%name)) deallocate(this%name) 1057 1058 call this%data%destroy() 1059 1060 if (associated(this%children)) call json_value_destroy(this%children) 1061 1062 if (associated(this%next)) call json_value_destroy(this%next) 1063 1064 deallocate(this) 1065 1066 nullify(this) 1067 1068 end if 1069 1070 end subroutine json_value_destroy
json_module/json_value_to_string [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
json_value_to_string
DESCRIPTION
Print the JSON structure to an allocatable string.
AUTHOR
Jacob Williams : 2/12/2014
SOURCE
1712 subroutine json_value_to_string(me,str) 1713 1714 implicit none 1715 1716 type(json_value),pointer,intent(in) :: me 1717 character(len=:),intent(out),allocatable :: str 1718 1719 str = '' 1720 call json_value_print(me, iunit=0, str=str) 1721 1722 end subroutine json_value_to_string
json_module/load_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
load_json_file
USAGE
call me%load_file(filename)
DESCRIPTION
Load the JSON file.
AUTHOR
Jacob Williams : 12/9/2013
SOURCE
405 subroutine load_json_file(me, filename) 406 407 implicit none 408 409 class(json_file),intent(inout) :: me 410 character(len=*),intent(in) :: filename 411 412 call json_parse(filename, me%p) 413 414 end subroutine load_json_file
json_module/parse_object [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
parse_object
DESCRIPTION
SOURCE
3538 recursive subroutine parse_object(unit, parent) 3539 3540 implicit none 3541 3542 integer, intent(in) :: unit 3543 type(json_value), pointer :: parent 3544 3545 type(json_value), pointer :: pair 3546 logical :: eof 3547 character(len=1) :: c 3548 character(len=:),allocatable :: tmp !this is a work-around for a bug 3549 ! in the gfortran 4.9 compiler. 3550 3551 if (.not. exception_thrown) then 3552 3553 !the routine is being called incorrectly. 3554 if (.not. associated(parent)) then 3555 call throw_exception('Error in parse_object: parent pointer not associated.') 3556 end if 3557 3558 nullify(pair) !probably not necessary 3559 3560 ! pair name 3561 c = pop_char(unit, eof = eof, skip_ws = .true.) 3562 if (eof) then 3563 call throw_exception('Error in parse_object:'//& 3564 ' Unexpected end of file while parsing start of object.') 3565 call cleanup() 3566 return 3567 else if ('}' == c) then 3568 ! end of an empty object 3569 call cleanup() 3570 return 3571 else if ('"' == c) then 3572 call json_value_create(pair) 3573 call parse_string(unit, tmp) !write to a tmp variable because of 3574 pair % name = tmp ! a bug in 4.9 gfortran compiler. 3575 deallocate(tmp) 3576 if (exception_thrown) return 3577 else 3578 call throw_exception('Error in parse_object: Expecting string: "'//c//'"') 3579 call cleanup() 3580 return 3581 end if 3582 3583 ! pair value 3584 c = pop_char(unit, eof = eof, skip_ws = .true.) 3585 if (eof) then 3586 call throw_exception('Error in parse_object:'//& 3587 ' Unexpected end of file while parsing object member.') 3588 call cleanup() 3589 return 3590 else if (':' == c) then 3591 ! parse the value 3592 call parse_value(unit, pair) 3593 if (exception_thrown) return 3594 call json_value_add(parent, pair) 3595 else 3596 call throw_exception('Error in parse_object:'//& 3597 ' Expecting : and then a value: '//c) 3598 call cleanup() 3599 return 3600 end if 3601 3602 ! another possible pair 3603 c = pop_char(unit, eof = eof, skip_ws = .true.) 3604 if (eof) then 3605 call cleanup() 3606 return 3607 else if (',' == c) then 3608 ! read the next member 3609 call parse_object(unit = unit, parent = parent) 3610 else if ('}' == c) then 3611 call cleanup() 3612 return 3613 else 3614 call throw_exception('Error in parse_object: Expecting end of object: '//c) 3615 call cleanup() 3616 return 3617 end if 3618 3619 call cleanup() 3620 3621 end if 3622 3623 contains 3624 3625 !cleanup routine: 3626 subroutine cleanup() 3627 3628 implicit none 3629 3630 if (associated(pair)) nullify(pair) 3631 3632 end subroutine cleanup 3633 3634 end subroutine parse_object
json_module/parse_value [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
parse_value
DESCRIPTION
SOURCE
3171 recursive subroutine parse_value(unit, value) 3172 3173 implicit none 3174 3175 integer, intent(in) :: unit 3176 type(json_value), pointer :: value 3177 3178 logical :: eof 3179 character(len=1) :: c 3180 character(len=:),allocatable :: tmp !this is a work-around for a bug 3181 ! in the gfortran 4.9 compiler. 3182 3183 if (.not. exception_thrown) then 3184 3185 !the routine is being called incorrectly. 3186 if (.not. associated(value)) then 3187 call throw_exception('Error in parse_value: value pointer not associated.') 3188 end if 3189 3190 ! pop the next non whitespace character off the file 3191 c = pop_char(unit, eof = eof, skip_ws = .true.) 3192 3193 if (eof) then 3194 return 3195 else 3196 select case (c) 3197 case ('{') 3198 3199 ! start object 3200 call to_object(value) !allocate class 3201 call parse_object(unit, value) 3202 3203 case ('[') 3204 3205 ! start array 3206 call to_array(value) !allocate class 3207 call parse_array(unit, value) 3208 3209 case (']') 3210 3211 ! end an empty array 3212 call push_char(c) 3213 nullify(value) 3214 3215 case ('"') 3216 3217 ! string 3218 call to_string(value) !allocate class 3219 3220 !associate (d => value%data) 3221 !select type (value%data) 3222 select case (value%data%var_type) 3223 !type is (json_string) 3224 case (json_string) 3225 call parse_string(unit, tmp) !write to a tmp variable because of 3226 value%data%str_value = tmp ! a bug in 4.9 gfortran compiler. 3227 deallocate(tmp) 3228 end select 3229 !end associate 3230 3231 case ('t') 3232 3233 !true 3234 call parse_for_chars(unit, 'rue') 3235 !allocate class and set value: 3236 if (.not. exception_thrown) call to_logical(value,.true.) 3237 3238 case ('f') 3239 3240 !false 3241 call parse_for_chars(unit, 'alse') 3242 !allocate class and set value: 3243 if (.not. exception_thrown) call to_logical(value,.false.) 3244 3245 case ('n') 3246 3247 call parse_for_chars(unit, 'ull') 3248 if (.not. exception_thrown) call to_null(value) !allocate class 3249 3250 case('-', '0': '9') 3251 3252 call push_char(c) 3253 call parse_number(unit, value) 3254 3255 case default 3256 3257 call throw_exception('Error in parse_value:'//& 3258 ' Unexpected character while parsing value. "'//& 3259 c//'"') 3260 3261 end select 3262 end if 3263 3264 end if 3265 3266 end subroutine parse_value
json_module/print_json_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
print_json_file
USAGE
call me%print_file()
DESCRIPTION
Print the JSON file.
Prints to the specified file unit (if not present, then prints to the console)
AUTHOR
Jacob Williams : 12/9/2013
SOURCE
435 subroutine print_json_file(me, iunit) 436 437 use, intrinsic :: iso_fortran_env, only: output_unit 438 439 implicit none 440 441 class(json_file),intent(inout) :: me 442 integer,intent(in),optional :: iunit !must be non-zero 443 444 integer :: i 445 character(len=:),allocatable :: dummy 446 447 if (present(iunit)) then 448 if (iunit/=0) then 449 i = iunit 450 else 451 call throw_exception('Error in print_json_file: iunit must be nonzero.') 452 return 453 end if 454 else 455 i = output_unit 456 end if 457 458 call json_value_print(me%p,iunit=i,str=dummy) 459 460 end subroutine print_json_file
json_module/string_to_double [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
string_to_double
DESCRIPTION
Convert a string into a double.
AUTHOR
Jacob Williams : 1/19/2014
SOURCE
2215 function string_to_double(str) result(rval) 2216 2217 implicit none 2218 2219 real(wp) :: rval 2220 character(len=*),intent(in) :: str 2221 2222 integer :: ierr 2223 2224 if (.not. exception_thrown) then 2225 2226 read(str,fmt=real_fmt,iostat=ierr) rval !string to double 2227 2228 if (ierr/=0) then !if there was an error 2229 rval = 0.0_wp 2230 call throw_exception('Error in string_to_double:'//& 2231 ' string cannot be converted to a double: '//trim(str)) 2232 end if 2233 2234 end if 2235 2236 end function string_to_double
json_module/string_to_integer [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
string_to_integer
DESCRIPTION
Convert a string into an integer.
NOTES
Replacement for the parse_integer function in the original code.
AUTHOR
Jacob Williams : 12/10/2013 : Rewrote routine. Added error checking.
SOURCE
2177 function string_to_integer(str) result(ival) 2178 2179 implicit none 2180 2181 integer :: ival 2182 character(len=*),intent(in) :: str 2183 2184 integer :: ierr 2185 2186 if (.not. exception_thrown) then 2187 2188 read(str,*,iostat=ierr) ival !string to integer 2189 2190 if (ierr/=0) then !if there was an error 2191 ival = 0 2192 call throw_exception('Error in string_to_integer:'//& 2193 ' string cannot be converted to an integer: '//trim(str)) 2194 end if 2195 2196 end if 2197 2198 end function string_to_integer
json_module/throw_exception [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
throw_exception
DESCRIPTION
Throw an exception in the JSON module.
This routine sets the error flag, and prevents any subsequent routine
from doing anything, until json_clear_exceptions is called.
AUTHOR
Jacob Williams : 12/4/2013
SOURCE
902 subroutine throw_exception(msg) 903 904 !use ifcore, only: tracebackqq !Intel routine 905 906 implicit none 907 908 character(len=*),intent(in) :: msg !the error message 909 910 exception_thrown = .true. 911 err_message = trim(msg) 912 913 !if (print_tracebacks) then 914 ! 915 ! !This is a feature of the Intel Fortran Compiler: 916 ! !Throw a traceback and return control to the user. 917 ! call tracebackqq(string=trim(msg), user_exit_code=-1) 918 ! 919 ! !write(*,'(A)') trim(msg) !gfortran version 920 ! !stop 921 ! 922 !end if 923 924 end subroutine throw_exception
json_module/to_array [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
to_array
DESCRIPTION
Change the variable to an array.
AUTHOR
Jacob Williams
SOURCE
3508 subroutine to_array(me,name) 3509 3510 implicit none 3511 3512 type(json_value), intent(inout) :: me 3513 character(len=*),intent(in),optional :: name 3514 3515 !set type and value: 3516 !associate (d => me%data) 3517 call me%data%destroy() 3518 me%data%var_type = json_array 3519 !end associate 3520 3521 !name: 3522 if (present(name)) me%name = trim(name) 3523 3524 end subroutine to_array
json_module/to_integer [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
to_integer
DESCRIPTION
Change the variable to an integer.
AUTHOR
Jacob Williams
SOURCE
3323 subroutine to_integer(me,val,name) 3324 3325 implicit none 3326 3327 type(json_value), intent(inout) :: me 3328 character(len=*),intent(in),optional :: name 3329 integer,intent(in),optional :: val 3330 3331 !set type and value: 3332 !associate (d => me%data) 3333 call me%data%destroy() 3334 me%data%var_type = json_integer 3335 allocate(me%data%int_value) 3336 if (present(val)) then 3337 me%data%int_value = val 3338 else 3339 me%data%int_value = 0 !default value 3340 end if 3341 !end associate 3342 3343 !name: 3344 if (present(name)) me%name = trim(name) 3345 3346 end subroutine to_integer
json_module/to_logical [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
to_logical
DESCRIPTION
Change the variable to a logical.
AUTHOR
Jacob Williams
SOURCE
3283 subroutine to_logical(me,val,name) 3284 3285 implicit none 3286 3287 type(json_value), intent(inout) :: me 3288 character(len=*),intent(in),optional :: name 3289 logical,intent(in),optional :: val 3290 3291 !set type and value: 3292 !associate (d => me%data) 3293 call me%data%destroy() 3294 me%data%var_type = json_logical 3295 allocate(me%data%log_value) 3296 if (present(val)) then 3297 me%data%log_value = val 3298 else 3299 me%data%log_value = .false. !default value 3300 end if 3301 !end associate 3302 3303 !name: 3304 if (present(name)) me%name = trim(name) 3305 3306 end subroutine to_logical
json_module/to_null [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
to_null
DESCRIPTION
Change the variable to a null.
AUTHOR
Jacob Williams
SOURCE
3442 subroutine to_null(me,name) 3443 3444 implicit none 3445 3446 type(json_value), intent(inout) :: me 3447 character(len=*),intent(in),optional :: name 3448 3449 !set type and value: 3450 !associate (d => me%data) 3451 call me%data%destroy() 3452 me%data%var_type = json_null 3453 !end associate 3454 3455 !name: 3456 if (present(name)) me%name = trim(name) 3457 3458 end subroutine to_null
json_module/to_object [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
to_object
DESCRIPTION
Change the variable to an object.
AUTHOR
Jacob Williams
SOURCE
3475 subroutine to_object(me,name) 3476 3477 implicit none 3478 3479 type(json_value), intent(inout) :: me 3480 character(len=*),intent(in),optional :: name 3481 3482 !set type and value: 3483 !associate (d => me%data) 3484 call me%data%destroy() 3485 me%data%var_type = json_object 3486 !end associate 3487 3488 !name: 3489 if (present(name)) me%name = trim(name) 3490 3491 end subroutine to_object
json_module/to_real [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
to_real
DESCRIPTION
Change the variable to a double.
AUTHOR
Jacob Williams
SOURCE
3363 subroutine to_real(me,val,name) 3364 3365 implicit none 3366 3367 type(json_value), intent(inout) :: me 3368 character(len=*),intent(in),optional :: name 3369 real(wp),intent(in),optional :: val 3370 3371 !set type and value: 3372 !associate (d => me%data) 3373 call me%data%destroy() 3374 me%data%var_type = json_real 3375 allocate(me%data%dbl_value) 3376 if (present(val)) then 3377 me%data%dbl_value = val 3378 else 3379 me%data%dbl_value = 0.0_wp !default value 3380 end if 3381 !end associate 3382 3383 !name: 3384 if (present(name)) me%name = trim(name) 3385 3386 end subroutine to_real
json_module/to_string [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
to_string
DESCRIPTION
Change the variable to a string.
AUTHOR
Jacob Williams
SOURCE
3403 subroutine to_string(me,val,name) 3404 3405 implicit none 3406 3407 type(json_value), intent(inout) :: me 3408 character(len=*),intent(in),optional :: name 3409 character(len=*),intent(in),optional :: val 3410 3411 !set type and value: 3412 !associate (d => me%data) 3413 call me%data%destroy() 3414 me%data%var_type = json_string 3415 if (present(val)) then 3416 me%data%str_value = val 3417 else 3418 me%data%str_value = '' !default value 3419 end if 3420 !end associate 3421 3422 !name: 3423 if (present(name)) me%name = trim(name) 3424 3425 end subroutine to_string
json_module/variable_info_in_file [ Functions ]
[ Top ] [ json_module ] [ Functions ]
NAME
variable_info_in_file
USAGE
call me%info(path,found,var_type,n_children)
DESCRIPTION
Returns information about a variable in a file.
AUTHOR
Jacob Williams : 2/3/2014
SOURCE
480 subroutine variable_info_in_file(me,path,found,var_type,n_children) 481 482 implicit none 483 484 class(json_file),intent(inout) :: me 485 character(len=*),intent(in) :: path 486 logical,intent(out) :: found 487 integer,intent(out) :: var_type 488 integer,intent(out) :: n_children 489 490 type(json_value),pointer :: p 491 492 !initialize: 493 nullify(p) 494 495 !get a pointer to the variable (if it is there): 496 call me%get(path,p,found) 497 498 if (found) then 499 500 !get info: 501 call json_info(p,var_type,n_children) 502 503 else 504 505 !set to dummy values: 506 var_type = json_unknown 507 n_children = 0 508 509 end if 510 511 !cleanup: 512 nullify(p) 513 514 end subroutine variable_info_in_file