-
Notifications
You must be signed in to change notification settings - Fork 2
/
myjson.f90
134 lines (109 loc) · 4.2 KB
/
myjson.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
module myjson_m
use json_m
implicit none
logical :: json_found
contains
!-----------------------------------------------------------------------------------------------------------
real function json_required_real(json,name)
implicit none
type(json_value),intent(in),pointer :: json
character(len=*) :: name
real :: value
call json_get(json, name, value, json_found)
if(json_failed()) then
write(*,*) 'Error: Unable to read required value: ',name
STOP
end if
json_required_real = value
end function json_required_real
!-----------------------------------------------------------------------------------------------------------
real function json_optional_real(json,name,default_value)
implicit none
type(json_value),intent(in),pointer :: json
character(len=*) :: name
real :: value, default_value
call json_get(json, name, value, json_found)
if((.not.json_found) .or. json_failed()) then
write(*,*) trim(name),' set to ',default_value
value = default_value
call json_clear_exceptions()
end if
json_optional_real = value
end function json_optional_real
!-----------------------------------------------------------------------------------------------------------
integer function json_optional_integer(json,name,default_value)
implicit none
type(json_value),intent(in),pointer :: json
character(len=*) :: name
integer :: value, default_value
call json_get(json, name, value, json_found)
if((.not.json_found) .or. json_failed()) then
write(*,*) trim(name),' set to ',default_value
value = default_value
call json_clear_exceptions()
end if
json_optional_integer = value
end function json_optional_integer
!-----------------------------------------------------------------------------------------------------------
real function json_file_required_real(json,name)
implicit none
type(json_file) :: json
character(len=*) :: name
real :: value
call json%get(name, value)
if(json_failed()) then
write(*,*) 'Error: Unable to read required value: ',name
STOP
end if
json_file_required_real = value
end function json_file_required_real
!-----------------------------------------------------------------------------------------------------------
real function json_file_optional_real(json,name,default_value)
implicit none
type(json_file) :: json
character(len=*) :: name
real :: value, default_value
call json%get(name, value)
if(json_failed()) then
write(*,*) name,' set to ',default_value
value = default_value
call json_clear_exceptions()
end if
json_file_optional_real = value
end function json_file_optional_real
!-----------------------------------------------------------------------------------------------------------
integer function json_file_optional_integer(json,name,default_value)
implicit none
type(json_file) :: json
character(len=*) :: name
integer :: value, default_value
call json%get(name, value)
if(json_failed()) then
write(*,*) trim(name),' set to ',default_value
value = default_value
call json_clear_exceptions()
end if
json_file_optional_integer = value
end function json_file_optional_integer
!-----------------------------------------------------------------------------------------------------------
subroutine json_check()
if(json_failed()) then
call print_json_error_message()
STOP
end if
end subroutine json_check
!-----------------------------------------------------------------------------------------------------------
subroutine print_json_error_message()
implicit none
character(len=:),allocatable :: error_msg
logical :: status_ok
!get error message:
call json_check_for_errors(status_ok, error_msg)
!print it if there is one:
if (.not. status_ok) then
write(*,'(A)') error_msg
deallocate(error_msg)
call json_clear_exceptions()
end if
end subroutine print_json_error_message
end module myjson_m