Get a real value from a json_value.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(json_core), | intent(inout) | :: | json | |||
type(json_value), | pointer | :: | me | |||
real(kind=RK), | intent(out) | :: | value |
subroutine json_get_real(json, me, value)
implicit none
class(json_core),intent(inout) :: json
type(json_value),pointer :: me
real(RK),intent(out) :: value
logical(LK) :: status_ok !! for [[string_to_real]]
value = 0.0_RK
if ( json%exception_thrown ) return
if (me%var_type == json_real) then
value = me%dbl_value
else
if (json%strict_type_checking) then
if (allocated(me%name)) then
call json%throw_exception('Error in json_get_real:'//&
' Unable to resolve value to real: '//me%name)
else
call json%throw_exception('Error in json_get_real:'//&
' Unable to resolve value to real')
end if
else
!type conversions
select case (me%var_type)
case (json_integer)
value = real(me%int_value, RK)
case (json_logical)
if (me%log_value) then
value = 1.0_RK
else
value = 0.0_RK
end if
case (json_string)
call string_to_real(me%str_value,json%use_quiet_nan,value,status_ok)
if (.not. status_ok) then
value = 0.0_RK
if (allocated(me%name)) then
call json%throw_exception('Error in json_get_real:'//&
' Unable to convert string value to real: '//&
me%name//' = '//trim(me%str_value))
else
call json%throw_exception('Error in json_get_real:'//&
' Unable to convert string value to real: '//&
trim(me%str_value))
end if
end if
case (json_null)
if (ieee_support_nan(value) .and. json%null_to_real_mode/=1_IK) then
select case (json%null_to_real_mode)
case(2_IK)
if (json%use_quiet_nan) then
value = ieee_value(value,ieee_quiet_nan)
else
value = ieee_value(value,ieee_signaling_nan)
end if
case(3_IK)
value = 0.0_RK
end select
else
if (allocated(me%name)) then
call json%throw_exception('Error in json_get_real:'//&
' Cannot convert null to NaN: '//me%name)
else
call json%throw_exception('Error in json_get_real:'//&
' Cannot convert null to NaN')
end if
end if
case default
if (allocated(me%name)) then
call json%throw_exception('Error in json_get_real:'//&
' Unable to resolve value to real: '//me%name)
else
call json%throw_exception('Error in json_get_real:'//&
' Unable to resolve value to real')
end if
end select
end if
end if
end subroutine json_get_real