Skip to content

Commit beefb14

Browse files
jacobwilliamsjacobwilliams
committed
added matrix info routines.
1 parent 499e7c7 commit beefb14

File tree

1 file changed

+123
-25
lines changed

1 file changed

+123
-25
lines changed

‎src/json_value_module.F90

Lines changed: 123 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -506,11 +506,17 @@ module json_value_module
506506
procedure :: MAYBEWRAP(json_value_rename)
507507

508508
!>
509-
! get info about a json_value
509+
! get info about a [[json_value]]
510510
generic,public :: info => json_info, MAYBEWRAP(json_info_by_path)
511511
procedure :: json_info
512512
procedure :: MAYBEWRAP(json_info_by_path)
513513

514+
!>
515+
! get matrix info about a [[json_value]]
516+
generic,public :: matrix_info => json_matrix_info, MAYBEWRAP(json_matrix_info_by_path)
517+
procedure :: json_matrix_info
518+
procedure :: MAYBEWRAP(json_matrix_info_by_path)
519+
514520
procedure,public :: remove => json_value_remove !! Remove a [[json_value]] from a linked-list structure.
515521
procedure,public :: check_for_errors => json_check_for_errors !! check for error and get error message
516522
procedure,public :: clear_exceptions => json_clear_exceptions !! clear exceptions
@@ -1008,32 +1014,25 @@ subroutine json_info_by_path(json,p,path,found,var_type,n_children,name)
10081014
character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name
10091015

10101016
type(json_value),pointer :: p_var
1011-
logical(LK) :: p_var_found
1017+
logical(LK) :: ok
10121018

1013-
nullify(p_var)
1014-
call json%get(p,path,p_var,p_var_found)
1019+
call json%get(p,path,p_var,found)
10151020

10161021
!check if it was found:
10171022
if (present(found)) then
1018-
found = p_var_found
1019-
if (.not. found) then
1020-
if (present(var_type)) var_type = json_unknown
1021-
if (present(n_children)) n_children = 0
1022-
if (present(name)) name = ''
1023-
call json%clear_exceptions()
1024-
return
1025-
end if
1023+
ok = found
10261024
else
1027-
if (json%failed()) then
1028-
if (present(var_type)) var_type = json_unknown
1029-
if (present(n_children)) n_children = 0
1030-
if (present(name)) name = ''
1031-
return
1032-
end if
1025+
ok = .not. json%failed()
10331026
end if
10341027

1035-
!get info:
1036-
call json%info(p_var,var_type,n_children,name)
1028+
if (.not. ok) then
1029+
if (present(var_type)) var_type = json_unknown
1030+
if (present(n_children)) n_children = 0
1031+
if (present(name)) name = ''
1032+
else
1033+
!get info:
1034+
call json%info(p_var,var_type,n_children,name)
1035+
end if
10371036

10381037
end subroutine json_info_by_path
10391038
!*****************************************************************************************
@@ -1096,7 +1095,7 @@ subroutine json_matrix_info(json,p,is_matrix,var_type,n_sets,set_size,name)
10961095
class(json_core),intent(inout) :: json
10971096
type(json_value),pointer :: p !! a JSON linked list
10981097
logical(LK),intent(out) :: is_matrix !! true if it is a valid matrix
1099-
integer(IK),intent(out),optional :: var_type !! variable type (if all elements have the same type)
1098+
integer(IK),intent(out),optional :: var_type !! variable type of data in the matrix (if all elements have the same type)
11001099
integer(IK),intent(out),optional :: n_sets !! number of data sets (i.e., matrix rows if using row-major order)
11011100
integer(IK),intent(out),optional :: set_size !! size of each data set (i.e., matrix cols if using row-major order)
11021101
character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name
@@ -1121,17 +1120,32 @@ subroutine json_matrix_info(json,p,is_matrix,var_type,n_sets,set_size,name)
11211120

11221121
main : do i=1,nr
11231122

1123+
nullify(p_row)
11241124
call json%get_child(p,i,p_row)
1125+
if (.not. associated(p_row)) then
1126+
is_matrix = .false.
1127+
call json%throw_exception('Error in json_matrix_info: '//&
1128+
'Malformed JSON linked list')
1129+
exit main
1130+
end if
11251131
call json%info(p_row,var_type=row_vartype,n_children=icount)
11261132

11271133
if (row_vartype==json_array) then
11281134
if (i==1) nc = icount !number of columns in first row
11291135
if (icount==nc) then !make sure each row has the same number of columns
11301136
!see if all the variables in this row are the same type:
11311137
do j=1,icount
1138+
nullify(p_element)
11321139
call json%get_child(p_row,j,p_element)
1140+
if (.not. associated(p_element)) then
1141+
is_matrix = .false.
1142+
call json%throw_exception('Error in json_matrix_info: '//&
1143+
'Malformed JSON linked list')
1144+
exit main
1145+
end if
11331146
call json%info(p_element,var_type=element_vartype)
1134-
if (i==1 .and. j==1) vartype = element_vartype !type of first element in the row
1147+
if (i==1 .and. j==1) vartype = element_vartype !type of first element
1148+
!in the row
11351149
if (vartype/=element_vartype) then
11361150
!not all variables are the same time
11371151
is_matrix = .false.
@@ -1161,12 +1175,96 @@ subroutine json_matrix_info(json,p,is_matrix,var_type,n_sets,set_size,name)
11611175
if (present(set_size)) set_size = 0
11621176
end if
11631177

1164-
nullify(p_row)
1165-
nullify(p_element)
1166-
11671178
end subroutine json_matrix_info
11681179
!*****************************************************************************************
11691180

1181+
!*****************************************************************************************
1182+
!>
1183+
! Returns matrix information about a [[json_value]], given the path.
1184+
!
1185+
!### See also
1186+
! * [[json_matrix_info]]
1187+
!
1188+
!@note If `found` is present, no exceptions will be thrown if an
1189+
! error occurs. Otherwise, an exception will be thrown if the
1190+
! variable is not found.
1191+
1192+
subroutine json_matrix_info_by_path(json,p,path,is_matrix,found,&
1193+
var_type,n_sets,set_size,name)
1194+
1195+
implicit none
1196+
1197+
class(json_core),intent(inout) :: json
1198+
type(json_value),pointer :: p !! a JSON linked list
1199+
character(kind=CK,len=*),intent(in) :: path !! path to the variable
1200+
logical(LK),intent(out) :: is_matrix !! true if it is a valid matrix
1201+
logical(LK),intent(out),optional :: found !! true if it was found
1202+
integer(IK),intent(out),optional :: var_type !! variable type of data in
1203+
!! the matrix (if all elements have
1204+
!! the same type)
1205+
integer(IK),intent(out),optional :: n_sets !! number of data sets (i.e., matrix
1206+
!! rows if using row-major order)
1207+
integer(IK),intent(out),optional :: set_size !! size of each data set (i.e., matrix
1208+
!! cols if using row-major order)
1209+
character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name
1210+
1211+
type(json_value),pointer :: p_var
1212+
logical(LK) :: ok
1213+
1214+
call json%get(p,path,p_var,found)
1215+
1216+
!check if it was found:
1217+
if (present(found)) then
1218+
ok = found
1219+
else
1220+
ok = .not. json%failed()
1221+
end if
1222+
1223+
if (.not. ok) then
1224+
if (present(var_type)) var_type = json_unknown
1225+
if (present(n_sets)) n_sets = 0
1226+
if (present(set_size)) set_size = 0
1227+
if (present(name)) name = ''
1228+
else
1229+
!get info:
1230+
call json%matrix_info(p_var,is_matrix,var_type,n_sets,set_size,name)
1231+
if (json%failed() .and. present(found)) then
1232+
found = .false.
1233+
call json%clear_exceptions()
1234+
end if
1235+
end if
1236+
1237+
end subroutine json_matrix_info_by_path
1238+
!*****************************************************************************************
1239+
1240+
!*****************************************************************************************
1241+
!>
1242+
! Alternate version of [[json_matrix_info_by_path]] where "path" is kind=CDK.
1243+
1244+
subroutine wrap_json_matrix_info_by_path(json,p,path,is_matrix,found,&
1245+
var_type,n_sets,set_size,name)
1246+
1247+
implicit none
1248+
1249+
class(json_core),intent(inout) :: json
1250+
type(json_value),pointer :: p !! a JSON linked list
1251+
character(kind=CDK,len=*),intent(in) :: path !! path to the variable
1252+
logical(LK),intent(out) :: is_matrix !! true if it is a valid matrix
1253+
logical(LK),intent(out),optional :: found !! true if it was found
1254+
integer(IK),intent(out),optional :: var_type !! variable type of data in
1255+
!! the matrix (if all elements have
1256+
!! the same type)
1257+
integer(IK),intent(out),optional :: n_sets !! number of data sets (i.e., matrix
1258+
!! rows if using row-major order)
1259+
integer(IK),intent(out),optional :: set_size !! size of each data set (i.e., matrix
1260+
!! cols if using row-major order)
1261+
character(kind=CK,len=:),allocatable,intent(out),optional :: name !! variable name
1262+
1263+
call json%matrix_info(p,to_unicode(path),is_matrix,found,var_type,n_sets,set_size,name)
1264+
1265+
end subroutine wrap_json_matrix_info_by_path
1266+
!*****************************************************************************************
1267+
11701268
!*****************************************************************************************
11711269
!> author: Jacob Williams
11721270
! date: 4/29/2016

0 commit comments

Comments
 (0)