json_get_real Subroutine

private subroutine json_get_real(json, me, value)

Get a real value from a json_value.

Arguments

Type IntentOptional AttributesName
class(json_core), intent(inout) :: json
type(json_value), pointer:: me
real(kind=RK), intent(out) :: value

Calls

proc~~json_get_real~~CallsGraph proc~json_get_real json_get_real proc~string_to_real string_to_real proc~json_get_real->proc~string_to_real

Contents

Source Code


Source Code

    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
            call json%throw_exception('Error in json_get_real:'//&
                                      ' Unable to resolve value to real: '//me%name)
        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
                    call json%throw_exception('Error in json_get_real:'//&
                         ' Unable to convert string value to real: me.'//&
                         me%name//' = '//trim(me%str_value))
                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
                    call json%throw_exception('Error in json_get_real:'//&
                                              ' Cannot convert null to NaN: '//me%name)
                end if
            case default

                call json%throw_exception('Error in json_get_real:'//&
                                          ' Unable to resolve value to real: '//me%name)
            end select
        end if
    end if

    end subroutine json_get_real