304 INTEGER(INTG),
INTENT(IN) ::
VALUE 305 INTEGER(INTG),
INTENT(OUT) :: ERR
310 enters(
"MATRIX_ALL_VALUES_SET_INTG",err,error,*999)
312 IF(
ASSOCIATED(matrix))
THEN 313 IF(matrix%MATRIX_FINISHED)
THEN 315 matrix%DATA_INTG=
VALUE 318 &
" does not correspond to the integer data type of the given value." 319 CALL flagerror(local_error,err,error,*999)
322 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
325 CALL flagerror(
"Matrix is not associated.",err,error,*999)
328 exits(
"MATRIX_ALL_VALUES_SET_INTG")
330 999 errorsexits(
"MATRIX_ALL_VALUES_SET_INTG",err,error)
343 REAL(SP),
INTENT(IN) ::
VALUE 344 INTEGER(INTG),
INTENT(OUT) :: ERR
349 enters(
"MATRIX_ALL_VALUES_SET_SP",err,error,*999)
351 IF(
ASSOCIATED(matrix))
THEN 352 IF(matrix%MATRIX_FINISHED)
THEN 357 &
" does not correspond to the single precision data type of the given value." 358 CALL flagerror(local_error,err,error,*999)
361 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
364 CALL flagerror(
"Matrix is not associated.",err,error,*999)
367 exits(
"MATRIX_ALL_VALUES_SET_SP")
369 999 errorsexits(
"MATRIX_ALL_VALUES_SET_SP",err,error)
382 REAL(DP),
INTENT(IN) ::
VALUE 383 INTEGER(INTG),
INTENT(OUT) :: ERR
388 enters(
"MATRIX_ALL_VALUES_SET_DP",err,error,*999)
390 IF(
ASSOCIATED(matrix))
THEN 391 IF(matrix%MATRIX_FINISHED)
THEN 396 &
" does not correspond to the double precision data type of the given value." 397 CALL flagerror(local_error,err,error,*999)
400 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
403 CALL flagerror(
"Matrix is not associated.",err,error,*999)
406 exits(
"MATRIX_ALL_VALUES_SET_DP")
408 999 errorsexits(
"MATRIX_ALL_VALUES_SET_DP",err,error)
421 LOGICAL,
INTENT(IN) ::
VALUE 422 INTEGER(INTG),
INTENT(OUT) :: ERR
427 enters(
"MATRIX_ALL_VALUES_SET_L",err,error,*999)
429 IF(
ASSOCIATED(matrix))
THEN 430 IF(matrix%MATRIX_FINISHED)
THEN 435 &
" does not correspond to the logical data type of the given value." 436 CALL flagerror(local_error,err,error,*999)
439 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
442 CALL flagerror(
"Matrix is not associated.",err,error,*999)
445 exits(
"MATRIX_ALL_VALUES_SET_L")
447 999 errorsexits(
"MATRIX_ALL_VALUES_SET_L",err,error)
460 INTEGER(INTG),
INTENT(OUT) :: ERR
463 INTEGER(INTG) :: column_idx,COUNT,row_idx,row_idx2
466 enters(
"MATRIX_CREATE_FINISH",err,error,*999)
468 IF(
ASSOCIATED(matrix))
THEN 469 IF(matrix%MATRIX_FINISHED)
THEN 470 CALL flagerror(
"Matrix has been finished.",err,error,*999)
472 SELECT CASE(matrix%STORAGE_TYPE)
474 IF(matrix%MAX_M==-1) matrix%MAX_M=matrix%M
475 IF(matrix%MAX_N==-1) matrix%MAX_N=matrix%N
476 matrix%SIZE=matrix%M*matrix%N
477 matrix%NUMBER_NON_ZEROS=matrix%M*matrix%N
478 matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=matrix%N
480 IF(matrix%MAX_M==-1) matrix%MAX_M=matrix%M
481 IF(matrix%MAX_N==-1) matrix%MAX_N=matrix%N
483 matrix%NUMBER_NON_ZEROS=matrix%M
484 matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=1
486 IF(matrix%MAX_M==-1)
CALL flagerror(
"Maximum number of rows has not been set for this matrix.",err,error,*999)
487 IF(matrix%MAX_N==-1)
CALL flagerror(
"Maximum number of columns has not been set for this matrix.",err,error,*999)
488 matrix%SIZE=matrix%MAX_M*matrix%N
489 matrix%NUMBER_NON_ZEROS=matrix%M*matrix%N
490 matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=matrix%N
492 IF(matrix%MAX_M==-1)
CALL flagerror(
"Maximum number of rows has not been set for this matrix.",err,error,*999)
493 IF(matrix%MAX_N==-1)
CALL flagerror(
"Maximum number of columns has not been set for this matrix.",err,error,*999)
494 matrix%SIZE=matrix%M*matrix%MAX_N
495 matrix%NUMBER_NON_ZEROS=matrix%M*matrix%N
496 matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=matrix%N
498 IF(matrix%NUMBER_NON_ZEROS==-1)
CALL flagerror(
"Number of non-zeros has not been set for this matrix.",err,error,*999)
499 IF(matrix%MAX_M==-1) matrix%MAX_M=matrix%M
500 IF(matrix%MAX_N==-1) matrix%MAX_N=matrix%N
501 matrix%SIZE=matrix%NUMBER_NON_ZEROS
502 IF(.NOT.
ALLOCATED(matrix%COLUMN_INDICES)) &
503 &
CALL flagerror(
"Matrix storage locations column indices have not been set.",err,error,*999)
504 IF(.NOT.
ALLOCATED(matrix%ROW_INDICES)) &
505 &
CALL flagerror(
"Matrix storage locations row indices have not been set.",err,error,*999)
506 matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=0
507 DO row_idx=1,matrix%M
508 IF((matrix%ROW_INDICES(row_idx+1)-matrix%ROW_INDICES(row_idx))>matrix%MAXIMUM_COLUMN_INDICES_PER_ROW) &
509 & matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=matrix%ROW_INDICES(row_idx+1)-matrix%ROW_INDICES(row_idx)
512 IF(matrix%NUMBER_NON_ZEROS==-1)
CALL flagerror(
"Number of non-zeros has not been set for this matrix.",err,error,*999)
513 IF(matrix%MAX_M==-1) matrix%MAX_M=matrix%M
514 IF(matrix%MAX_N==-1) matrix%MAX_N=matrix%N
515 matrix%SIZE=matrix%NUMBER_NON_ZEROS
516 IF(.NOT.
ALLOCATED(matrix%COLUMN_INDICES)) &
517 &
CALL flagerror(
"Matrix storage locations column indices have not been set.",err,error,*999)
518 IF(.NOT.
ALLOCATED(matrix%ROW_INDICES)) &
519 &
CALL flagerror(
"Matrix storage locations row indices have not been set.",err,error,*999)
520 matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=0
521 DO row_idx=1,matrix%M
523 DO column_idx=1,matrix%N
524 DO row_idx2=matrix%COLUMN_INDICES(column_idx),matrix%COLUMN_INDICES(column_idx+1)-1
525 IF(matrix%ROW_INDICES(row_idx2)==row_idx) count=count+1
528 IF(count>matrix%MAXIMUM_COLUMN_INDICES_PER_ROW) matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=count
531 IF(matrix%NUMBER_NON_ZEROS==-1)
CALL flagerror(
"Number of non-zeros has not been set for this matrix.",err,error,*999)
532 IF(matrix%MAX_M==-1) matrix%MAX_M=matrix%M
533 IF(matrix%MAX_N==-1) matrix%MAX_N=matrix%N
534 matrix%SIZE=matrix%NUMBER_NON_ZEROS
535 IF(.NOT.
ALLOCATED(matrix%COLUMN_INDICES)) &
536 &
CALL flagerror(
"Matrix storage locations column indices have not been set.",err,error,*999)
537 IF(.NOT.
ALLOCATED(matrix%ROW_INDICES)) &
538 &
CALL flagerror(
"Matrix storage locations row indices have not been set.",err,error,*999)
539 matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=0
540 DO row_idx=1,matrix%M
542 DO row_idx2=1,matrix%NUMBER_NON_ZEROS
543 IF(matrix%ROW_INDICES(row_idx2)==row_idx) count=count+1
545 IF(count>matrix%MAXIMUM_COLUMN_INDICES_PER_ROW) matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=count
548 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))//
" is invalid." 549 CALL flagerror(local_error,err,error,*999)
551 IF(matrix%SIZE>0)
THEN 552 SELECT CASE(matrix%DATA_TYPE)
554 ALLOCATE(matrix%DATA_INTG(matrix%SIZE),stat=err)
555 IF(err/=0)
CALL flagerror(
"Could not allocate matrix integer data.",err,error,*999)
557 ALLOCATE(matrix%DATA_SP(matrix%SIZE),stat=err)
558 IF(err/=0)
CALL flagerror(
"Could not allocate matrix single precision data.",err,error,*999)
560 ALLOCATE(matrix%DATA_DP(matrix%SIZE),stat=err)
561 IF(err/=0)
CALL flagerror(
"Could not allocate matrix double precision data.",err,error,*999)
563 ALLOCATE(matrix%DATA_L(matrix%SIZE),stat=err)
564 IF(err/=0)
CALL flagerror(
"Could not allocate matrix logical data.",err,error,*999)
566 local_error=
"The matrix data type of "//
trim(
number_to_vstring(matrix%DATA_TYPE,
"*",err,error))//
" is invalid." 567 CALL flagerror(local_error,err,error,*999)
572 matrix%MATRIX_FINISHED=.true.
575 CALL flagerror(
"Matrix is not associated.",err,error,*999)
578 exits(
"MATRIX_CREATE_FINISH")
581 999 errorsexits(
"MATRIX_CREATE_FINISH",err,error)
594 INTEGER(INTG),
INTENT(OUT) :: ERR
598 enters(
"MATRIX_CREATE_START",err,error,*999)
600 IF(
ASSOCIATED(matrix))
THEN 601 CALL flagerror(
"Matrix is already associated.",err,error,*998)
603 ALLOCATE(matrix,stat=err)
604 IF(err/=0)
CALL flagerror(
"Could not allocate the matrix.",err,error,*999)
611 exits(
"MATRIX_CREATE_START")
614 998 errorsexits(
"MATRIX_CREATE_START",err,error)
627 INTEGER(INTG),
POINTER :: DATA(:)
628 INTEGER(INTG),
INTENT(OUT) :: ERR
633 enters(
"MATRIX_DATA_GET_INTG",err,error,*999)
635 IF(
ASSOCIATED(matrix))
THEN 636 IF(
ASSOCIATED(data))
THEN 637 CALL flagerror(
"Data is already associated.",err,error,*999)
640 IF(matrix%MATRIX_FINISHED)
THEN 642 data=>matrix%DATA_INTG
645 &
" does not correspond to the integer data type of the requested values." 646 CALL flagerror(local_error,err,error,*999)
649 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
653 CALL flagerror(
"Matrix is not associated.",err,error,*999)
656 exits(
"MATRIX_DATA_GET_INTG")
658 999 errorsexits(
"MATRIX_DATA_GET_INTG",err,error)
671 REAL(SP),
POINTER :: DATA(:)
672 INTEGER(INTG),
INTENT(OUT) :: ERR
677 enters(
"MATRIX_DATA_GET_SP",err,error,*999)
679 IF(
ASSOCIATED(matrix))
THEN 680 IF(
ASSOCIATED(data))
THEN 681 CALL flagerror(
"Data is already associated.",err,error,*999)
684 IF(matrix%MATRIX_FINISHED)
THEN 689 &
" does not correspond to the single precision data type of the requested values." 690 CALL flagerror(local_error,err,error,*999)
693 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
697 CALL flagerror(
"Matrix is not associated.",err,error,*999)
700 exits(
"MATRIX_DATA_GET_SP")
702 999 errorsexits(
"MATRIX_DATA_GET_SP",err,error)
715 REAL(DP),
POINTER :: DATA(:)
716 INTEGER(INTG),
INTENT(OUT) :: ERR
721 enters(
"MATRIX_DATA_GET_DP",err,error,*999)
723 IF(
ASSOCIATED(matrix))
THEN 724 IF(
ASSOCIATED(data))
THEN 725 CALL flagerror(
"Data is already associated.",err,error,*999)
728 IF(matrix%MATRIX_FINISHED)
THEN 733 &
" does not correspond to the double precision data type of the requested values." 734 CALL flagerror(local_error,err,error,*999)
737 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
741 CALL flagerror(
"Matrix is not associated.",err,error,*999)
744 exits(
"MATRIX_DATA_GET_DP")
746 999 errorsexits(
"MATRIX_DATA_GET_DP",err,error)
759 LOGICAL,
POINTER :: DATA(:)
760 INTEGER(INTG),
INTENT(OUT) :: ERR
765 enters(
"MATRIX_DATA_GET_L",err,error,*999)
767 IF(
ASSOCIATED(matrix))
THEN 768 IF(
ASSOCIATED(data))
THEN 769 CALL flagerror(
"Data is already associated.",err,error,*999)
772 IF(matrix%MATRIX_FINISHED)
THEN 777 &
" does not correspond to the logical data type of the requested values." 778 CALL flagerror(local_error,err,error,*999)
781 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
785 CALL flagerror(
"Matrix is not associated.",err,error,*999)
788 exits(
"MATRIX_DATA_GET_L")
790 999 errorsexits(
"MATRIX_DATA_GET_L",err,error)
803 INTEGER(INTG),
INTENT(OUT) :: dataType
804 INTEGER(INTG),
INTENT(OUT) :: err
807 enters(
"Matrix_DataTypeGet",err,error,*999)
809 IF(
ASSOCIATED(matrix))
THEN 810 IF(.NOT.matrix%matrix_finished)
THEN 811 CALL flag_error(
"The matrix has not been finished.",err,error,*999)
813 datatype=matrix%data_type
816 CALL flag_error(
"Matrix is not associated.",err,error,*999)
819 exits(
"Matrix_DataTypeGet")
821 999 errorsexits(
"Matrix_DataTypeGet",err,error)
834 INTEGER(INTG),
INTENT(IN) :: DATA_TYPE
835 INTEGER(INTG),
INTENT(OUT) :: ERR
840 enters(
"MATRIX_DATA_TYPE_SET",err,error,*999)
842 IF(
ASSOCIATED(matrix))
THEN 843 IF(matrix%MATRIX_FINISHED)
THEN 844 CALL flagerror(
"The matrix has been finished.",err,error,*999)
846 SELECT CASE(data_type)
856 local_error=
"The matrix vector data type of "//
trim(
number_to_vstring(data_type,
"*",err,error))//
" is invalid." 857 CALL flagerror(local_error,err,error,*999)
861 CALL flagerror(
"Matrix is not associated.",err,error,*999)
864 exits(
"MATRIX_DATA_TYPE_SET")
866 999 errorsexits(
"MATRIX_DATA_TYPE_SET",err,error)
879 INTEGER(INTG),
INTENT(OUT) :: ERR
882 enters(
"MATRIX_DESTROY",err,error,*999)
884 IF(
ASSOCIATED(matrix))
THEN 887 CALL flagerror(
"Matrix is not associated.",err,error,*999)
890 exits(
"MATRIX_DESTROY")
892 999 errorsexits(
"MATRIX_DESTROY",err,error)
906 INTEGER(INTG),
INTENT(OUT) :: ERR
911 enters(
"MATRIX_DUPLICATE",err,error,*998)
913 IF(
ASSOCIATED(matrix))
THEN 914 IF(
ASSOCIATED(new_matrix))
THEN 915 CALL flagerror(
"New matrix is already associated.",err,error,*998)
921 SELECT CASE(matrix%STORAGE_TYPE)
930 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))//
" is invalid." 931 CALL flagerror(local_error,err,error,*999)
936 CALL flagerror(
"Matrix is not associated.",err,error,*998)
939 exits(
"MATRIX_DUPLICATE")
942 998 errorsexits(
"MATRIX_DUPLICATE",err,error)
955 INTEGER(INTG),
INTENT(OUT) :: ERR
959 enters(
"MATRIX_FINALISE",err,error,*999)
961 IF(
ASSOCIATED(matrix))
THEN 962 IF(
ALLOCATED(matrix%ROW_INDICES))
DEALLOCATE(matrix%ROW_INDICES)
963 IF(
ALLOCATED(matrix%COLUMN_INDICES))
DEALLOCATE(matrix%COLUMN_INDICES)
964 IF(
ALLOCATED(matrix%DATA_INTG))
DEALLOCATE(matrix%DATA_INTG)
965 IF(
ALLOCATED(matrix%DATA_SP))
DEALLOCATE(matrix%DATA_SP)
966 IF(
ALLOCATED(matrix%DATA_DP))
DEALLOCATE(matrix%DATA_DP)
967 IF(
ALLOCATED(matrix%DATA_L))
DEALLOCATE(matrix%DATA_L)
971 exits(
"MATRIX_FINALISE")
973 999 errorsexits(
"MATRIX_FINALISE",err,error)
986 INTEGER(INTG),
INTENT(OUT) :: ERR
990 enters(
"MATRIX_INITIALISE",err,error,*999)
992 IF(
ASSOCIATED(matrix))
THEN 995 matrix%MATRIX_FINISHED=.false.
1001 matrix%STORAGE_TYPE=0
1002 matrix%NUMBER_NON_ZEROS=0
1004 matrix%MAXIMUM_COLUMN_INDICES_PER_ROW=0
1006 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1009 exits(
"MATRIX_INITIALISE")
1011 999 errorsexits(
"MATRIX_INITIALISE",err,error)
1024 INTEGER(INTG),
INTENT(OUT) :: MAX_COLUMNS_PER_ROW
1025 INTEGER(INTG),
INTENT(OUT) :: ERR
1029 enters(
"MATRIX_MAX_COLUMNS_PER_ROW_GET",err,error,*999)
1031 IF(
ASSOCIATED(matrix))
THEN 1032 IF(matrix%MATRIX_FINISHED)
THEN 1033 max_columns_per_row=matrix%MAXIMUM_COLUMN_INDICES_PER_ROW
1035 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
1038 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1041 exits(
"MATRIX_MAX_COLUMNS_PER_ROW_GET")
1043 999 errorsexits(
"MATRIX_MAX_COLUMNS_PER_ROW_GET",err,error)
1056 INTEGER(INTG),
INTENT(IN) :: NUMBER_NON_ZEROS
1057 INTEGER(INTG),
INTENT(OUT) :: ERR
1062 enters(
"MATRIX_NUMBER_NON_ZEROS_SET",err,error,*999)
1064 IF(
ASSOCIATED(matrix))
THEN 1065 IF(matrix%MATRIX_FINISHED)
THEN 1066 CALL flagerror(
"The matrix has already been finished.",err,error,*999)
1068 SELECT CASE(matrix%STORAGE_TYPE)
1070 CALL flagerror(
"Can not set the number of non-zeros for a matrix with block storage.",err,error,*999)
1072 CALL flagerror(
"Can not set the number of non-zeros for a matrix with diagonal storage.",err,error,*999)
1074 CALL flagerror(
"Can not set the number of non-zeros for a matrix with column major storage.",err,error,*999)
1076 CALL flagerror(
"Can not set the number of non-zeros for a matrix with row major storage.",err,error,*999)
1078 IF(number_non_zeros>=0)
THEN 1079 matrix%NUMBER_NON_ZEROS=number_non_zeros
1081 local_error=
"The number of non-zeros ("//
trim(
number_to_vstring(number_non_zeros,
"*",err,error))// &
1082 &
") is invalid. The number must be greater than or equal to zero." 1083 CALL flagerror(local_error,err,error,*999)
1086 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))//
" is invalid." 1087 CALL flagerror(local_error,err,error,*999)
1091 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1094 exits(
"MATRIX_NUMBER_NON_ZEROS_SET")
1096 999 errorsexits(
"MATRIX_NUMBER_NON_ZEROS_SET",err,error)
1109 INTEGER(INTG),
INTENT(OUT) :: NUMBER_NON_ZEROS
1110 INTEGER(INTG),
INTENT(OUT) :: ERR
1115 enters(
"MATRIX_NUMBER_NON_ZEROS_GET",err,error,*999)
1117 IF(
ASSOCIATED(matrix))
THEN 1118 IF(matrix%MATRIX_FINISHED)
THEN 1119 SELECT CASE(matrix%STORAGE_TYPE)
1123 number_non_zeros=matrix%NUMBER_NON_ZEROS
1125 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))//
" is invalid." 1126 CALL flagerror(local_error,err,error,*999)
1129 CALL flagerror(
"The matrix is not finished.",err,error,*999)
1132 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1135 exits(
"MATRIX_NUMBER_NON_ZEROS_GET")
1137 999 errorsexits(
"MATRIX_NUMBER_NON_ZEROS_GET",err,error)
1150 INTEGER(INTG),
INTENT(OUT) :: ERR
1154 enters(
"MATRIX_LINKLIST_SET",err,error,*999)
1156 IF(
ASSOCIATED(matrix))
THEN 1157 IF(matrix%MATRIX_FINISHED)
THEN 1158 CALL flagerror(
"The matrix has been finished",err,error,*999)
1163 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1166 exits(
"MATRIX_LINKLIST_SET")
1168 999 errorsexits(
"MATRIX_LINKLIST_SET",err,error)
1180 INTEGER(INTG),
INTENT(OUT) :: ERR
1184 enters(
"MATRIX_LINKLIST_GET",err,error,*999)
1186 IF(
ASSOCIATED(matrix))
THEN 1187 IF(matrix%MATRIX_FINISHED)
THEN 1190 CALL flagerror(
"The matrix has not been finished",err,error,*999)
1193 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1196 exits(
"MATRIX_LINKLIST_GET")
1198 999 errorsexits(
"MATRIX_LINKLIST_GET",err,error)
1211 INTEGER(INTG),
INTENT(IN) :: MAX_M
1212 INTEGER(INTG),
INTENT(IN) :: MAX_N
1213 INTEGER(INTG),
INTENT(OUT) :: ERR
1218 enters(
"MATRIX_MAX_SIZE_SET",err,error,*999)
1220 IF(
ASSOCIATED(matrix))
THEN 1221 IF(matrix%MATRIX_FINISHED)
THEN 1222 CALL flagerror(
"The matrix has been finished.",err,error,*999)
1226 IF(max_m>=matrix%M)
THEN 1227 IF(max_n>=matrix%N)
THEN 1233 CALL flagerror(local_error,err,error,*999)
1236 local_error=
"The maximum number of matrix columns ("//
trim(
number_to_vstring(max_m,
"*",err,error))// &
1237 &
") must be >= the number of matrix columns ("//
trim(
number_to_vstring(matrix%M,
"*",err,error))//
")." 1238 CALL flagerror(local_error,err,error,*999)
1241 local_error=
"The maximum number of matrix columns of "//
trim(
number_to_vstring(max_n,
"*",err,error))// &
1242 &
" is invalid. The number must be > 0." 1243 CALL flagerror(local_error,err,error,*999)
1246 local_error=
"The maximum number of matrix rows of "//
trim(
number_to_vstring(max_m,
"*",err,error))// &
1247 &
" is invalid. The number must be > 0." 1248 CALL flagerror(local_error,err,error,*999)
1252 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1255 exits(
"MATRIX_MAX_SIZE_SET")
1257 999 errorsexits(
"MATRIX_MAX_SIZE_SET",err,error)
1269 INTEGER(INTG),
INTENT(IN) :: ID
1271 INTEGER(INTG),
INTENT(OUT) :: ERR
1274 INTEGER(INTG) :: i,j
1275 CHARACTER(LEN=9) :: ROW_STRING,COL_STRING
1276 CHARACTER(LEN=39) :: INITIAL_STRING
1279 enters(
"MATRIX_OUTPUT",err,error,*999)
1281 IF(
ASSOCIATED(matrix))
THEN 1282 IF(matrix%MATRIX_FINISHED)
THEN 1283 SELECT CASE(matrix%STORAGE_TYPE)
1285 SELECT CASE(matrix%DATA_TYPE)
1287 CALL write_string_matrix(id,1,1,matrix%M,1,1,matrix%N,8,8,reshape(matrix%DATA_INTG,(/matrix%MAX_M,matrix%MAX_N/)), &
1288 &
write_string_matrix_name_and_indices,
'("Matrix',
'(",I9,",:)',
':",8(X,I13))',
'(20X,8(X,I13))', &
1291 CALL write_string_matrix(id,1,1,matrix%M,1,1,matrix%N,8,8,reshape(matrix%DATA_SP,(/matrix%MAX_M,matrix%MAX_N/)), &
1292 &
write_string_matrix_name_and_indices,
'("Matrix',
'(",I9,",:)',
':",8(X,E13.6))',
'(20X,8(X,E13.6))', &
1295 CALL write_string_matrix(id,1,1,matrix%M,1,1,matrix%N,8,8,reshape(matrix%DATA_DP,(/matrix%MAX_M,matrix%MAX_N/)), &
1296 &
write_string_matrix_name_and_indices,
'("Matrix',
'(",I9,",:)',
':",8(X,E13.6))',
'(20X,8(X,E13.6))', &
1299 CALL write_string_matrix(id,1,1,matrix%M,1,1,matrix%N,8,8,reshape(matrix%DATA_L,(/matrix%MAX_M,matrix%MAX_N/)), &
1300 &
write_string_matrix_name_and_indices,
'("Matrix',
'(",I9,",:)',
':",8(X,L13))',
'(20X,8(X,L13))', &
1303 local_error=
"The matrix data type of "//
trim(
number_to_vstring(matrix%DATA_TYPE,
"*",err,error))//
" is invalid." 1304 CALL flagerror(local_error,err,error,*999)
1307 CALL flagerror(
"Not implemented.",err,error,*999)
1309 CALL flagerror(
"Not implemented.",err,error,*999)
1311 CALL flagerror(
"Not implemented.",err,error,*999)
1315 SELECT CASE(matrix%DATA_TYPE)
1317 initial_string=
'("Matrix('//row_string//
',:):",8(X,I13))' 1318 CALL write_string_vector(id,matrix%ROW_INDICES(i),1,matrix%ROW_INDICES(i+1)-1,8,8,matrix%DATA_INTG,initial_string, &
1319 &
'(20X,8(X,I13))',err,error,*999)
1321 initial_string=
'("Matrix('//row_string//
',:):",8(X,E13.6))' 1322 CALL write_string_vector(id,matrix%ROW_INDICES(i),1,matrix%ROW_INDICES(i+1)-1,8,8,matrix%DATA_SP,initial_string, &
1323 &
'(20X,8(X,E13.6))',err,error,*999)
1325 initial_string=
'("Matrix('//row_string//
',:):",8(X,E13.6))' 1326 CALL write_string_vector(id,matrix%ROW_INDICES(i),1,matrix%ROW_INDICES(i+1)-1,8,8,matrix%DATA_DP,initial_string, &
1327 &
'(20X,8(X,E13.6))',err,error,*999)
1329 initial_string=
'("Matrix('//row_string//
',:):",8(X,L13))' 1330 CALL write_string_vector(id,matrix%ROW_INDICES(i),1,matrix%ROW_INDICES(i+1)-1,8,8,matrix%DATA_L,initial_string, &
1331 &
'(20X,8(X,L13))',err,error,*999)
1333 local_error=
"The matrix data type of "//
trim(
number_to_vstring(matrix%DATA_TYPE,
"*",err,error))//
" is invalid." 1334 CALL flagerror(local_error,err,error,*999)
1340 SELECT CASE(matrix%DATA_TYPE)
1342 initial_string=
'("Matrix(:,'//col_string//
'):",8(X,I13))' 1343 CALL write_string_vector(id,matrix%COLUMN_INDICES(j),1,matrix%COLUMN_INDICES(j+1)-1,8,8,matrix%DATA_INTG, &
1344 & initial_string,
'(20X,8(X,I13))',err,error,*999)
1346 initial_string=
'("Matrix(:,'//col_string//
'):",8(X,E13.6))' 1347 CALL write_string_vector(id,matrix%COLUMN_INDICES(j),1,matrix%COLUMN_INDICES(j+1)-1,8,8,matrix%DATA_SP, &
1348 & initial_string,
'(20X,8(X,E13.6))',err,error,*999)
1350 initial_string=
'("Matrix(:,'//col_string//
'):",8(X,E13.6))' 1351 CALL write_string_vector(id,matrix%COLUMN_INDICES(j),1,matrix%COLUMN_INDICES(j+1)-1,8,8,matrix%DATA_DP, &
1352 & initial_string,
'(20X,8(X,E13.6))',err,error,*999)
1354 initial_string=
'("Matrix(:,'//col_string//
'):",8(X,L13))' 1355 CALL write_string_vector(id,matrix%COLUMN_INDICES(j),1,matrix%COLUMN_INDICES(j+1)-1,8,8,matrix%DATA_L, &
1356 & initial_string,
'(20X,8(X,L13))',err,error,*999)
1358 local_error=
"The matrix data type of "//
trim(
number_to_vstring(matrix%DATA_TYPE,
"*",err,error))//
" is invalid." 1359 CALL flagerror(local_error,err,error,*999)
1363 CALL flagerror(
"Not implemented.",err,error,*999)
1365 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))//
" is invalid." 1366 CALL flagerror(local_error,err,error,*999)
1369 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
1372 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1375 exits(
"MATRIX_OUTPUT")
1377 999 errorsexits(
"MATRIX_OUTPUT",err,error)
1390 INTEGER(INTG),
INTENT(IN) :: M
1391 INTEGER(INTG),
INTENT(IN) :: N
1392 INTEGER(INTG),
INTENT(OUT) :: ERR
1397 enters(
"MATRIX_SIZE_SET",err,error,*999)
1399 IF(
ASSOCIATED(matrix))
THEN 1400 IF(matrix%MATRIX_FINISHED)
THEN 1401 CALL flagerror(
"The matrix has been finished.",err,error,*999)
1409 &
" is invalid. The number must be >0." 1410 CALL flagerror(local_error,err,error,*999)
1414 &
" is invalid. The number must be >0." 1415 CALL flagerror(local_error,err,error,*999)
1419 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1422 exits(
"MATRIX_SIZE_SET")
1424 999 errorsexits(
"MATRIX_SIZE_SET",err,error)
1437 INTEGER(INTG),
INTENT(IN) :: I
1438 INTEGER(INTG),
INTENT(IN) :: J
1439 INTEGER(INTG),
INTENT(OUT) :: LOCATION
1440 INTEGER(INTG),
INTENT(OUT) :: ERR
1443 INTEGER(INTG) :: k,LOWLIMIT,MIDPOINT,UPLIMIT
1444 LOGICAL :: FOUNDCOLUMN, FOUNDROW
1447 enters(
"MATRIX_STORAGE_LOCATION_FIND",err,error,*999)
1450 IF(
ASSOCIATED(matrix))
THEN 1451 IF(matrix%MATRIX_FINISHED)
THEN 1452 IF(i<1.OR.i>matrix%M)
THEN 1453 local_error=
"Row number "//
trim(
number_to_vstring(i,
"*",err,error))//
" is outside the matrix range of 1 to "// &
1455 CALL flagerror(local_error,err,error,*999)
1457 IF(j<1.OR.j>matrix%N)
THEN 1458 local_error=
"Column number "//
trim(
number_to_vstring(j,
"*",err,error))//
" is outside the matrix range of 1 to "// &
1460 CALL flagerror(local_error,err,error,*999)
1463 SELECT CASE(matrix%STORAGE_TYPE)
1465 location=i+(j-1)*matrix%M
1469 location=i+(j-1)*matrix%MAX_M
1471 location=(i-1)*matrix%MAX_N+j
1474 lowlimit=matrix%ROW_INDICES(i)
1475 IF(j>=matrix%COLUMN_INDICES(lowlimit))
THEN 1476 uplimit=matrix%ROW_INDICES(i+1)
1477 IF(uplimit>lowlimit)
THEN 1478 IF(j<=matrix%COLUMN_INDICES(uplimit-1))
THEN 1480 midpoint=(uplimit+lowlimit)/2
1481 IF(matrix%COLUMN_INDICES(midpoint)>j)
THEN 1487 DO k=lowlimit,uplimit
1488 IF(matrix%COLUMN_INDICES(k)==j)
THEN 1498 lowlimit=matrix%COLUMN_INDICES(j)
1499 IF(i>=matrix%ROW_INDICES(lowlimit))
THEN 1500 uplimit=matrix%COLUMN_INDICES(j+1)
1501 IF(uplimit>lowlimit)
THEN 1502 IF(i<=matrix%ROW_INDICES(uplimit-1))
THEN 1503 DO WHILE((uplimit-lowlimit)>1)
1504 midpoint=(uplimit+lowlimit)/2
1505 IF(matrix%ROW_INDICES(midpoint)>i)
THEN 1511 IF(matrix%ROW_INDICES(lowlimit)==i) location=lowlimit
1513 midpoint=(uplimit+lowlimit)/2
1514 IF(matrix%ROW_INDICES(midpoint)>i)
THEN 1520 DO k=lowlimit,uplimit
1521 IF(matrix%ROW_INDICES(k)==i)
THEN 1532 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
1533 IF(matrix%ROW_INDICES(location)==i)
THEN 1534 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
1535 IF(matrix%COLUMN_INDICES(location)==j.AND.matrix%ROW_INDICES(location)==i)
THEN 1537 ELSE IF(matrix%ROW_INDICES(location)/=i)
THEN 1538 location=matrix%SIZE+1
1547 IF(.NOT.(foundrow.AND.foundcolumn)) location=0
1549 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))//
" is invalid." 1550 CALL flagerror(local_error,err,error,*999)
1553 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
1556 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1559 exits(
"MATRIX_STORAGE_LOCATION_FIND")
1561 999 errorsexits(
"MATRIX_STORAGE_LOCATION_FIND",err,error)
1574 INTEGER(INTG),
POINTER :: ROW_INDICES(:)
1575 INTEGER(INTG),
POINTER :: COLUMN_INDICES(:)
1576 INTEGER(INTG),
INTENT(OUT) :: ERR
1581 enters(
"MATRIX_STORAGE_LOCATIONS_GET",err,error,*999)
1583 IF(
ASSOCIATED(matrix))
THEN 1584 IF(matrix%MATRIX_FINISHED)
THEN 1585 SELECT CASE(matrix%STORAGE_TYPE)
1587 CALL flagerror(
"Can not get matrix locations for a block storage matrix.",err,error,*999)
1589 CALL flagerror(
"Can not get matrix locations for a diagonal storage matrix.",err,error,*999)
1591 CALL flagerror(
"Can not get matrix locations for a column major storage matrix.",err,error,*999)
1593 CALL flagerror(
"Can not get matrix locations for a row major storage matrix.",err,error,*999)
1595 row_indices=>matrix%ROW_INDICES
1596 column_indices=>matrix%COLUMN_INDICES
1598 row_indices=>matrix%ROW_INDICES
1599 column_indices=>matrix%COLUMN_INDICES
1601 row_indices=>matrix%ROW_INDICES
1602 column_indices=>matrix%COLUMN_INDICES
1604 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))//
" is invalid." 1605 CALL flagerror(local_error,err,error,*999)
1608 CALL flagerror(
"Matrix has not been finished.",err,error,*999)
1611 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1614 exits(
"MATRIX_STORAGE_LOCATIONS_GET")
1616 999 errorsexits(
"MATRIX_STORAGE_LOCATIONS_GET",err,error)
1629 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
1630 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
1631 INTEGER(INTG),
INTENT(OUT) :: ERR
1634 INTEGER(INTG) :: i,j,k
1637 enters(
"MATRIX_STORAGE_LOCATIONS_SET",err,error,*999)
1639 IF(
ASSOCIATED(matrix))
THEN 1640 IF(matrix%MATRIX_FINISHED)
THEN 1641 CALL flagerror(
"Matrix has been finished.",err,error,*999)
1643 SELECT CASE(matrix%STORAGE_TYPE)
1645 CALL flagerror(
"Can not set matrix locations for a block storage matrix.",err,error,*999)
1647 CALL flagerror(
"Can not set matrix locations for a diagonal storage matrix.",err,error,*999)
1649 CALL flagerror(
"Can not set matrix locations for a column major storage matrix.",err,error,*999)
1651 CALL flagerror(
"Can not set matrix locations for a row major storage matrix.",err,error,*999)
1653 IF(
SIZE(row_indices,1)==matrix%M+1)
THEN 1654 IF(
SIZE(column_indices,1)==matrix%NUMBER_NON_ZEROS)
THEN 1655 IF(row_indices(1)==1)
THEN 1656 IF(row_indices(matrix%M+1)==matrix%NUMBER_NON_ZEROS+1)
THEN 1658 IF(row_indices(i)<row_indices(i-1))
THEN 1659 local_error=
"Invalid row indices. Row "//
trim(
number_to_vstring(i,
"*",err,error))//
" index number ("// &
1663 CALL flagerror(local_error,err,error,*999)
1667 DO j=row_indices(i),row_indices(i+1)-1
1671 local_error=
"Invalid column indices. Column index "//
trim(
number_to_vstring(j,
"*",err,error))//
" ("// &
1674 CALL flagerror(local_error,err,error,*999)
1677 local_error=
"Invalid column indices. Column index "//
trim(
number_to_vstring(j,
"*",err,error))//
" ("// &
1679 CALL flagerror(local_error,err,error,*999)
1683 IF(
ALLOCATED(matrix%ROW_INDICES))
DEALLOCATE(matrix%ROW_INDICES)
1684 IF(
ALLOCATED(matrix%COLUMN_INDICES))
DEALLOCATE(matrix%COLUMN_INDICES)
1685 ALLOCATE(matrix%ROW_INDICES(matrix%M+1),stat=err)
1686 IF(err/=0)
CALL flagerror(
"Could not allocate matrix row indices.",err,error,*999)
1687 ALLOCATE(matrix%COLUMN_INDICES(matrix%NUMBER_NON_ZEROS),stat=err)
1688 IF(err/=0)
CALL flagerror(
"Could not allocate matrix column indices.",err,error,*999)
1689 matrix%ROW_INDICES(1:matrix%M+1)=row_indices(1:matrix%M+1)
1690 matrix%COLUMN_INDICES(1:matrix%NUMBER_NON_ZEROS)=column_indices(1:matrix%NUMBER_NON_ZEROS)
1696 local_error=
"Invalid row indices. The last row index ("// &
1698 &
") does not equal the number of non-zeros + 1 ("// &
1700 CALL flagerror(local_error,err,error,*999)
1703 local_error=
"Invalid row indices. The first row index ("// &
1705 CALL flagerror(local_error,err,error,*999)
1708 local_error=
"The supplied number of column indices ("// &
1710 &
") does not match the number of non-zeros in the matrix ("// &
1712 CALL flagerror(local_error,err,error,*999)
1715 local_error=
"The supplied number of row indices ("//
trim(
number_to_vstring(
SIZE(row_indices,1),
"*",err,error))// &
1716 &
") does not match the number of rows in the matrix + 1 ("// &
1718 CALL flagerror(local_error,err,error,*999)
1721 IF(
SIZE(column_indices,1)==matrix%N+1)
THEN 1722 IF(
SIZE(row_indices,1)==matrix%NUMBER_NON_ZEROS)
THEN 1723 IF(column_indices(1)==1)
THEN 1724 IF(column_indices(matrix%N+1)==matrix%NUMBER_NON_ZEROS+1)
THEN 1725 IF(column_indices(1)/=1)
THEN 1726 local_error=
"Invalid column indices. Column index 1 ("// &
1728 &
" should be equal to one." 1729 CALL flagerror(local_error,err,error,*999)
1732 IF(column_indices(j)<column_indices(j-1))
THEN 1734 &
" index number ("//
trim(
number_to_vstring(column_indices(j),
"*",err,error))//
") is less than column "// &
1737 CALL flagerror(local_error,err,error,*999)
1739 IF(column_indices(j)<0.OR.column_indices(j)>matrix%NUMBER_NON_ZEROS+1)
THEN 1740 local_error=
"Invalid column indices. Column index "//
trim(
number_to_vstring(j,
"*",err,error))//
" ("// &
1742 &
" should be in the range of one to the number of non-zeros + 1 ("// &
1744 CALL flagerror(local_error,err,error,*999)
1748 DO i=column_indices(j),column_indices(j+1)-1
1755 CALL flagerror(local_error,err,error,*999)
1760 CALL flagerror(local_error,err,error,*999)
1764 IF(
ALLOCATED(matrix%ROW_INDICES))
DEALLOCATE(matrix%ROW_INDICES)
1765 IF(
ALLOCATED(matrix%COLUMN_INDICES))
DEALLOCATE(matrix%COLUMN_INDICES)
1766 ALLOCATE(matrix%ROW_INDICES(matrix%NUMBER_NON_ZEROS),stat=err)
1767 IF(err/=0)
CALL flagerror(
"Could not allocate matrix row indices.",err,error,*999)
1768 ALLOCATE(matrix%COLUMN_INDICES(matrix%N+1),stat=err)
1769 IF(err/=0)
CALL flagerror(
"Could not allocate matrix column indices.",err,error,*999)
1770 matrix%ROW_INDICES(1:matrix%NUMBER_NON_ZEROS)=row_indices(1:matrix%NUMBER_NON_ZEROS)
1771 matrix%COLUMN_INDICES(1:matrix%N+1)=column_indices(1:matrix%N+1)
1777 local_error=
"Invalid column indices. The last column index ("// &
1779 &
") does not equal the number of non-zeros + 1 ("// &
1781 CALL flagerror(local_error,err,error,*999)
1784 local_error=
"Invalid column indices. The first column index ("// &
1786 CALL flagerror(local_error,err,error,*999)
1789 local_error=
"The supplied number of row indices ("// &
1791 &
") does not match the number of non-zeros in the matrix ("// &
1793 CALL flagerror(local_error,err,error,*999)
1796 local_error=
"The supplied number of column indices ("// &
1798 &
") does not match the number of columns in the matrix + 1 ("// &
1800 CALL flagerror(local_error,err,error,*999)
1803 IF(
SIZE(row_indices,1)==matrix%NUMBER_NON_ZEROS)
THEN 1804 IF(
SIZE(column_indices,1)==matrix%NUMBER_NON_ZEROS)
THEN 1805 DO k=1,matrix%NUMBER_NON_ZEROS
1806 IF(row_indices(k)<1.OR.row_indices(k)>matrix%M)
THEN 1807 local_error=
"Invalid row indices. Row index number "//
trim(
number_to_vstring(k,
"*",err,error))//
" ("// &
1809 &
") is out of range. The row index must be between 1 and "// &
1811 CALL flagerror(local_error,err,error,*999)
1812 ELSE IF(column_indices(k)<1.OR.column_indices(k)>matrix%N)
THEN 1813 local_error=
"Invalid column indices. Column index number "//
trim(
number_to_vstring(k,
"*",err,error))//
" ("// &
1815 &
") is out of range. The column index must be between 1 and "// &
1817 CALL flagerror(local_error,err,error,*999)
1820 matrix%ROW_INDICES(1:matrix%NUMBER_NON_ZEROS)=row_indices(1:matrix%NUMBER_NON_ZEROS)
1821 matrix%COLUMN_INDICES(1:matrix%NUMBER_NON_ZEROS)=column_indices(1:matrix%NUMBER_NON_ZEROS)
1824 local_error=
"The supplied number of column indices ("// &
1826 &
") does not match the number of non-zeros in the matrix ("// &
1828 CALL flagerror(local_error,err,error,*999)
1831 local_error=
"The supplied number of row indices ("// &
1833 &
") does not match the number of non-zeros in the matrix ("// &
1835 CALL flagerror(local_error,err,error,*999)
1838 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))//
" is invalid." 1839 CALL flagerror(local_error,err,error,*999)
1843 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1846 exits(
"MATRIX_STORAGE_LOCATIONS_SET")
1848 999 errorsexits(
"MATRIX_STORAGE_LOCATIONS_SET",err,error)
1861 INTEGER(INTG),
INTENT(OUT) :: STORAGE_TYPE
1862 INTEGER(INTG),
INTENT(OUT) :: ERR
1866 enters(
"MATRIX_STORAGE_TYPE_GET",err,error,*999)
1868 IF(
ASSOCIATED(matrix))
THEN 1869 IF(matrix%MATRIX_FINISHED)
THEN 1870 storage_type=matrix%STORAGE_TYPE
1872 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
1875 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1878 exits(
"MATRIX_STORAGE_TYPE_GET")
1880 999 errorsexits(
"MATRIX_STORAGE_TYPE_GET",err,error)
1893 INTEGER(INTG),
INTENT(IN) :: STORAGE_TYPE
1894 INTEGER(INTG),
INTENT(OUT) :: ERR
1899 enters(
"MATRIX_STORAGE_TYPE_SET",err,error,*999)
1901 IF(
ASSOCIATED(matrix))
THEN 1902 IF(matrix%MATRIX_FINISHED)
THEN 1903 CALL flagerror(
"The matrix has been finished.",err,error,*999)
1905 SELECT CASE(storage_type)
1921 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(storage_type,
"*",err,error))//
" is invalid." 1922 CALL flagerror(local_error,err,error,*999)
1926 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1929 exits(
"MATRIX_STORAGE_TYPE_SET")
1931 999 errorsexits(
"MATRIX_STORAGE_TYPE_SET",err,error)
1944 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
1945 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
1946 INTEGER(INTG),
INTENT(IN) :: VALUES(:)
1947 INTEGER(INTG),
INTENT(OUT) :: ERR
1950 INTEGER(INTG) :: k,LOCATION
1953 enters(
"MATRIX_VALUES_ADD_INTG",err,error,*999)
1955 IF(
ASSOCIATED(matrix))
THEN 1956 IF(matrix%MATRIX_FINISHED)
THEN 1957 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 1958 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 1960 DO k=1,
SIZE(row_indices,1)
1962 IF(location==0)
THEN 1965 CALL flagerror(local_error,err,error,*999)
1967 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+values(k)
1972 &
" does not correspond to the integer data type of the given values." 1973 CALL flagerror(local_error,err,error,*999)
1976 local_error=
"The size of the column indices array ("// &
1978 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 1979 CALL flagerror(local_error,err,error,*999)
1982 local_error=
"The size of the row indices array ("// &
1984 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 1985 CALL flagerror(local_error,err,error,*999)
1988 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
1991 CALL flagerror(
"Matrix is not associated.",err,error,*999)
1994 exits(
"MATRIX_VALUES_ADD_INTG")
1996 999 errorsexits(
"MATRIX_VALUES_ADD_INTG",err,error)
2009 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
2010 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
2011 INTEGER(INTG),
INTENT(IN) ::
VALUE 2012 INTEGER(INTG),
INTENT(OUT) :: ERR
2015 INTEGER(INTG) :: LOCATION
2018 enters(
"MATRIX_VALUES_ADD_INTG1",err,error,*999)
2020 IF(
ASSOCIATED(matrix))
THEN 2021 IF(matrix%MATRIX_FINISHED)
THEN 2024 IF(location==0)
THEN 2027 CALL flagerror(local_error,err,error,*999)
2029 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+
VALUE 2033 &
" does not correspond to the integer data type of the given value." 2034 CALL flagerror(local_error,err,error,*999)
2037 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
2040 CALL flagerror(
"Matrix is not associated.",err,error,*999)
2043 exits(
"MATRIX_VALUES_ADD_INTG1")
2045 999 errorsexits(
"MATRIX_VALUES_ADD_INTG1",err,error)
2058 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
2059 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
2060 INTEGER(INTG),
INTENT(IN) :: VALUES(:,:)
2061 INTEGER(INTG),
INTENT(OUT) :: ERR
2064 INTEGER(INTG) :: i,j,k,ROW_INDEX,PREVIOUS_ROW_INDEX,COLUMN_INDEX,PREVIOUS_COLUMN_INDEX,LOCATION,LOWLIMIT,MIDPOINT,UPLIMIT
2065 LOGICAL :: FOUNDCOLUMN, FOUNDROW
2068 enters(
"MATRIX_VALUES_ADD_INTG2",err,error,*999)
2070 IF(
ASSOCIATED(matrix))
THEN 2071 IF(matrix%MATRIX_FINISHED)
THEN 2072 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 2073 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 2075 SELECT CASE(matrix%STORAGE_TYPE)
2077 DO j=1,
SIZE(column_indices,1)
2078 column_index=column_indices(j)
2079 DO i=1,
SIZE(row_indices,1)
2080 row_index=row_indices(i)
2081 location=row_index+(column_index-1)*matrix%M
2082 IF(location==0)
THEN 2085 CALL flagerror(local_error,err,error,*999)
2087 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+values(i,j)
2092 DO i=1,
SIZE(row_indices,1)
2093 row_index=row_indices(i)
2094 DO j=1,
SIZE(column_indices,1)
2096 column_index=column_indices(j)
2097 IF(row_index==column_index) location=row_index
2098 IF(location==0)
THEN 2101 CALL flagerror(local_error,err,error,*999)
2103 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+values(i,j)
2108 DO j=1,
SIZE(column_indices,1)
2109 column_index=column_indices(j)
2110 DO i=1,
SIZE(row_indices,1)
2111 row_index=row_indices(i)
2112 location=row_index+(column_index-1)*matrix%MAX_M
2113 IF(location==0)
THEN 2116 CALL flagerror(local_error,err,error,*999)
2118 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+values(i,j)
2123 DO i=1,
SIZE(row_indices,1)
2124 row_index=row_indices(i)
2125 DO j=1,
SIZE(column_indices,1)
2126 column_index=column_indices(j)
2127 location=(row_index-1)*matrix%MAX_N+column_index
2128 IF(location==0)
THEN 2131 CALL flagerror(local_error,err,error,*999)
2133 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+values(i,j)
2139 previous_column_index=-1
2140 DO i=1,
SIZE(row_indices,1)
2141 row_index=row_indices(i)
2142 lowlimit=matrix%ROW_INDICES(row_index)
2143 uplimit=matrix%ROW_INDICES(row_index+1)
2144 DO j=1,
SIZE(column_indices,1)
2146 column_index=column_indices(j)
2147 IF(column_index<=previous_column_index)
THEN 2148 lowlimit=matrix%ROW_INDICES(row_index)
2150 uplimit=matrix%ROW_INDICES(row_index+1)
2152 previous_column_index=column_index
2154 midpoint=(uplimit+lowlimit)/2
2155 IF(matrix%COLUMN_INDICES(midpoint)>column_index)
THEN 2161 DO k=lowlimit,uplimit
2162 IF(matrix%COLUMN_INDICES(k)==column_index)
THEN 2168 IF(location==0)
THEN 2171 CALL flagerror(local_error,err,error,*999)
2173 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+values(i,j)
2179 previous_row_index=-1
2180 DO j=1,
SIZE(column_indices,1)
2181 column_index=column_indices(j)
2182 lowlimit=matrix%COLUMN_INDICES(column_index)
2183 uplimit=matrix%COLUMN_INDICES(column_index+1)
2184 DO i=1,
SIZE(row_indices,1)
2186 row_index=row_indices(i)
2187 IF(row_index<=previous_row_index)
THEN 2188 lowlimit=matrix%COLUMN_INDICES(column_index)
2190 uplimit=matrix%COLUMN_INDICES(column_index+1)
2192 previous_row_index=row_index
2194 midpoint=(uplimit+lowlimit)/2
2195 IF(matrix%ROW_INDICES(midpoint)>row_index)
THEN 2201 DO k=lowlimit,uplimit
2202 IF(matrix%ROW_INDICES(k)==row_index)
THEN 2208 IF(location==0)
THEN 2211 CALL flagerror(local_error,err,error,*999)
2213 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+values(i,j)
2218 DO i=1,
SIZE(row_indices,1)
2219 row_index=row_indices(i)
2220 DO j=1,
SIZE(column_indices,1)
2221 column_index=column_indices(j)
2224 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
2225 IF(matrix%ROW_INDICES(location)==row_index)
THEN 2226 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
2227 IF(matrix%COLUMN_INDICES(location)==column_index.AND.matrix%ROW_INDICES(location)==row_index)
THEN 2229 ELSE IF(matrix%ROW_INDICES(location)/=row_index)
THEN 2230 location=matrix%SIZE+1
2239 IF(.NOT.(foundrow.AND.foundcolumn)) location=0
2240 IF(location==0)
THEN 2243 CALL flagerror(local_error,err,error,*999)
2245 matrix%DATA_INTG(location)=matrix%DATA_INTG(location)+values(i,j)
2250 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))// &
2252 CALL flagerror(local_error,err,error,*999)
2256 &
" does not correspond to the integer data type of the given values." 2257 CALL flagerror(local_error,err,error,*999)
2260 local_error=
"The size of the column indices array ("// &
2262 &
") does not conform to the number of columns in the values array ("// &
2264 CALL flagerror(local_error,err,error,*999)
2267 local_error=
"The size of the row indices array ("// &
2269 &
") does not conform to the number of rows the values array ("// &
2271 CALL flagerror(local_error,err,error,*999)
2274 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
2277 CALL flagerror(
"Matrix is not associated.",err,error,*999)
2280 exits(
"MATRIX_VALUES_ADD_INTG2")
2282 999 errorsexits(
"MATRIX_VALUES_ADD_INTG2",err,error)
2295 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
2296 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
2297 REAL(SP),
INTENT(IN) :: VALUES(:)
2298 INTEGER(INTG),
INTENT(OUT) :: ERR
2301 INTEGER(INTG) :: k,LOCATION
2304 enters(
"MATRIX_VALUES_ADD_SP",err,error,*999)
2306 IF(
ASSOCIATED(matrix))
THEN 2307 IF(matrix%MATRIX_FINISHED)
THEN 2308 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 2309 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 2311 DO k=1,
SIZE(row_indices,1)
2313 IF(location==0)
THEN 2316 CALL flagerror(local_error,err,error,*999)
2318 matrix%DATA_SP(location)=matrix%DATA_SP(location)+values(k)
2323 &
" does not correspond to the single precision data type of the given values." 2324 CALL flagerror(local_error,err,error,*999)
2327 local_error=
"The size of the column indices array ("// &
2329 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 2330 CALL flagerror(local_error,err,error,*999)
2333 local_error=
"The size of the row indices array ("// &
2335 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 2336 CALL flagerror(local_error,err,error,*999)
2339 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
2342 CALL flagerror(
"Matrix is not associated.",err,error,*999)
2345 exits(
"MATRIX_VALUES_ADD_SP")
2347 999 errorsexits(
"MATRIX_VALUES_ADD_SP",err,error)
2360 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
2361 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
2362 REAL(SP),
INTENT(IN) ::
VALUE 2363 INTEGER(INTG),
INTENT(OUT) :: ERR
2366 INTEGER(INTG) :: LOCATION
2369 enters(
"MATRIX_VALUES_ADD_SP1",err,error,*999)
2371 IF(
ASSOCIATED(matrix))
THEN 2372 IF(matrix%MATRIX_FINISHED)
THEN 2375 IF(location==0)
THEN 2378 CALL flagerror(local_error,err,error,*999)
2380 matrix%DATA_SP(location)=matrix%DATA_SP(location)+
VALUE 2384 &
" does not correspond to the single precision data type of the given value." 2385 CALL flagerror(local_error,err,error,*999)
2388 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
2391 CALL flagerror(
"Matrix is not associated.",err,error,*999)
2394 exits(
"MATRIX_VALUES_ADD_SP1")
2396 999 errorsexits(
"MATRIX_VALUES_ADD_SP1",err,error)
2409 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
2410 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
2411 REAL(SP),
INTENT(IN) :: VALUES(:,:)
2412 INTEGER(INTG),
INTENT(OUT) :: ERR
2415 INTEGER(INTG) :: i,j,k,ROW_INDEX,PREVIOUS_ROW_INDEX,COLUMN_INDEX,PREVIOUS_COLUMN_INDEX,LOCATION,LOWLIMIT,MIDPOINT,UPLIMIT
2416 LOGICAL :: FOUNDCOLUMN, FOUNDROW
2419 enters(
"MATRIX_VALUES_ADD_SP2",err,error,*999)
2421 IF(
ASSOCIATED(matrix))
THEN 2422 IF(matrix%MATRIX_FINISHED)
THEN 2423 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 2424 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 2426 SELECT CASE(matrix%STORAGE_TYPE)
2428 DO j=1,
SIZE(column_indices,1)
2429 column_index=column_indices(j)
2430 DO i=1,
SIZE(row_indices,1)
2431 row_index=row_indices(i)
2432 location=row_index+(column_index-1)*matrix%M
2433 IF(location==0)
THEN 2436 CALL flagerror(local_error,err,error,*999)
2438 matrix%DATA_SP(location)=matrix%DATA_SP(location)+values(i,j)
2443 DO i=1,
SIZE(row_indices,1)
2444 row_index=row_indices(i)
2445 DO j=1,
SIZE(column_indices,1)
2447 column_index=column_indices(j)
2448 IF(row_index==column_index) location=row_index
2449 IF(location==0)
THEN 2452 CALL flagerror(local_error,err,error,*999)
2454 matrix%DATA_SP(location)=matrix%DATA_SP(location)+values(i,j)
2459 DO j=1,
SIZE(column_indices,1)
2460 column_index=column_indices(j)
2461 DO i=1,
SIZE(row_indices,1)
2462 row_index=row_indices(i)
2463 location=row_index+(column_index-1)*matrix%MAX_M
2464 IF(location==0)
THEN 2467 CALL flagerror(local_error,err,error,*999)
2469 matrix%DATA_SP(location)=matrix%DATA_SP(location)+values(i,j)
2474 DO i=1,
SIZE(row_indices,1)
2475 row_index=row_indices(i)
2476 DO j=1,
SIZE(column_indices,1)
2477 column_index=column_indices(j)
2478 location=(row_index-1)*matrix%MAX_N+column_index
2479 IF(location==0)
THEN 2482 CALL flagerror(local_error,err,error,*999)
2484 matrix%DATA_SP(location)=matrix%DATA_SP(location)+values(i,j)
2490 previous_column_index=-1
2491 DO i=1,
SIZE(row_indices,1)
2492 row_index=row_indices(i)
2493 lowlimit=matrix%ROW_INDICES(row_index)
2494 uplimit=matrix%ROW_INDICES(row_index+1)
2495 DO j=1,
SIZE(column_indices,1)
2497 column_index=column_indices(j)
2498 IF(column_index<=previous_column_index)
THEN 2499 lowlimit=matrix%ROW_INDICES(row_index)
2501 uplimit=matrix%ROW_INDICES(row_index+1)
2503 previous_column_index=column_index
2505 midpoint=(uplimit+lowlimit)/2
2506 IF(matrix%COLUMN_INDICES(midpoint)>column_index)
THEN 2512 DO k=lowlimit,uplimit
2513 IF(matrix%COLUMN_INDICES(k)==column_index)
THEN 2519 IF(location==0)
THEN 2522 CALL flagerror(local_error,err,error,*999)
2524 matrix%DATA_SP(location)=matrix%DATA_SP(location)+values(i,j)
2530 previous_row_index=-1
2531 DO j=1,
SIZE(column_indices,1)
2532 column_index=column_indices(j)
2533 lowlimit=matrix%COLUMN_INDICES(column_index)
2534 uplimit=matrix%COLUMN_INDICES(column_index+1)
2535 DO i=1,
SIZE(row_indices,1)
2537 row_index=row_indices(i)
2538 IF(row_index<=previous_row_index)
THEN 2539 lowlimit=matrix%COLUMN_INDICES(column_index)
2541 uplimit=matrix%COLUMN_INDICES(column_index+1)
2543 previous_row_index=row_index
2545 midpoint=(uplimit+lowlimit)/2
2546 IF(matrix%ROW_INDICES(midpoint)>row_index)
THEN 2552 DO k=lowlimit,uplimit
2553 IF(matrix%ROW_INDICES(k)==row_index)
THEN 2559 IF(location==0)
THEN 2562 CALL flagerror(local_error,err,error,*999)
2564 matrix%DATA_SP(location)=matrix%DATA_SP(location)+values(i,j)
2569 DO i=1,
SIZE(row_indices,1)
2570 row_index=row_indices(i)
2571 DO j=1,
SIZE(column_indices,1)
2572 column_index=column_indices(j)
2575 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
2576 IF(matrix%ROW_INDICES(location)==row_index)
THEN 2577 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
2578 IF(matrix%COLUMN_INDICES(location)==column_index.AND.matrix%ROW_INDICES(location)==row_index)
THEN 2580 ELSE IF(matrix%ROW_INDICES(location)/=row_index)
THEN 2581 location=matrix%SIZE+1
2590 IF(.NOT.(foundrow.AND.foundcolumn)) location=0
2591 IF(location==0)
THEN 2594 CALL flagerror(local_error,err,error,*999)
2596 matrix%DATA_SP(location)=matrix%DATA_SP(location)+values(i,j)
2601 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))// &
2603 CALL flagerror(local_error,err,error,*999)
2607 &
" does not correspond to the single precision data type of the given values." 2608 CALL flagerror(local_error,err,error,*999)
2611 local_error=
"The size of the column indices array ("// &
2613 &
") does not conform to the number of columns in the values array ("// &
2615 CALL flagerror(local_error,err,error,*999)
2618 local_error=
"The size of the row indices array ("// &
2620 &
") does not conform to the number of rows the values array ("// &
2622 CALL flagerror(local_error,err,error,*999)
2625 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
2628 CALL flagerror(
"Matrix is not associated.",err,error,*999)
2631 exits(
"MATRIX_VALUES_ADD_SP2")
2633 999 errorsexits(
"MATRIX_VALUES_ADD_SP2",err,error)
2646 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
2647 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
2648 REAL(DP),
INTENT(IN) :: VALUES(:)
2649 INTEGER(INTG),
INTENT(OUT) :: ERR
2652 INTEGER(INTG) :: k,LOCATION
2655 enters(
"MATRIX_VALUES_ADD_DP",err,error,*999)
2657 IF(
ASSOCIATED(matrix))
THEN 2658 IF(matrix%MATRIX_FINISHED)
THEN 2659 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 2660 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 2662 DO k=1,
SIZE(row_indices,1)
2664 IF(location==0)
THEN 2667 CALL flagerror(local_error,err,error,*999)
2669 matrix%DATA_DP(location)=matrix%DATA_DP(location)+values(k)
2674 &
" does not correspond to the double precision data type of the given values." 2675 CALL flagerror(local_error,err,error,*999)
2678 local_error=
"The size of the column indices array ("// &
2680 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 2681 CALL flagerror(local_error,err,error,*999)
2684 local_error=
"The size of the row indices array ("// &
2686 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 2687 CALL flagerror(local_error,err,error,*999)
2690 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
2693 CALL flagerror(
"Matrix is not associated.",err,error,*999)
2696 exits(
"MATRIX_VALUES_ADD_DP")
2698 999 errorsexits(
"MATRIX_VALUES_ADD_DP",err,error)
2711 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
2712 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
2713 REAL(DP),
INTENT(IN) ::
VALUE 2714 INTEGER(INTG),
INTENT(OUT) :: ERR
2717 INTEGER(INTG) :: LOCATION
2720 enters(
"MATRIX_VALUES_ADD_DP1",err,error,*999)
2722 IF(
ASSOCIATED(matrix))
THEN 2723 IF(matrix%MATRIX_FINISHED)
THEN 2726 IF(location==0)
THEN 2729 CALL flagerror(local_error,err,error,*999)
2731 matrix%DATA_DP(location)=matrix%DATA_DP(location)+
VALUE 2735 &
" does not correspond to the double precision data type of the given value." 2736 CALL flagerror(local_error,err,error,*999)
2739 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
2742 CALL flagerror(
"Matrix is not associated.",err,error,*999)
2745 exits(
"MATRIX_VALUES_ADD_DP1")
2747 999 errorsexits(
"MATRIX_VALUES_ADD_DP1",err,error)
2760 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
2761 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
2762 REAL(DP),
INTENT(IN) :: VALUES(:,:)
2763 INTEGER(INTG),
INTENT(OUT) :: ERR
2766 INTEGER(INTG) :: i,j,k,ROW_INDEX,PREVIOUS_ROW_INDEX,COLUMN_INDEX,PREVIOUS_COLUMN_INDEX,LOCATION,LOWLIMIT,MIDPOINT,UPLIMIT
2767 LOGICAL :: FOUNDCOLUMN, FOUNDROW
2770 enters(
"MATRIX_VALUES_ADD_DP2",err,error,*999)
2772 IF(
ASSOCIATED(matrix))
THEN 2773 IF(matrix%MATRIX_FINISHED)
THEN 2774 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 2775 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 2777 SELECT CASE(matrix%STORAGE_TYPE)
2779 DO j=1,
SIZE(column_indices,1)
2780 column_index=column_indices(j)
2781 DO i=1,
SIZE(row_indices,1)
2782 row_index=row_indices(i)
2783 location=row_index+(column_index-1)*matrix%M
2784 IF(location==0)
THEN 2787 CALL flagerror(local_error,err,error,*999)
2789 matrix%DATA_DP(location)=matrix%DATA_DP(location)+values(i,j)
2794 DO i=1,
SIZE(row_indices,1)
2795 row_index=row_indices(i)
2796 DO j=1,
SIZE(column_indices,1)
2798 column_index=column_indices(j)
2799 IF(row_index==column_index) location=row_index
2800 IF(location==0)
THEN 2803 CALL flagerror(local_error,err,error,*999)
2805 matrix%DATA_DP(location)=matrix%DATA_DP(location)+values(i,j)
2810 DO j=1,
SIZE(column_indices,1)
2811 column_index=column_indices(j)
2812 DO i=1,
SIZE(row_indices,1)
2813 row_index=row_indices(i)
2814 location=row_index+(column_index-1)*matrix%MAX_M
2815 IF(location==0)
THEN 2818 CALL flagerror(local_error,err,error,*999)
2820 matrix%DATA_DP(location)=matrix%DATA_DP(location)+values(i,j)
2825 DO i=1,
SIZE(row_indices,1)
2826 row_index=row_indices(i)
2827 DO j=1,
SIZE(column_indices,1)
2828 column_index=column_indices(j)
2829 location=(row_index-1)*matrix%MAX_N+column_index
2830 IF(location==0)
THEN 2833 CALL flagerror(local_error,err,error,*999)
2835 matrix%DATA_DP(location)=matrix%DATA_DP(location)+values(i,j)
2841 previous_column_index=-1
2842 DO i=1,
SIZE(row_indices,1)
2843 row_index=row_indices(i)
2844 lowlimit=matrix%ROW_INDICES(row_index)
2845 uplimit=matrix%ROW_INDICES(row_index+1)
2846 DO j=1,
SIZE(column_indices,1)
2848 column_index=column_indices(j)
2849 IF(column_index<=previous_column_index)
THEN 2850 lowlimit=matrix%ROW_INDICES(row_index)
2852 uplimit=matrix%ROW_INDICES(row_index+1)
2854 previous_column_index=column_index
2856 midpoint=(uplimit+lowlimit)/2
2857 IF(matrix%COLUMN_INDICES(midpoint)>column_index)
THEN 2863 DO k=lowlimit,uplimit
2864 IF(matrix%COLUMN_INDICES(k)==column_index)
THEN 2870 IF(location==0)
THEN 2873 CALL flagerror(local_error,err,error,*999)
2875 matrix%DATA_DP(location)=matrix%DATA_DP(location)+values(i,j)
2881 previous_row_index=-1
2882 DO j=1,
SIZE(column_indices,1)
2883 column_index=column_indices(j)
2884 lowlimit=matrix%COLUMN_INDICES(column_index)
2885 uplimit=matrix%COLUMN_INDICES(column_index+1)
2886 DO i=1,
SIZE(row_indices,1)
2888 row_index=row_indices(i)
2889 IF(row_index<=previous_row_index)
THEN 2890 lowlimit=matrix%COLUMN_INDICES(column_index)
2892 uplimit=matrix%COLUMN_INDICES(column_index+1)
2894 previous_row_index=row_index
2896 midpoint=(uplimit+lowlimit)/2
2897 IF(matrix%ROW_INDICES(midpoint)>row_index)
THEN 2903 DO k=lowlimit,uplimit
2904 IF(matrix%ROW_INDICES(k)==row_index)
THEN 2910 IF(location==0)
THEN 2913 CALL flagerror(local_error,err,error,*999)
2915 matrix%DATA_DP(location)=matrix%DATA_DP(location)+values(i,j)
2920 DO i=1,
SIZE(row_indices,1)
2921 row_index=row_indices(i)
2922 DO j=1,
SIZE(column_indices,1)
2923 column_index=column_indices(j)
2926 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
2927 IF(matrix%ROW_INDICES(location)==row_index)
THEN 2928 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
2929 IF(matrix%COLUMN_INDICES(location)==column_index.AND.matrix%ROW_INDICES(location)==row_index)
THEN 2931 ELSE IF(matrix%ROW_INDICES(location)/=row_index)
THEN 2932 location=matrix%SIZE+1
2941 IF(.NOT.(foundrow.AND.foundcolumn)) location=0
2942 IF(location==0)
THEN 2945 CALL flagerror(local_error,err,error,*999)
2947 matrix%DATA_DP(location)=matrix%DATA_DP(location)+values(i,j)
2952 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))// &
2954 CALL flagerror(local_error,err,error,*999)
2958 &
" does not correspond to the double precision data type of the given values." 2959 CALL flagerror(local_error,err,error,*999)
2962 local_error=
"The size of the column indices array ("// &
2964 &
") does not conform to the number of columns in the values array ("// &
2966 CALL flagerror(local_error,err,error,*999)
2969 local_error=
"The size of the row indices array ("// &
2971 &
") does not conform to the number of rows the values array ("// &
2973 CALL flagerror(local_error,err,error,*999)
2976 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
2979 CALL flagerror(
"Matrix is not associated.",err,error,*999)
2982 exits(
"MATRIX_VALUES_ADD_DP2")
2984 999 errorsexits(
"MATRIX_VALUES_ADD_DP2",err,error)
2997 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
2998 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
2999 LOGICAL,
INTENT(IN) :: VALUES(:)
3000 INTEGER(INTG),
INTENT(OUT) :: ERR
3003 INTEGER(INTG) :: k,LOCATION
3006 enters(
"MATRIX_VALUES_ADD_L",err,error,*999)
3008 IF(
ASSOCIATED(matrix))
THEN 3009 IF(matrix%MATRIX_FINISHED)
THEN 3010 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3011 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 3013 DO k=1,
SIZE(row_indices,1)
3015 IF(location==0)
THEN 3018 CALL flagerror(local_error,err,error,*999)
3020 matrix%DATA_L(location)=matrix%DATA_L(location).OR.values(k)
3025 &
" does not correspond to the logical data type of the given values." 3026 CALL flagerror(local_error,err,error,*999)
3029 local_error=
"The size of the column indices array ("// &
3031 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3032 CALL flagerror(local_error,err,error,*999)
3035 local_error=
"The size of the row indices array ("// &
3037 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3038 CALL flagerror(local_error,err,error,*999)
3041 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3044 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3047 exits(
"MATRIX_VALUES_ADD_L")
3049 999 errorsexits(
"MATRIX_VALUES_ADD_L",err,error)
3062 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
3063 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
3064 LOGICAL,
INTENT(IN) ::
VALUE 3065 INTEGER(INTG),
INTENT(OUT) :: ERR
3068 INTEGER(INTG) :: LOCATION
3071 enters(
"MATRIX_VALUES_ADD_L1",err,error,*999)
3073 IF(
ASSOCIATED(matrix))
THEN 3074 IF(matrix%MATRIX_FINISHED)
THEN 3077 IF(location==0)
THEN 3080 CALL flagerror(local_error,err,error,*999)
3082 matrix%DATA_L(location)=matrix%DATA_L(location).OR.
VALUE 3086 &
" does not correspond to the logical data type of the given value." 3087 CALL flagerror(local_error,err,error,*999)
3090 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3093 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3096 exits(
"MATRIX_VALUES_ADD_L1")
3098 999 errorsexits(
"MATRIX_VALUES_ADD_L1",err,error)
3111 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3112 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3113 LOGICAL,
INTENT(IN) :: VALUES(:,:)
3114 INTEGER(INTG),
INTENT(OUT) :: ERR
3117 INTEGER(INTG) :: i,j,k,ROW_INDEX,PREVIOUS_ROW_INDEX,COLUMN_INDEX,PREVIOUS_COLUMN_INDEX,LOCATION,LOWLIMIT,MIDPOINT,UPLIMIT
3118 LOGICAL :: FOUNDCOLUMN, FOUNDROW
3121 enters(
"MATRIX_VALUES_ADD_L2",err,error,*999)
3123 IF(
ASSOCIATED(matrix))
THEN 3124 IF(matrix%MATRIX_FINISHED)
THEN 3125 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3126 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 3128 SELECT CASE(matrix%STORAGE_TYPE)
3130 DO j=1,
SIZE(column_indices,1)
3131 column_index=column_indices(j)
3132 DO i=1,
SIZE(row_indices,1)
3133 row_index=row_indices(i)
3134 location=row_index+(column_index-1)*matrix%M
3135 IF(location==0)
THEN 3138 CALL flagerror(local_error,err,error,*999)
3140 matrix%DATA_L(location)=matrix%DATA_L(location).OR.values(i,j)
3145 DO i=1,
SIZE(row_indices,1)
3146 row_index=row_indices(i)
3147 DO j=1,
SIZE(column_indices,1)
3149 column_index=column_indices(j)
3150 IF(row_index==column_index) location=row_index
3151 IF(location==0)
THEN 3154 CALL flagerror(local_error,err,error,*999)
3156 matrix%DATA_L(location)=matrix%DATA_L(location).OR.values(i,j)
3161 DO j=1,
SIZE(column_indices,1)
3162 column_index=column_indices(j)
3163 DO i=1,
SIZE(row_indices,1)
3164 row_index=row_indices(i)
3165 location=row_index+(column_index-1)*matrix%MAX_M
3166 IF(location==0)
THEN 3169 CALL flagerror(local_error,err,error,*999)
3171 matrix%DATA_L(location)=matrix%DATA_L(location).OR.values(i,j)
3176 DO i=1,
SIZE(row_indices,1)
3177 row_index=row_indices(i)
3178 DO j=1,
SIZE(column_indices,1)
3179 column_index=column_indices(j)
3180 location=(row_index-1)*matrix%MAX_N+column_index
3181 IF(location==0)
THEN 3184 CALL flagerror(local_error,err,error,*999)
3186 matrix%DATA_L(location)=matrix%DATA_L(location).OR.values(i,j)
3192 previous_column_index=-1
3193 DO i=1,
SIZE(row_indices,1)
3194 row_index=row_indices(i)
3195 lowlimit=matrix%ROW_INDICES(row_index)
3196 uplimit=matrix%ROW_INDICES(row_index+1)
3197 DO j=1,
SIZE(column_indices,1)
3199 column_index=column_indices(j)
3200 IF(column_index<=previous_column_index)
THEN 3201 lowlimit=matrix%ROW_INDICES(row_index)
3203 uplimit=matrix%ROW_INDICES(row_index+1)
3205 previous_column_index=column_index
3207 midpoint=(uplimit+lowlimit)/2
3208 IF(matrix%COLUMN_INDICES(midpoint)>column_index)
THEN 3214 DO k=lowlimit,uplimit
3215 IF(matrix%COLUMN_INDICES(k)==column_index)
THEN 3221 IF(location==0)
THEN 3224 CALL flagerror(local_error,err,error,*999)
3226 matrix%DATA_L(location)=matrix%DATA_L(location).OR.values(i,j)
3232 previous_row_index=-1
3233 DO j=1,
SIZE(column_indices,1)
3234 column_index=column_indices(j)
3235 lowlimit=matrix%COLUMN_INDICES(column_index)
3236 uplimit=matrix%COLUMN_INDICES(column_index+1)
3237 DO i=1,
SIZE(row_indices,1)
3239 row_index=row_indices(i)
3240 IF(row_index<=previous_row_index)
THEN 3241 lowlimit=matrix%COLUMN_INDICES(column_index)
3243 uplimit=matrix%COLUMN_INDICES(column_index+1)
3245 previous_row_index=row_index
3247 midpoint=(uplimit+lowlimit)/2
3248 IF(matrix%ROW_INDICES(midpoint)>row_index)
THEN 3254 DO k=lowlimit,uplimit
3255 IF(matrix%ROW_INDICES(k)==row_index)
THEN 3261 IF(location==0)
THEN 3264 CALL flagerror(local_error,err,error,*999)
3266 matrix%DATA_L(location)=matrix%DATA_L(location).OR.values(i,j)
3271 DO i=1,
SIZE(row_indices,1)
3272 row_index=row_indices(i)
3273 DO j=1,
SIZE(column_indices,1)
3274 column_index=column_indices(j)
3277 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
3278 IF(matrix%ROW_INDICES(location)==row_index)
THEN 3279 DO WHILE(.NOT.foundcolumn.AND.location<=matrix%SIZE)
3280 IF(matrix%COLUMN_INDICES(location)==column_index.AND.matrix%ROW_INDICES(location)==row_index)
THEN 3282 ELSE IF(matrix%ROW_INDICES(location)/=row_index)
THEN 3283 location=matrix%SIZE+1
3292 IF(.NOT.(foundrow.AND.foundcolumn)) location=0
3293 IF(location==0)
THEN 3296 CALL flagerror(local_error,err,error,*999)
3298 matrix%DATA_L(location)=matrix%DATA_L(location).OR.values(i,j)
3303 local_error=
"The matrix storage type of "//
trim(
number_to_vstring(matrix%STORAGE_TYPE,
"*",err,error))// &
3305 CALL flagerror(local_error,err,error,*999)
3309 &
" does not correspond to the logical data type of the given values." 3310 CALL flagerror(local_error,err,error,*999)
3313 local_error=
"The size of the column indices array ("// &
3315 &
") does not conform to the number of columns in the values array ("// &
3317 CALL flagerror(local_error,err,error,*999)
3320 local_error=
"The size of the row indices array ("// &
3322 &
") does not conform to the number of rows the values array ("// &
3324 CALL flagerror(local_error,err,error,*999)
3327 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3330 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3333 exits(
"MATRIX_VALUES_ADD_L2")
3335 999 errorsexits(
"MATRIX_VALUES_ADD_L2",err,error)
3348 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3349 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3350 INTEGER(INTG),
INTENT(OUT) :: VALUES(:)
3351 INTEGER(INTG),
INTENT(OUT) :: ERR
3354 INTEGER(INTG) :: k,LOCATION
3357 enters(
"MATRIX_VALUES_GET_INTG",err,error,*999)
3359 IF(
ASSOCIATED(matrix))
THEN 3360 IF(matrix%MATRIX_FINISHED)
THEN 3361 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3362 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 3364 DO k=1,
SIZE(row_indices,1)
3366 IF(location==0)
THEN 3369 values(k)=matrix%DATA_INTG(location)
3374 &
" does not correspond to the integer data type of the given values." 3375 CALL flagerror(local_error,err,error,*999)
3378 local_error=
"The size of the column indices array ("// &
3380 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3381 CALL flagerror(local_error,err,error,*999)
3384 local_error=
"The size of the row indices array ("// &
3386 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3387 CALL flagerror(local_error,err,error,*999)
3390 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3393 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3396 exits(
"MATRIX_VALUES_GET_INTG")
3398 999 errorsexits(
"MATRIX_VALUES_GET_INTG",err,error)
3411 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
3412 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
3413 INTEGER(INTG),
INTENT(OUT) ::
VALUE 3414 INTEGER(INTG),
INTENT(OUT) :: ERR
3417 INTEGER(INTG) :: LOCATION
3420 enters(
"MATRIX_VALUES_GET_INTG1",err,error,*999)
3422 IF(
ASSOCIATED(matrix))
THEN 3423 IF(matrix%MATRIX_FINISHED)
THEN 3426 IF(location==0)
THEN 3429 VALUE=matrix%DATA_INTG(location)
3433 &
" does not correspond to the integer data type of the given value." 3434 CALL flagerror(local_error,err,error,*999)
3437 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3440 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3443 exits(
"MATRIX_VALUES_GET_INTG1")
3445 999 errorsexits(
"MATRIX_VALUES_GET_INTG1",err,error)
3458 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3459 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3460 INTEGER(INTG),
INTENT(OUT) :: VALUES(:,:)
3461 INTEGER(INTG),
INTENT(OUT) :: ERR
3464 INTEGER(INTG) :: i,j,LOCATION
3467 enters(
"MATRIX_VALUES_GET_INTG2",err,error,*999)
3469 IF(
ASSOCIATED(matrix))
THEN 3470 IF(matrix%MATRIX_FINISHED)
THEN 3471 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3472 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 3474 DO i=1,
SIZE(row_indices,1)
3475 DO j=1,
SIZE(column_indices,1)
3477 IF(location==0)
THEN 3480 values(i,j)=matrix%DATA_INTG(location)
3486 &
" does not correspond to the integer data type of the given values." 3487 CALL flagerror(local_error,err,error,*999)
3490 local_error=
"The size of the column indices array ("// &
3492 &
") does not conform to the number of columns in the values array ("// &
3494 CALL flagerror(local_error,err,error,*999)
3497 local_error=
"The size of the row indices array ("// &
3499 &
") does not conform to the number of rows in the values array ("// &
3501 CALL flagerror(local_error,err,error,*999)
3504 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3507 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3510 exits(
"MATRIX_VALUES_GET_INTG2")
3512 999 errorsexits(
"MATRIX_VALUES_GET_INTG2",err,error)
3525 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3526 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3527 REAL(SP),
INTENT(OUT) :: VALUES(:)
3528 INTEGER(INTG),
INTENT(OUT) :: ERR
3531 INTEGER(INTG) :: k,LOCATION
3534 enters(
"MATRIX_VALUES_GET_SP",err,error,*999)
3536 IF(
ASSOCIATED(matrix))
THEN 3537 IF(matrix%MATRIX_FINISHED)
THEN 3538 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3539 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 3541 DO k=1,
SIZE(row_indices,1)
3543 IF(location==0)
THEN 3546 values(k)=matrix%DATA_SP(location)
3551 &
" does not correspond to the single precision data type of the given values." 3552 CALL flagerror(local_error,err,error,*999)
3555 local_error=
"The size of the column indices array ("// &
3557 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3558 CALL flagerror(local_error,err,error,*999)
3561 local_error=
"The size of the row indices array ("// &
3563 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3564 CALL flagerror(local_error,err,error,*999)
3567 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3570 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3573 exits(
"MATRIX_VALUES_GET_SP")
3575 999 errorsexits(
"MATRIX_VALUES_GET_SP",err,error)
3588 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
3589 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
3590 REAL(SP),
INTENT(OUT) ::
VALUE 3591 INTEGER(INTG),
INTENT(OUT) :: ERR
3594 INTEGER(INTG) :: LOCATION
3597 enters(
"MATRIX_VALUES_GET_SP1",err,error,*999)
3599 IF(
ASSOCIATED(matrix))
THEN 3600 IF(matrix%MATRIX_FINISHED)
THEN 3603 IF(location==0)
THEN 3606 VALUE=matrix%DATA_SP(location)
3610 &
" does not correspond to the single precision data type of the given value." 3611 CALL flagerror(local_error,err,error,*999)
3614 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3617 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3620 exits(
"MATRIX_VALUES_GET_SP1")
3622 999 errorsexits(
"MATRIX_VALUES_GET_SP1",err,error)
3635 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3636 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3637 REAL(SP),
INTENT(OUT) :: VALUES(:,:)
3638 INTEGER(INTG),
INTENT(OUT) :: ERR
3641 INTEGER(INTG) :: i,j,LOCATION
3644 enters(
"MATRIX_VALUES_GET_SP2",err,error,*999)
3646 IF(
ASSOCIATED(matrix))
THEN 3647 IF(matrix%MATRIX_FINISHED)
THEN 3648 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3649 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 3651 DO i=1,
SIZE(row_indices,1)
3652 DO j=1,
SIZE(column_indices,1)
3654 IF(location==0)
THEN 3657 values(i,j)=matrix%DATA_SP(location)
3663 &
" does not correspond to the single precision data type of the given values." 3664 CALL flagerror(local_error,err,error,*999)
3667 local_error=
"The size of the column indices array ("// &
3669 &
") does not conform to the number of columns in the values array ("// &
3671 CALL flagerror(local_error,err,error,*999)
3674 local_error=
"The size of the row indices array ("// &
3676 &
") does not conform to the number of rows in the values array ("// &
3678 CALL flagerror(local_error,err,error,*999)
3681 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3684 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3687 exits(
"MATRIX_VALUES_GET_SP2")
3689 999 errorsexits(
"MATRIX_VALUES_GET_SP2",err,error)
3702 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3703 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3704 REAL(DP),
INTENT(OUT) :: VALUES(:)
3705 INTEGER(INTG),
INTENT(OUT) :: ERR
3708 INTEGER(INTG) :: k,LOCATION
3711 enters(
"MATRIX_VALUES_GET_DP",err,error,*999)
3713 IF(
ASSOCIATED(matrix))
THEN 3714 IF(matrix%MATRIX_FINISHED)
THEN 3715 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3716 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 3718 DO k=1,
SIZE(row_indices,1)
3720 IF(location==0)
THEN 3723 values(k)=matrix%DATA_DP(location)
3728 &
" does not correspond to the double precision data type of the given values." 3729 CALL flagerror(local_error,err,error,*999)
3732 local_error=
"The size of the column indices array ("// &
3734 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3735 CALL flagerror(local_error,err,error,*999)
3738 local_error=
"The size of the row indices array ("// &
3740 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3741 CALL flagerror(local_error,err,error,*999)
3744 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3747 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3750 exits(
"MATRIX_VALUES_GET_DP")
3752 999 errorsexits(
"MATRIX_VALUES_GET_DP",err,error)
3765 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
3766 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
3767 REAL(DP),
INTENT(OUT) ::
VALUE 3768 INTEGER(INTG),
INTENT(OUT) :: ERR
3771 INTEGER(INTG) :: LOCATION
3774 enters(
"MATRIX_VALUES_GET_DP1",err,error,*999)
3776 IF(
ASSOCIATED(matrix))
THEN 3777 IF(matrix%MATRIX_FINISHED)
THEN 3780 IF(location==0)
THEN 3783 VALUE=matrix%DATA_DP(location)
3787 &
" does not correspond to the double precision data type of the given value." 3788 CALL flagerror(local_error,err,error,*999)
3791 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3794 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3797 exits(
"MATRIX_VALUES_GET_DP1")
3799 999 errorsexits(
"MATRIX_VALUES_GET_DP1",err,error)
3812 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3813 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3814 REAL(DP),
INTENT(OUT) :: VALUES(:,:)
3815 INTEGER(INTG),
INTENT(OUT) :: ERR
3818 INTEGER(INTG) :: i,j,LOCATION
3821 enters(
"MATRIX_VALUES_GET_DP2",err,error,*999)
3823 IF(
ASSOCIATED(matrix))
THEN 3824 IF(matrix%MATRIX_FINISHED)
THEN 3825 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3826 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 3828 DO i=1,
SIZE(row_indices,1)
3829 DO j=1,
SIZE(column_indices,1)
3831 IF(location==0)
THEN 3834 values(i,j)=matrix%DATA_DP(location)
3840 &
" does not correspond to the double precision data type of the given values." 3841 CALL flagerror(local_error,err,error,*999)
3844 local_error=
"The size of the column indices array ("// &
3846 &
") does not conform to the number of columns in the values array ("// &
3848 CALL flagerror(local_error,err,error,*999)
3851 local_error=
"The size of the row indices array ("// &
3853 &
") does not conform to the number of rows in the values array ("// &
3855 CALL flagerror(local_error,err,error,*999)
3858 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3861 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3864 exits(
"MATRIX_VALUES_GET_DP2")
3866 999 errorsexits(
"MATRIX_VALUES_GET_DP2",err,error)
3879 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3880 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3881 LOGICAL,
INTENT(OUT) :: VALUES(:)
3882 INTEGER(INTG),
INTENT(OUT) :: ERR
3885 INTEGER(INTG) :: k,LOCATION
3888 enters(
"MATRIX_VALUES_GET_L",err,error,*999)
3890 IF(
ASSOCIATED(matrix))
THEN 3891 IF(matrix%MATRIX_FINISHED)
THEN 3892 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 3893 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 3895 DO k=1,
SIZE(row_indices,1)
3897 IF(location==0)
THEN 3900 values(k)=matrix%DATA_L(location)
3905 &
" does not correspond to the logical data type of the given values." 3906 CALL flagerror(local_error,err,error,*999)
3909 local_error=
"The size of the column indices array ("// &
3911 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3912 CALL flagerror(local_error,err,error,*999)
3915 local_error=
"The size of the row indices array ("// &
3917 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 3918 CALL flagerror(local_error,err,error,*999)
3921 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3924 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3927 exits(
"MATRIX_VALUES_GET_L")
3929 999 errorsexits(
"MATRIX_VALUES_GET_L",err,error)
3942 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
3943 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
3944 LOGICAL,
INTENT(OUT) ::
VALUE 3945 INTEGER(INTG),
INTENT(OUT) :: ERR
3948 INTEGER(INTG) :: LOCATION
3951 enters(
"MATRIX_VALUES_GET_L1",err,error,*999)
3953 IF(
ASSOCIATED(matrix))
THEN 3954 IF(matrix%MATRIX_FINISHED)
THEN 3957 IF(location==0)
THEN 3960 VALUE=matrix%DATA_L(location)
3964 &
" does not correspond to the logical data type of the given value." 3965 CALL flagerror(local_error,err,error,*999)
3968 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
3971 CALL flagerror(
"Matrix is not associated.",err,error,*999)
3974 exits(
"MATRIX_VALUES_GET_L1")
3976 999 errorsexits(
"MATRIX_VALUES_GET_L1",err,error)
3989 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
3990 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
3991 LOGICAL,
INTENT(OUT) :: VALUES(:,:)
3992 INTEGER(INTG),
INTENT(OUT) :: ERR
3995 INTEGER(INTG) :: i,j,LOCATION
3998 enters(
"MATRIX_VALUES_GET_L2",err,error,*999)
4000 IF(
ASSOCIATED(matrix))
THEN 4001 IF(matrix%MATRIX_FINISHED)
THEN 4002 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4003 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 4005 DO i=1,
SIZE(row_indices,1)
4006 DO j=1,
SIZE(column_indices,1)
4008 IF(location==0)
THEN 4011 values(i,j)=matrix%DATA_L(location)
4017 &
" does not correspond to the logical data type of the given values." 4018 CALL flagerror(local_error,err,error,*999)
4021 local_error=
"The size of the column indices array ("// &
4023 &
") does not conform to the number of columns in the values array ("// &
4025 CALL flagerror(local_error,err,error,*999)
4028 local_error=
"The size of the row indices array ("// &
4030 &
") does not conform to the number of rows in the values array ("// &
4032 CALL flagerror(local_error,err,error,*999)
4035 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4038 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4041 exits(
"MATRIX_VALUES_GET_L2")
4043 999 errorsexits(
"MATRIX_VALUES_GET_L2",err,error)
4056 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
4057 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
4058 INTEGER(INTG),
INTENT(IN) :: VALUES(:)
4059 INTEGER(INTG),
INTENT(OUT) :: ERR
4062 INTEGER(INTG) :: k,LOCATION
4065 enters(
"MATRIX_VALUES_SET_INTG",err,error,*999)
4067 IF(
ASSOCIATED(matrix))
THEN 4068 IF(matrix%MATRIX_FINISHED)
THEN 4069 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4070 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 4072 DO k=1,
SIZE(row_indices,1)
4074 IF(location==0)
THEN 4077 CALL flagerror(local_error,err,error,*999)
4079 matrix%DATA_INTG(location)=values(k)
4084 &
" does not correspond to the integer data type of the given values." 4085 CALL flagerror(local_error,err,error,*999)
4088 local_error=
"The size of the column indices array ("// &
4090 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 4091 CALL flagerror(local_error,err,error,*999)
4094 local_error=
"The size of the row indices array ("// &
4096 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 4097 CALL flagerror(local_error,err,error,*999)
4100 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4103 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4106 exits(
"MATRIX_VALUES_SET_INTG")
4108 999 errorsexits(
"MATRIX_VALUES_SET_INTG",err,error)
4121 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
4122 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
4123 INTEGER(INTG),
INTENT(IN) ::
VALUE 4124 INTEGER(INTG),
INTENT(OUT) :: ERR
4127 INTEGER(INTG) :: LOCATION
4130 enters(
"MATRIX_VALUES_SET_INTG1",err,error,*999)
4132 IF(
ASSOCIATED(matrix))
THEN 4133 IF(matrix%MATRIX_FINISHED)
THEN 4136 IF(location==0)
THEN 4139 CALL flagerror(local_error,err,error,*999)
4141 matrix%DATA_INTG(location)=
VALUE 4145 &
" does not correspond to the integer data type of the given value." 4146 CALL flagerror(local_error,err,error,*999)
4149 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4152 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4155 exits(
"MATRIX_VALUES_SET_INTG1")
4157 999 errorsexits(
"MATRIX_VALUES_SET_INTG1",err,error)
4170 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
4171 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
4172 INTEGER(INTG),
INTENT(IN) :: VALUES(:,:)
4173 INTEGER(INTG),
INTENT(OUT) :: ERR
4176 INTEGER(INTG) :: i,j,LOCATION
4179 enters(
"MATRIX_VALUES_SET_INTG2",err,error,*999)
4181 IF(
ASSOCIATED(matrix))
THEN 4182 IF(matrix%MATRIX_FINISHED)
THEN 4183 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4184 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 4186 DO i=1,
SIZE(row_indices,1)
4187 DO j=1,
SIZE(column_indices,1)
4189 IF(location==0)
THEN 4192 CALL flagerror(local_error,err,error,*999)
4194 matrix%DATA_INTG(location)=values(i,j)
4200 &
" does not correspond to the integer data type of the given values." 4201 CALL flagerror(local_error,err,error,*999)
4204 local_error=
"The size of the column indices array ("// &
4206 &
") does not conform to the number of columns in the values array ("// &
4208 CALL flagerror(local_error,err,error,*999)
4211 local_error=
"The size of the row indices array ("// &
4213 &
") does not conform to the number of rows in the values array ("// &
4215 CALL flagerror(local_error,err,error,*999)
4218 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4221 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4224 exits(
"MATRIX_VALUES_SET_INTG2")
4226 999 errorsexits(
"MATRIX_VALUES_SET_INTG2",err,error)
4239 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
4240 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
4241 REAL(SP),
INTENT(IN) :: VALUES(:)
4242 INTEGER(INTG),
INTENT(OUT) :: ERR
4245 INTEGER(INTG) :: k,LOCATION
4248 enters(
"MATRIX_VALUES_SET_SP",err,error,*999)
4250 IF(
ASSOCIATED(matrix))
THEN 4251 IF(matrix%MATRIX_FINISHED)
THEN 4252 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4253 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 4255 DO k=1,
SIZE(row_indices,1)
4257 IF(location==0)
THEN 4260 CALL flagerror(local_error,err,error,*999)
4262 matrix%DATA_SP(location)=values(k)
4267 &
" does not correspond to the single precision data type of the given values." 4268 CALL flagerror(local_error,err,error,*999)
4271 local_error=
"The size of the column indices array ("// &
4273 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 4274 CALL flagerror(local_error,err,error,*999)
4277 local_error=
"The size of the row indices array ("// &
4279 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 4280 CALL flagerror(local_error,err,error,*999)
4283 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4286 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4289 exits(
"MATRIX_VALUES_SET_SP")
4291 999 errorsexits(
"MATRIX_VALUES_SET_SP",err,error)
4304 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
4305 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
4306 REAL(SP),
INTENT(IN) ::
VALUE 4307 INTEGER(INTG),
INTENT(OUT) :: ERR
4310 INTEGER(INTG) :: LOCATION
4313 enters(
"MATRIX_VALUES_SET_SP1",err,error,*999)
4315 IF(
ASSOCIATED(matrix))
THEN 4316 IF(matrix%MATRIX_FINISHED)
THEN 4319 IF(location==0)
THEN 4322 CALL flagerror(local_error,err,error,*999)
4324 matrix%DATA_SP(location)=
VALUE 4328 &
" does not correspond to the single precision data type of the given value." 4329 CALL flagerror(local_error,err,error,*999)
4332 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4335 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4338 exits(
"MATRIX_VALUES_SET_SP1")
4340 999 errorsexits(
"MATRIX_VALUES_SET_SP1",err,error)
4353 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
4354 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
4355 REAL(SP),
INTENT(IN) :: VALUES(:,:)
4356 INTEGER(INTG),
INTENT(OUT) :: ERR
4359 INTEGER(INTG) :: i,j,LOCATION
4362 enters(
"MATRIX_VALUES_SET_SP2",err,error,*999)
4364 IF(
ASSOCIATED(matrix))
THEN 4365 IF(matrix%MATRIX_FINISHED)
THEN 4366 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4367 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 4369 DO i=1,
SIZE(row_indices,1)
4370 DO j=1,
SIZE(column_indices,1)
4372 IF(location==0)
THEN 4375 CALL flagerror(local_error,err,error,*999)
4377 matrix%DATA_SP(location)=values(i,j)
4383 &
" does not correspond to the single precision data type of the given values." 4384 CALL flagerror(local_error,err,error,*999)
4387 local_error=
"The size of the column indices array ("// &
4389 &
") does not conform to the number of columns in the values array ("// &
4391 CALL flagerror(local_error,err,error,*999)
4394 local_error=
"The size of the row indices array ("// &
4396 &
") does not conform to the number of rows in the values array ("// &
4398 CALL flagerror(local_error,err,error,*999)
4401 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4404 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4407 exits(
"MATRIX_VALUES_SET_SP2")
4409 999 errorsexits(
"MATRIX_VALUES_SET_SP2",err,error)
4422 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
4423 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
4424 REAL(DP),
INTENT(IN) :: VALUES(:)
4425 INTEGER(INTG),
INTENT(OUT) :: ERR
4428 INTEGER(INTG) :: k,LOCATION
4431 enters(
"MATRIX_VALUES_SET_DP",err,error,*999)
4433 IF(
ASSOCIATED(matrix))
THEN 4434 IF(matrix%MATRIX_FINISHED)
THEN 4435 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4436 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 4438 DO k=1,
SIZE(row_indices,1)
4440 IF(location==0)
THEN 4443 CALL flagerror(local_error,err,error,*999)
4445 matrix%DATA_DP(location)=values(k)
4450 &
" does not correspond to the double precision data type of the given values." 4451 CALL flagerror(local_error,err,error,*999)
4454 local_error=
"The size of the column indices array ("// &
4456 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 4457 CALL flagerror(local_error,err,error,*999)
4460 local_error=
"The size of the row indices array ("// &
4462 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 4463 CALL flagerror(local_error,err,error,*999)
4466 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4469 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4472 exits(
"MATRIX_VALUES_SET_DP")
4474 999 errorsexits(
"MATRIX_VALUES_SET_DP",err,error)
4487 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
4488 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
4489 REAL(DP),
INTENT(IN) ::
VALUE 4490 INTEGER(INTG),
INTENT(OUT) :: ERR
4493 INTEGER(INTG) :: LOCATION
4496 enters(
"MATRIX_VALUES_SET_DP1",err,error,*999)
4498 IF(
ASSOCIATED(matrix))
THEN 4499 IF(matrix%MATRIX_FINISHED)
THEN 4502 IF(location==0)
THEN 4505 CALL flagerror(local_error,err,error,*999)
4507 matrix%DATA_DP(location)=
VALUE 4511 &
" does not correspond to the double precision data type of the given value." 4512 CALL flagerror(local_error,err,error,*999)
4515 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4518 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4521 exits(
"MATRIX_VALUES_SET_DP1")
4523 999 errorsexits(
"MATRIX_VALUES_SET_DP1",err,error)
4536 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
4537 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
4538 REAL(DP),
INTENT(IN) :: VALUES(:,:)
4539 INTEGER(INTG),
INTENT(OUT) :: ERR
4542 INTEGER(INTG) :: i,j,LOCATION
4545 enters(
"MATRIX_VALUES_SET_DP2",err,error,*999)
4547 IF(
ASSOCIATED(matrix))
THEN 4548 IF(matrix%MATRIX_FINISHED)
THEN 4549 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4550 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 4552 DO i=1,
SIZE(row_indices,1)
4553 DO j=1,
SIZE(column_indices,1)
4555 IF(location==0)
THEN 4558 CALL flagerror(local_error,err,error,*999)
4560 matrix%DATA_DP(location)=values(i,j)
4566 &
" does not correspond to the double precision data type of the given values." 4567 CALL flagerror(local_error,err,error,*999)
4570 local_error=
"The size of the column indices array ("// &
4572 &
") does not conform to the number of columns in the values array ("// &
4574 CALL flagerror(local_error,err,error,*999)
4577 local_error=
"The size of the row indices array ("// &
4579 &
") does not conform to the number of rows in the values array ("// &
4581 CALL flagerror(local_error,err,error,*999)
4584 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4587 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4590 exits(
"MATRIX_VALUES_SET_DP2")
4592 999 errorsexits(
"MATRIX_VALUES_SET_DP2",err,error)
4605 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
4606 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
4607 LOGICAL,
INTENT(IN) :: VALUES(:)
4608 INTEGER(INTG),
INTENT(OUT) :: ERR
4611 INTEGER(INTG) :: k,LOCATION
4614 enters(
"MATRIX_VALUES_SET_L",err,error,*999)
4616 IF(
ASSOCIATED(matrix))
THEN 4617 IF(matrix%MATRIX_FINISHED)
THEN 4618 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4619 IF(
SIZE(column_indices,1)==
SIZE(values,1))
THEN 4621 DO k=1,
SIZE(row_indices,1)
4623 IF(location==0)
THEN 4626 CALL flagerror(local_error,err,error,*999)
4628 matrix%DATA_L(location)=values(k)
4633 &
" does not correspond to the logical data type of the given values." 4634 CALL flagerror(local_error,err,error,*999)
4637 local_error=
"The size of the column indices array ("// &
4639 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 4640 CALL flagerror(local_error,err,error,*999)
4643 local_error=
"The size of the row indices array ("// &
4645 &
") does not conform to the size of the values array ("//
trim(
number_to_vstring(
SIZE(values,1),
"*",err,error))//
")." 4646 CALL flagerror(local_error,err,error,*999)
4649 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4652 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4655 exits(
"MATRIX_VALUES_SET_L")
4657 999 errorsexits(
"MATRIX_VALUES_SET_L",err,error)
4670 INTEGER(INTG),
INTENT(IN) :: ROW_INDEX
4671 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDEX
4672 LOGICAL,
INTENT(IN) ::
VALUE 4673 INTEGER(INTG),
INTENT(OUT) :: ERR
4676 INTEGER(INTG) :: LOCATION
4679 enters(
"MATRIX_VALUES_SET_L1",err,error,*999)
4681 IF(
ASSOCIATED(matrix))
THEN 4682 IF(matrix%MATRIX_FINISHED)
THEN 4685 IF(location==0)
THEN 4688 CALL flagerror(local_error,err,error,*999)
4690 matrix%DATA_L(location)=
VALUE 4694 &
" does not correspond to the logical data type of the given value." 4695 CALL flagerror(local_error,err,error,*999)
4698 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4701 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4704 exits(
"MATRIX_VALUES_SET_L1")
4706 999 errorsexits(
"MATRIX_VALUES_SET_L1",err,error)
4719 INTEGER(INTG),
INTENT(IN) :: ROW_INDICES(:)
4720 INTEGER(INTG),
INTENT(IN) :: COLUMN_INDICES(:)
4721 LOGICAL,
INTENT(IN) :: VALUES(:,:)
4722 INTEGER(INTG),
INTENT(OUT) :: ERR
4725 INTEGER(INTG) :: i,j,LOCATION
4728 enters(
"MATRIX_VALUES_SET_L2",err,error,*999)
4730 IF(
ASSOCIATED(matrix))
THEN 4731 IF(matrix%MATRIX_FINISHED)
THEN 4732 IF(
SIZE(row_indices,1)==
SIZE(values,1))
THEN 4733 IF(
SIZE(column_indices,1)==
SIZE(values,2))
THEN 4735 DO i=1,
SIZE(row_indices,1)
4736 DO j=1,
SIZE(row_indices,1)
4738 IF(location==0)
THEN 4741 CALL flagerror(local_error,err,error,*999)
4743 matrix%DATA_L(location)=values(i,j)
4749 &
" does not correspond to the logical data type of the given values." 4750 CALL flagerror(local_error,err,error,*999)
4753 local_error=
"The size of the column indices array ("// &
4755 &
") does not conform to the number of columns in the values array ("// &
4757 CALL flagerror(local_error,err,error,*999)
4760 local_error=
"The size of the row indices array ("// &
4762 &
") does not conform to the number of rows in the values array ("// &
4764 CALL flagerror(local_error,err,error,*999)
4767 CALL flagerror(
"The matrix has not been finished.",err,error,*999)
4770 CALL flagerror(
"Matrix is not associated.",err,error,*999)
4773 exits(
"MATRIX_VALUES_SET_L2")
4775 999 errorsexits(
"MATRIX_VALUES_SET_L2",err,error)
4788 INTEGER(INTG),
INTENT(IN) ::
VALUE 4789 INTEGER(INTG),
INTENT(OUT) :: ERR
4794 enters(
"VECTOR_ALL_VALUES_SET_INTG",err,error,*999)
4796 IF(
ASSOCIATED(vector))
THEN 4797 IF(vector%VECTOR_FINISHED)
THEN 4799 vector%DATA_INTG=
VALUE 4802 &
" does not correspond to the integer data type of the given value." 4803 CALL flagerror(local_error,err,error,*999)
4806 CALL flagerror(
"The vector has not been finished.",err,error,*999)
4809 CALL flagerror(
"Vector is not associated.",err,error,*999)
4812 exits(
"VECTOR_ALL_VALUES_SET_INTG")
4814 999 errorsexits(
"VECTOR_ALL_VALUES_SET_INTG",err,error)
4827 REAL(SP),
INTENT(IN) ::
VALUE 4828 INTEGER(INTG),
INTENT(OUT) :: ERR
4833 enters(
"VECTOR_ALL_VALUES_SET_SP",err,error,*999)
4835 IF(
ASSOCIATED(vector))
THEN 4836 IF(vector%VECTOR_FINISHED)
THEN 4838 vector%DATA_SP=
VALUE 4841 &
" does not correspond to the single precision data type of the given value." 4842 CALL flagerror(local_error,err,error,*999)
4845 CALL flagerror(
"The vector has not been finished.",err,error,*999)
4848 CALL flagerror(
"Vector is not associated.",err,error,*999)
4851 exits(
"VECTOR_ALL_VALUES_SET_SP")
4853 999 errorsexits(
"VECTOR_ALL_VALUES_SET_SP",err,error)
4866 REAL(DP),
INTENT(IN) ::
VALUE 4867 INTEGER(INTG),
INTENT(OUT) :: ERR
4872 enters(
"VECTOR_ALL_VALUES_SET_DP",err,error,*999)
4874 IF(
ASSOCIATED(vector))
THEN 4875 IF(vector%VECTOR_FINISHED)
THEN 4877 vector%DATA_DP=
VALUE 4880 &
" does not correspond to the double precision data type of the given value." 4881 CALL flagerror(local_error,err,error,*999)
4884 CALL flagerror(
"The vector has not been finished.",err,error,*999)
4887 CALL flagerror(
"Vector is not associated.",err,error,*999)
4890 exits(
"VECTOR_ALL_VALUES_SET_DP")
4892 999 errorsexits(
"VECTOR_ALL_VALUES_SET_DP",err,error)
4905 LOGICAL,
INTENT(IN) ::
VALUE 4906 INTEGER(INTG),
INTENT(OUT) :: ERR
4911 enters(
"VECTOR_ALL_VALUES_SET_L",err,error,*999)
4913 IF(
ASSOCIATED(vector))
THEN 4914 IF(vector%VECTOR_FINISHED)
THEN 4919 &
" does not correspond to the logical data type of the given value." 4920 CALL flagerror(local_error,err,error,*999)
4923 CALL flagerror(
"The vector has not been finished.",err,error,*999)
4926 CALL flagerror(
"Vector is not associated.",err,error,*999)
4929 exits(
"VECTOR_ALL_VALUES_SET_L")
4931 999 errorsexits(
"VECTOR_ALL_VALUES_SET_L",err,error)
4944 INTEGER(INTG),
INTENT(OUT) :: ERR
4949 enters(
"VECTOR_CREATE_FINISH",err,error,*999)
4951 IF(
ASSOCIATED(vector))
THEN 4952 IF(vector%VECTOR_FINISHED)
THEN 4953 CALL flagerror(
"Vector has been finished.",err,error,*999)
4955 IF(vector%SIZE>0)
THEN 4956 SELECT CASE(vector%DATA_TYPE)
4958 ALLOCATE(vector%DATA_INTG(vector%SIZE),stat=err)
4959 IF(err/=0)
CALL flagerror(
"Could not allocate vector integer data.",err,error,*999)
4961 ALLOCATE(vector%DATA_SP(vector%SIZE),stat=err)
4962 IF(err/=0)
CALL flagerror(
"Could not allocate vector single precision data.",err,error,*999)
4964 ALLOCATE(vector%DATA_DP(vector%SIZE),stat=err)
4965 IF(err/=0)
CALL flagerror(
"Could not allocate vector double precision data.",err,error,*999)
4967 ALLOCATE(vector%DATA_L(vector%SIZE),stat=err)
4968 IF(err/=0)
CALL flagerror(
"Could not allocate vector logical data.",err,error,*999)
4970 local_error=
"The vector data type of "//
trim(
number_to_vstring(vector%DATA_TYPE,
"*",err,error))//
" is invalid." 4971 CALL flagerror(local_error,err,error,*999)
4976 vector%VECTOR_FINISHED=.true.
4979 CALL flagerror(
"Vector is not associated.",err,error,*999)
4982 exits(
"VECTOR_CREATE_FINISH")
4984 999 errorsexits(
"VECTOR_CREATE_FINISH",err,error)
4997 INTEGER(INTG),
INTENT(OUT) :: ERR
5001 enters(
"VECTOR_CREATE_START",err,error,*999)
5003 IF(
ASSOCIATED(vector))
THEN 5004 CALL flagerror(
"Vector is already associated.",err,error,*998)
5006 ALLOCATE(vector,stat=err)
5007 IF(err/=0)
CALL flagerror(
"Could not allocate the vector.",err,error,*999)
5013 exits(
"VECTOR_CREATE_START")
5015 999
IF(
ASSOCIATED(vector))
CALL vector_finalise(vector,err,error,*998)
5016 998 errorsexits(
"VECTOR_CREATE_START",err,error)
5029 INTEGER(INTG),
POINTER :: DATA(:)
5030 INTEGER(INTG),
INTENT(OUT) :: ERR
5035 enters(
"VECTOR_DATA_GET_INTG",err,error,*999)
5037 IF(
ASSOCIATED(vector))
THEN 5038 IF(
ASSOCIATED(data))
THEN 5039 CALL flagerror(
"Data is already associated.",err,error,*999)
5042 IF(vector%VECTOR_FINISHED)
THEN 5044 data=>vector%DATA_INTG
5047 &
" does not correspond to the integer data type of the requested values." 5048 CALL flagerror(local_error,err,error,*999)
5051 CALL flagerror(
"The vector has not been finished.",err,error,*999)
5055 CALL flagerror(
"Vector is not associated.",err,error,*999)
5058 exits(
"VECTOR_DATA_GET_INTG")
5060 999 errorsexits(
"VECTOR_DATA_GET_INTG",err,error)
5073 REAL(SP),
POINTER :: DATA(:)
5074 INTEGER(INTG),
INTENT(OUT) :: ERR
5079 enters(
"VECTOR_DATA_GET_SP",err,error,*999)
5081 IF(
ASSOCIATED(vector))
THEN 5082 IF(
ASSOCIATED(data))
THEN 5083 CALL flagerror(
"Data is already associated.",err,error,*999)
5086 IF(vector%VECTOR_FINISHED)
THEN 5088 data=>vector%DATA_SP
5091 &
" does not correspond to the single precision data type of the requested values." 5092 CALL flagerror(local_error,err,error,*999)
5095 CALL flagerror(
"The vector has not been finished.",err,error,*999)
5099 CALL flagerror(
"Vector is not associated.",err,error,*999)
5102 exits(
"VECTOR_DATA_GET_SP")
5104 999 errorsexits(
"VECTOR_DATA_GET_SP",err,error)
5117 REAL(DP),
POINTER :: DATA(:)
5118 INTEGER(INTG),
INTENT(OUT) :: ERR
5123 enters(
"VECTOR_DATA_GET_DP",err,error,*999)
5125 IF(
ASSOCIATED(vector))
THEN 5126 IF(
ASSOCIATED(data))
THEN 5127 CALL flagerror(
"Data is already associated.",err,error,*999)
5130 IF(vector%VECTOR_FINISHED)
THEN 5132 data=>vector%DATA_DP
5135 &
" does not correspond to the double precision data type of the requested values." 5136 CALL flagerror(local_error,err,error,*999)
5139 CALL flagerror(
"The vector has not been finished.",err,error,*999)
5143 CALL flagerror(
"Vector is not associated.",err,error,*999)
5146 exits(
"VECTOR_DATA_GET_DP")
5148 999 errorsexits(
"VECTOR_DATA_GET_DP",err,error)
5161 LOGICAL,
POINTER :: DATA(:)
5162 INTEGER(INTG),
INTENT(OUT) :: ERR
5167 enters(
"VECTOR_DATA_GET_L",err,error,*999)
5169 IF(
ASSOCIATED(vector))
THEN 5170 IF(
ASSOCIATED(data))
THEN 5171 CALL flagerror(
"Data is already associated.",err,error,*999)
5174 IF(vector%VECTOR_FINISHED)
THEN 5179 &
" does not correspond to the logical data type of the requested values." 5180 CALL flagerror(local_error,err,error,*999)
5183 CALL flagerror(
"The vector has not been finished.",err,error,*999)
5187 CALL flagerror(
"Vector is not associated.",err,error,*999)
5190 exits(
"VECTOR_DATA_GET_L")
5192 999 errorsexits(
"VECTOR_DATA_GET_L",err,error)
5205 INTEGER(INTG),
INTENT(OUT) :: dataType
5206 INTEGER(INTG),
INTENT(OUT) :: err
5209 enters(
"Vector_DataTypeGet",err,error,*999)
5211 IF(
ASSOCIATED(vector))
THEN 5212 IF(.NOT.vector%vector_finished)
THEN 5213 CALL flag_error(
"The vector has not been finished.",err,error,*999)
5215 datatype=vector%data_type
5218 CALL flag_error(
"Vector is not associated.",err,error,*999)
5221 exits(
"Vector_DataTypeGet")
5223 999 errorsexits(
"Vector_DataTypeGet",err,error)
5236 INTEGER(INTG),
INTENT(IN) :: DATA_TYPE
5237 INTEGER(INTG),
INTENT(OUT) :: ERR
5242 enters(
"VECTOR_DATA_TYPE_SET",err,error,*999)
5244 IF(
ASSOCIATED(vector))
THEN 5245 IF(vector%VECTOR_FINISHED)
THEN 5246 CALL flagerror(
"The vector has been finished.",err,error,*999)
5248 SELECT CASE(data_type)
5258 local_error=
"The vector data type of "//
trim(
number_to_vstring(data_type,
"*",err,error))//
" is invalid." 5259 CALL flagerror(local_error,err,error,*999)
5263 CALL flagerror(
"Vector is not associated.",err,error,*999)
5266 exits(
"VECTOR_DATA_TYPE_SET")
5268 999 errorsexits(
"VECTOR_DATA_TYPE_SET",err,error)
5281 INTEGER(INTG),
INTENT(OUT) :: ERR
5285 enters(
"VECTOR_DESTROY",err,error,*999)
5287 IF(
ASSOCIATED(vector))
THEN 5290 CALL flagerror(
"Vector is not associated.",err,error,*999)
5293 exits(
"VECTOR_DESTROY")
5295 999 errorsexits(
"VECTOR_DESTROY",err,error)
5309 INTEGER(INTG),
INTENT(OUT) :: ERR
5313 enters(
"VECTOR_DUPLICATE",err,error,*998)
5315 IF(
ASSOCIATED(vector))
THEN 5316 IF(
ASSOCIATED(new_vector))
THEN 5317 CALL flagerror(
"New vector is already associated.",err,error,*998)
5325 CALL flagerror(
"Vector is not associated.",err,error,*998)
5328 exits(
"VECTOR_DUPLICATE")
5331 998 errorsexits(
"VECTOR_DUPLICATE",err,error)
5344 INTEGER(INTG),
INTENT(OUT) :: ERR
5348 enters(
"VECTOR_FINALISE",err,error,*999)
5350 IF(
ASSOCIATED(vector))
THEN 5351 IF(
ALLOCATED(vector%DATA_INTG))
DEALLOCATE(vector%DATA_INTG)
5352 IF(
ALLOCATED(vector%DATA_SP))
DEALLOCATE(vector%DATA_SP)
5353 IF(
ALLOCATED(vector%DATA_DP))
DEALLOCATE(vector%DATA_DP)
5354 IF(
ALLOCATED(vector%DATA_L))
DEALLOCATE(vector%DATA_L)
5358 exits(
"VECTOR_FINALISE")
5360 999 errorsexits(
"VECTOR_FINALISE",err,error)
5373 INTEGER(INTG),
INTENT(OUT) :: ERR
5377 enters(
"VECTOR_INITIALISE",err,error,*999)
5379 IF(
ASSOCIATED(vector))
THEN 5382 vector%VECTOR_FINISHED=.false.
5387 CALL flagerror(
"Vector is not associated.",err,error,*999)
5390 exits(
"VECTOR_INITIALISE")
5392 999 errorsexits(
"VECTOR_INITIALISE",err,error)
5405 INTEGER(INTG),
INTENT(IN) :: N
5406 INTEGER(INTG),
INTENT(OUT) :: ERR
5411 enters(
"VECTOR_SIZE_SET",err,error,*999)
5413 IF(
ASSOCIATED(vector))
THEN 5414 IF(vector%VECTOR_FINISHED)
THEN 5415 CALL flagerror(
"The vector has been finished.",err,error,*999)
5421 &
") is invalid. The number must be >0." 5422 CALL flagerror(local_error,err,error,*999)
5426 CALL flagerror(
"Vector is not associated.",err,error,*999)
5429 exits(
"VECTOR_SIZE_SET")
5431 999 errorsexits(
"VECTOR_SIZE_SET",err,error)