json_get_double Subroutine

private subroutine json_get_double(json, me, value)

Get a double 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_double~~CallsGraph proc~json_get_double json_get_double proc~string_to_real string_to_real proc~json_get_double->proc~string_to_real

Contents

Source Code


Source Code

    subroutine json_get_double(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_double) then
        value = me%dbl_value
    else
        if (json%strict_type_checking) then
            call json%throw_exception('Error in json_get_double:'//&
                                      ' Unable to resolve value to double: '//me%name)
        else
            !type conversions
            select case (me%var_type)
            case (json_integer)
                value = me%int_value
            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,value,status_ok)
                if (.not. status_ok) then
                    value = 0.0_RK
                    call json%throw_exception('Error in json_get_double:'//&
                         ' Unable to convert string value to double: me.'//&
                         me%name//' = '//trim(me%str_value))
                end if
            case default
                call json%throw_exception('Error in json_get_double:'//&
                                          ' Unable to resolve value to double: '//me%name)
            end select
        end if
    end if

    end subroutine json_get_double