json_matrix_info Subroutine

  1. json_value_module.F90
  2. json_value_module
  3. json_matrix_info

private subroutine json_matrix_info(json, p, is_matrix, var_type, n_sets, set_size, name)

Alternate version of json_info that returns matrix information about a json_value.

A json_value is a valid rank 2 matrix if all of the following are true:

  • The var_type is json_array
  • Each child is also a json_array, each of which has the same number of elements
  • Each individual element has the same variable type (integer, logical, etc.)

The idea here is that if it is a valid matrix, it can be interoperable with a Fortran rank 2 array of the same type.

Example

The following example is an array with var_type=json_integer, n_sets=3, and set_size=4

    {
        "matrix": [
            [1,2,3,4],
            [5,6,7,8],
            [9,10,11,12]
        ]
    }

Arguments

Type IntentOptional AttributesName
class(json_core), intent(inout) :: json
type(json_value), pointer:: p

a JSON linked list
logical(kind=LK), intent(out) :: is_matrix

true if it is a valid matrix
integer(kind=IK), intent(out), optional :: var_type

variable type of data in the matrix (if all elements have the same type)
integer(kind=IK), intent(out), optional :: n_sets

number of data sets (i.e., matrix rows if using row-major order)
integer(kind=IK), intent(out), optional :: set_size

size of each data set (i.e., matrix cols if using row-major order)
character(kind=CK,len=:), intent(out), optional allocatable:: name

variable name

Contents

Source Code

json_matrix_info

Source Code

    subroutine json_matrix_info(json,p,is_matrix,var_type,n_sets,set_size,name)

    implicit none

    class(json_core),intent(inout)   :: json
    type(json_value),pointer         :: p          !! a JSON linked list
    logical(LK),intent(out)          :: is_matrix  !! true if it is a valid matrix
    integer(IK),intent(out),optional :: var_type   !! variable type of data in the matrix
                                                   !! (if all elements have the same type)
    integer(IK),intent(out),optional :: n_sets     !! number of data sets (i.e., matrix
                                                   !! rows if using row-major order)
    integer(IK),intent(out),optional :: set_size   !! size of each data set (i.e., matrix
                                                   !! cols if using row-major order)
    character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name

    type(json_value),pointer :: p_row       !! for getting a set
    type(json_value),pointer :: p_element   !! for getting an element in a set
    integer(IK) :: vartype         !! json variable type of `p`
    integer(IK) :: row_vartype     !! json variable type of a row
    integer(IK) :: element_vartype !! json variable type of an element in a row
    integer(IK) :: nr              !! number of children of `p`
    integer(IK) :: nc              !! number of elements in first child of `p`
    integer(IK) :: icount          !! number of elements in a set
    integer     :: i               !! counter
    integer     :: j               !! counter
#if defined __GFORTRAN__
    character(kind=CK,len=:),allocatable :: p_name  !! temporary variable for getting name
#endif

    !get info about the variable:
#if defined __GFORTRAN__
    call json%info(p,vartype,nr)
    if (present(name)) then !workaround for gfortran bug
        if (allocated(p%name)) then
            p_name = p%name
            name = p_name
        else
            name = CK_''
        end if
    end if
#else
    call json%info(p,vartype,nr,name)
#endif

    is_matrix = (vartype==json_array)

    if (is_matrix) then

        main : do i=1,nr

            nullify(p_row)
            call json%get_child(p,i,p_row)
            if (.not. associated(p_row)) then
                is_matrix = .false.
                call json%throw_exception('Error in json_matrix_info: '//&
                                          'Malformed JSON linked list')
                exit main
            end if
            call json%info(p_row,var_type=row_vartype,n_children=icount)

            if (row_vartype==json_array) then
                if (i==1) nc = icount  !number of columns in first row
                if (icount==nc) then   !make sure each row has the same number of columns
                    !see if all the variables in this row are the same type:
                    do j=1,icount
                        nullify(p_element)
                        call json%get_child(p_row,j,p_element)
                        if (.not. associated(p_element)) then
                            is_matrix = .false.
                            call json%throw_exception('Error in json_matrix_info: '//&
                                                      'Malformed JSON linked list')
                            exit main
                        end if
                        call json%info(p_element,var_type=element_vartype)
                        if (i==1 .and. j==1) vartype = element_vartype  !type of first element
                                                                        !in the row
                        if (vartype/=element_vartype) then
                            !not all variables are the same time
                            is_matrix = .false.
                            exit main
                        end if
                    end do
                else
                    is_matrix = .false.
                    exit main
                end if
            else
                is_matrix = .false.
                exit main
            end if

        end do main

    end if

    if (is_matrix) then
        if (present(var_type)) var_type = vartype
        if (present(n_sets))   n_sets   = nr
        if (present(set_size)) set_size = nc
    else
        if (present(var_type)) var_type = json_unknown
        if (present(n_sets))   n_sets   = 0
        if (present(set_size)) set_size = 0
    end if

    end subroutine json_matrix_info