107 INTEGER(INTG),
INTENT(OUT) :: ERR
110 INTEGER(INTG) :: DUMMY_ERR,matrix_idx,NUMBER_OF_NON_ZEROS
111 INTEGER(INTG),
POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
118 NULLIFY(column_indices)
121 enters(
"SOLVER_MATRICES_CREATE_FINISH",err,error,*998)
123 IF(
ASSOCIATED(solver_matrices))
THEN 124 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 125 CALL flagerror(
"Solver matrices have already been finished",err,error,*998)
127 solver_equations=>solver_matrices%SOLVER_EQUATIONS
128 IF(
ASSOCIATED(solver_equations))
THEN 129 solver_mapping=>solver_equations%SOLVER_MAPPING
130 IF(
ASSOCIATED(solver_mapping))
THEN 132 row_domain_map=>solver_mapping%ROW_DOFS_MAPPING
133 IF(
ASSOCIATED(row_domain_map))
THEN 134 DO matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
135 solver_matrix=>solver_matrices%MATRICES(matrix_idx)%PTR
136 IF(
ASSOCIATED(solver_matrix))
THEN 137 column_domain_map=>solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(matrix_idx)%COLUMN_DOFS_MAPPING
138 IF(
ASSOCIATED(column_domain_map))
THEN 141 &
ptr%MATRIX,err,error,*999)
149 & column_indices,err,error,*999)
154 IF(
ASSOCIATED(row_indices))
DEALLOCATE(row_indices)
155 IF(
ASSOCIATED(column_indices))
DEALLOCATE(column_indices)
160 &
ptr%SOLVER_VECTOR,err,error,*999)
166 CALL flagerror(
"Column domain mapping is not associated.",err,error,*999)
169 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
187 solver_matrices%SOLVER_MATRICES_FINISHED=.true.
189 CALL flagerror(
"Row domain mapping is not associated.",err,error,*998)
192 CALL flagerror(
"Solver equations solver mapping is not associated.",err,error,*998)
195 CALL flagerror(
"Solver matrices solver equations is not associated.",err,error,*998)
199 CALL flagerror(
"Solver matrices is not associated.",err,error,*998)
202 exits(
"SOLVER_MATRICES_CREATE_FINISH")
204 999
IF(
ASSOCIATED(row_indices))
DEALLOCATE(row_indices)
205 IF(
ASSOCIATED(column_indices))
DEALLOCATE(column_indices)
207 998 errorsexits(
"SOLVER_MATRICES_CREATE_FINISH",err,error)
222 INTEGER(INTG),
INTENT(OUT) :: ERR
225 INTEGER(INTG) :: DUMMY_ERR
228 enters(
"SOLVER_MATRICES_CREATE_START",err,error,*998)
230 IF(
ASSOCIATED(solver_equations))
THEN 231 IF(solver_equations%SOLVER_EQUATIONS_FINISHED)
THEN 232 IF(
ASSOCIATED(solver_matrices))
THEN 233 CALL flagerror(
"Solver matrices is already associated",err,error,*998)
235 NULLIFY(solver_equations%SOLVER_MATRICES)
237 solver_matrices=>solver_equations%SOLVER_MATRICES
240 CALL flagerror(
"Solver equations are not finished",err,error,*998)
243 CALL flagerror(
"Solver is not associated",err,error,*998)
246 exits(
"SOLVER_MATRICES_CREATE_START")
249 998 errorsexits(
"SOLVER_MATRICES_CREATE_START",err,error)
263 INTEGER(INTG),
INTENT(OUT) :: ERR
267 enters(
"SOLVER_MATRICES_DESTROY",err,error,*999)
269 IF(
ASSOCIATED(solver_matrices))
THEN 272 CALL flagerror(
"Solver matrices is not associated",err,error,*999)
275 exits(
"SOLVER_MATRICES_DESTROY")
277 999 errorsexits(
"SOLVER_MATRICES_DESTROY",err,error)
291 INTEGER(INTG),
INTENT(OUT) :: ERR
294 INTEGER(INTG) :: matrix_idx
296 enters(
"SOLVER_MATRICES_FINALISE",err,error,*999)
298 IF(
ASSOCIATED(solver_matrices))
THEN 299 IF(
ALLOCATED(solver_matrices%MATRICES))
THEN 300 DO matrix_idx=1,
SIZE(solver_matrices%MATRICES,1)
303 DEALLOCATE(solver_matrices%MATRICES)
307 DEALLOCATE(solver_matrices)
310 exits(
"SOLVER_MATRICES_FINALISE")
312 999 errorsexits(
"SOLVER_MATRICES_FINALISE",err,error)
326 INTEGER(INTG),
INTENT(OUT) :: ERR
329 INTEGER(INTG) :: DUMMY_ERR,equations_matrix_idx,equations_set_idx,matrix_idx
333 enters(
"SOLVER_MATRICES_INITIALISE",err,error,*998)
335 IF(
ASSOCIATED(solver_equations))
THEN 336 IF(
ASSOCIATED(solver_equations%SOLVER_MATRICES))
THEN 337 CALL flagerror(
"Solver matrices is already associated for this solver equations.",err,error,*998)
339 solver_mapping=>solver_equations%SOLVER_MAPPING
340 IF(
ASSOCIATED(solver_mapping))
THEN 341 ALLOCATE(solver_equations%SOLVER_MATRICES,stat=err)
342 IF(err/=0)
CALL flagerror(
"Could not allocate solver matrices.",err,error,*999)
343 solver_equations%SOLVER_MATRICES%SOLVER_EQUATIONS=>solver_equations
344 solver_equations%SOLVER_MATRICES%SOLVER_MATRICES_FINISHED=.false.
345 solver_equations%SOLVER_MATRICES%SOLVER_MAPPING=>solver_mapping
346 solver_equations%SOLVER_MATRICES%NUMBER_OF_ROWS=solver_mapping%NUMBER_OF_ROWS
347 solver_equations%SOLVER_MATRICES%NUMBER_OF_GLOBAL_ROWS=solver_mapping%NUMBER_OF_GLOBAL_ROWS
349 solver_equations%SOLVER_MATRICES%NUMBER_OF_MATRICES=solver_mapping%NUMBER_OF_SOLVER_MATRICES
350 ALLOCATE(solver_equations%SOLVER_MATRICES%MATRICES(solver_mapping%NUMBER_OF_SOLVER_MATRICES),stat=err)
351 IF(err/=0)
CALL flagerror(
"Could not allocate solver matrices matrices.",err,error,*999)
352 DO matrix_idx=1,solver_mapping%NUMBER_OF_SOLVER_MATRICES
353 NULLIFY(solver_equations%SOLVER_MATRICES%MATRICES(matrix_idx)%PTR)
355 DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
356 IF(
ALLOCATED(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS_TO_SOLVER_MATRIX_MAPS_SM( &
357 & matrix_idx)%DYNAMIC_EQUATIONS_TO_SOLVER_MATRIX_MAPS))
THEN 358 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
359 & equations_to_solver_matrix_maps_sm(matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
361 solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS_TO_SOLVER_MATRIX_MAPS_SM( &
362 & matrix_idx)%DYNAMIC_EQUATIONS_TO_SOLVER_MATRIX_MAPS(equations_matrix_idx)%PTR%SOLVER_MATRIX=> &
363 & solver_equations%SOLVER_MATRICES%MATRICES(matrix_idx)%PTR
366 IF(
ALLOCATED(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
367 & equations_to_solver_matrix_maps_sm(matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS))
THEN 368 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
369 & equations_to_solver_matrix_maps_sm(matrix_idx)%NUMBER_OF_EQUATIONS_JACOBIANS
370 solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
371 & equations_to_solver_matrix_maps_sm(matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS(equations_matrix_idx)%PTR% &
372 & solver_matrix=>solver_equations%SOLVER_MATRICES%MATRICES(matrix_idx)%PTR
375 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
376 & equations_to_solver_matrix_maps_sm(matrix_idx)%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
378 solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)%EQUATIONS_TO_SOLVER_MATRIX_MAPS_SM( &
379 & matrix_idx)%LINEAR_EQUATIONS_TO_SOLVER_MATRIX_MAPS(equations_matrix_idx)%PTR%SOLVER_MATRIX=> &
380 & solver_equations%SOLVER_MATRICES%MATRICES(matrix_idx)%PTR
387 solver_equations%SOLVER_MATRICES%UPDATE_RESIDUAL=.true.
389 solver_equations%SOLVER_MATRICES%UPDATE_RESIDUAL=.false.
391 NULLIFY(solver_equations%SOLVER_MATRICES%RESIDUAL)
392 solver_equations%SOLVER_MATRICES%UPDATE_RHS_VECTOR=.true.
393 NULLIFY(solver_equations%SOLVER_MATRICES%RHS_VECTOR)
395 CALL flagerror(
"Solver equations solver mapping is not associated",err,error,*999)
399 CALL flagerror(
"Solver equations is not associated",err,error,*998)
402 exits(
"SOLVER_MATRICES_INITIALISE")
405 998 errorsexits(
"SOLVER_MATRICES_INITIALISE",err,error)
419 INTEGER(INTG),
INTENT(OUT) :: LIBRARY_TYPE
420 INTEGER(INTG),
INTENT(OUT) :: ERR
424 enters(
"SOLVER_MATRICES_LIBRARY_TYPE_GET",err,error,*999)
426 IF(
ASSOCIATED(solver_matrices))
THEN 427 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 428 library_type=solver_matrices%LIBRARY_TYPE
430 CALL flagerror(
"Solver matrices has not finished.",err,error,*999)
433 CALL flagerror(
"Solver matrices is not associated.",err,error,*999)
436 exits(
"SOLVER_MATRICES_LIBRARY_TYPE_GET")
438 999 errorsexits(
"SOLVER_MATRICES_LIBRARY_TYPE_GET",err,error)
452 INTEGER(INTG),
INTENT(IN) :: LIBRARY_TYPE
453 INTEGER(INTG),
INTENT(OUT) :: ERR
458 enters(
"SOLVER_MATRICES_LIBRARY_TYPE_SET",err,error,*999)
460 IF(
ASSOCIATED(solver_matrices))
THEN 461 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 462 CALL flagerror(
"Solver matrices has been finished.",err,error,*999)
464 SELECT CASE(library_type)
470 local_error=
"The library type of "//
trim(
number_to_vstring(library_type,
"*",err,error))//
" is invalid." 471 CALL flagerror(local_error,err,error,*999)
475 CALL flagerror(
"Solver matrices is not associated.",err,error,*999)
478 exits(
"SOLVER_MATRICES_LIBRARY_TYPE_SET")
480 999 errorsexits(
"SOLVER_MATRICES_LIBRARY_TYPE_SET",err,error)
492 INTEGER(INTG),
INTENT(IN) :: ID
493 INTEGER(INTG),
INTENT(IN) :: SELECTION_TYPE
495 INTEGER(INTG),
INTENT(OUT) :: ERR
498 INTEGER(INTG) :: matrix_idx
501 enters(
"SOLVER_MATRICES_OUTPUT",err,error,*999)
503 IF(
ASSOCIATED(solver_matrices))
THEN 504 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 505 CALL write_string(id,
"",err,error,*999)
511 CALL write_string(id,
"Solver matrices:",err,error,*999)
512 CALL write_string_value(id,
"Number of matrices = ",solver_matrices%NUMBER_OF_MATRICES,err,error,*999)
513 DO matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
514 solver_matrix=>solver_matrices%MATRICES(matrix_idx)%PTR
515 IF(
ASSOCIATED(solver_matrix))
THEN 516 CALL write_string_value(id,
"Solver matrix : ",matrix_idx,err,error,*999)
519 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
527 IF(
ASSOCIATED(solver_matrices%RESIDUAL))
THEN 528 CALL write_string(id,
"Solver residual vector:",err,error,*999)
538 IF(
ASSOCIATED(solver_matrices%RHS_VECTOR))
THEN 539 CALL write_string(id,
"Solver RHS vector:",err,error,*999)
544 CALL flagerror(
"Solver matrices have not been finished.",err,error,*999)
547 CALL flagerror(
"Solver matrices is not associated.",err,error,*999)
550 exits(
"SOLVER_MATRICES_OUTPUT")
552 999 errorsexits(
"SOLVER_MATRICES_OUTPUT",err,error)
565 INTEGER(INTG),
INTENT(OUT) :: STORAGE_TYPE(:)
566 INTEGER(INTG),
INTENT(OUT) :: ERR
569 INTEGER(INTG) :: matrix_idx
573 enters(
"SOLVER_MATRICES_STORAGE_TYPE_GET",err,error,*999)
575 IF(
ASSOCIATED(solver_matrices))
THEN 576 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 577 IF(
SIZE(storage_type,1)>=solver_matrices%NUMBER_OF_MATRICES)
THEN 578 DO matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
579 solver_matrix=>solver_matrices%MATRICES(matrix_idx)%PTR
580 IF(
ASSOCIATED(solver_matrix))
THEN 581 storage_type(matrix_idx)=solver_matrix%STORAGE_TYPE
583 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
587 local_error=
"The size of STORAGE_TYPE is too small. The supplied size is "// &
590 CALL flagerror(local_error,err,error,*999)
593 CALL flagerror(
"Solver matrices have not finished.",err,error,*999)
596 CALL flagerror(
"Solver matrices is not associated.",err,error,*999)
599 exits(
"SOLVER_MATRICES_STORAGE_TYPE_GET")
601 999 errorsexits(
"SOLVER_MATRICES_STORAGE_TYPE_GET",err,error)
614 INTEGER(INTG),
INTENT(IN) :: STORAGE_TYPE(:)
615 INTEGER(INTG),
INTENT(OUT) :: ERR
618 INTEGER(INTG) :: matrix_idx
622 enters(
"SOLVER_MATRICES_STORAGE_TYPE_SET",err,error,*999)
624 IF(
ASSOCIATED(solver_matrices))
THEN 625 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 626 CALL flagerror(
"Solver matrices have been finished.",err,error,*999)
628 IF(
SIZE(storage_type,1)==solver_matrices%NUMBER_OF_MATRICES)
THEN 629 DO matrix_idx=1,solver_matrices%NUMBER_OF_MATRICES
630 solver_matrix=>solver_matrices%MATRICES(matrix_idx)%PTR
631 IF(
ASSOCIATED(solver_matrix))
THEN 632 SELECT CASE(storage_type(matrix_idx))
648 local_error=
"The specified storage type of "//
trim(
number_to_vstring(storage_type(matrix_idx),
"*",err,error))// &
650 CALL flagerror(local_error,err,error,*999)
653 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
657 local_error=
"The size of the storage type array ("//
trim(
number_to_vstring(
SIZE(storage_type,1),
"*",err,error))// &
658 &
") is not equal to the number of matrices ("// &
660 CALL flagerror(local_error,err,error,*999)
664 CALL flagerror(
"Solver matrices is not associated.",err,error,*999)
667 exits(
"SOLVER_MATRICES_STORAGE_TYPE_SET")
669 999 errorsexits(
"SOLVER_MATRICES_STORAGE_TYPE_SET",err,error)
682 INTEGER(INTG),
INTENT(IN) :: equations_set_idx
683 REAL(DP),
INTENT(IN) :: ALPHA
685 INTEGER(INTG),
INTENT(OUT) :: ERR
688 INTEGER(INTG) :: equations_column_idx,equations_column_number,equations_row_number,EQUATIONS_STORAGE_TYPE, &
689 & solver_column_idx,solver_column_number,solver_row_idx,solver_row_number
690 INTEGER(INTG),
POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
691 REAL(DP) :: column_coupling_coefficient,row_coupling_coefficient,VALUE
692 REAL(DP),
POINTER :: EQUATIONS_MATRIX_DATA(:)
702 enters(
"SOLVER_MATRIX_EQUATIONS_MATRIX_ADD",err,error,*999)
704 NULLIFY(equations_matrix_data)
705 NULLIFY(column_indices)
708 IF(
ASSOCIATED(solver_matrix))
THEN 709 IF(
ASSOCIATED(equations_matrix))
THEN 710 IF(abs(alpha)>zero_tolerance)
THEN 711 solver_matrices=>solver_matrix%SOLVER_MATRICES
712 IF(
ASSOCIATED(solver_matrices))
THEN 713 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 714 solver_mapping=>solver_matrices%SOLVER_MAPPING
715 IF(
ASSOCIATED(solver_mapping))
THEN 716 linear_matrices=>equations_matrix%LINEAR_MATRICES
717 dynamic_matrices=>equations_matrix%DYNAMIC_MATRICES
718 IF(
ASSOCIATED(dynamic_matrices).OR.
ASSOCIATED(linear_matrices))
THEN 719 IF(
ASSOCIATED(dynamic_matrices))
THEN 720 equations_matrices=>dynamic_matrices%EQUATIONS_MATRICES
722 equations_matrices=>linear_matrices%EQUATIONS_MATRICES
724 IF(
ASSOCIATED(equations_matrices))
THEN 725 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 726 IF(equations_set_idx>0.AND.equations_set_idx<=solver_mapping%NUMBER_OF_EQUATIONS_SETS)
THEN 727 equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
728 & equations_to_solver_matrix_maps_em(equations_matrix%MATRIX_NUMBER)% &
729 & equations_to_solver_matrix_maps(solver_matrix%MATRIX_NUMBER)%PTR
730 IF(
ASSOCIATED(equations_to_solver_map))
THEN 731 solver_distributed_matrix=>solver_matrix%MATRIX
732 IF(
ASSOCIATED(solver_distributed_matrix))
THEN 733 equations_distributed_matrix=>equations_matrix%MATRIX
734 IF(
ASSOCIATED(equations_distributed_matrix))
THEN 738 SELECT CASE(equations_storage_type)
741 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
743 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
744 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
745 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
746 & equations_row_to_solver_rows_maps(equations_row_number)% &
747 & solver_rows(solver_row_idx)
748 row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
749 & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
750 & coupling_coefficients(solver_row_idx)
752 DO equations_column_number=1,equations_matrix%NUMBER_OF_COLUMNS
754 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
755 & equations_column_number)%NUMBER_OF_SOLVER_COLS
756 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
757 & equations_column_number)%SOLVER_COLS(solver_column_idx)
758 column_coupling_coefficient=equations_to_solver_map% &
759 & equations_col_to_solver_cols_map(equations_column_number)% &
760 & coupling_coefficients(solver_column_idx)
762 VALUE=alpha*equations_matrix_data(equations_row_number+ &
763 & (equations_column_number-1)*equations_matrices%TOTAL_NUMBER_OF_ROWS)* &
764 & row_coupling_coefficient*column_coupling_coefficient
766 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
773 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
775 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
776 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
777 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
778 & equations_row_to_solver_rows_maps(equations_row_number)% &
779 & solver_rows(solver_row_idx)
780 row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
781 & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
782 & coupling_coefficients(solver_row_idx)
783 equations_column_number=equations_row_number
785 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
786 & equations_column_number)%NUMBER_OF_SOLVER_COLS
787 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
788 & equations_column_number)%SOLVER_COLS(solver_column_idx)
789 column_coupling_coefficient=equations_to_solver_map% &
790 & equations_col_to_solver_cols_map(equations_column_number)% &
791 & coupling_coefficients(solver_column_idx)
793 VALUE=alpha*equations_matrix_data(equations_row_number)* &
794 & row_coupling_coefficient*column_coupling_coefficient
796 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
801 CALL flagerror(
"Not implemented.",err,error,*999)
803 CALL flagerror(
"Not implemented.",err,error,*999)
806 & row_indices,column_indices,err,error,*999)
808 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
810 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
811 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
812 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
813 & equations_row_to_solver_rows_maps(equations_row_number)% &
814 & solver_rows(solver_row_idx)
815 row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
816 & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(equations_row_number)% &
817 & coupling_coefficients(solver_row_idx)
819 DO equations_column_idx=row_indices(equations_row_number),row_indices(equations_row_number+1)-1
820 equations_column_number=column_indices(equations_column_idx)
822 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
823 & equations_column_number)%NUMBER_OF_SOLVER_COLS
824 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
825 & equations_column_number)%SOLVER_COLS(solver_column_idx)
826 column_coupling_coefficient=equations_to_solver_map% &
827 & equations_col_to_solver_cols_map(equations_column_number)% &
828 & coupling_coefficients(solver_column_idx)
830 VALUE=alpha*equations_matrix_data(equations_column_idx)*row_coupling_coefficient* &
831 & column_coupling_coefficient
833 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
839 CALL flagerror(
"Not implemented.",err,error,*999)
841 CALL flagerror(
"Not implemented.",err,error,*999)
843 local_error=
"The equations matrix storage type of "// &
845 CALL flagerror(local_error,err,error,*999)
850 CALL flagerror(
"The equations matrix distributed matrix is not associated",err,error,*999)
853 CALL flagerror(
"Solver matrix distributed matrix is not associated.",err,error,*999)
856 CALL flagerror(
"Equations to solver map is not associated.",err,error,*999)
859 local_error=
"The specified equations set index of "// &
861 &
" is invalid. The equations set index needs to be between 1 and "// &
863 CALL flagerror(local_error,err,error,*999)
866 CALL flagerror(
"Equations matrices have not been finished.",err,error,*999)
869 CALL flagerror(
"Dynamic or linear matrices equations matrices is not associated.",err,error,*999)
872 CALL flagerror(
"Equations matrix dynamic or linear matrices is not associated.",err,error,*999)
875 CALL flagerror(
"Solver matrices solver mapping is not associated.",err,error,*999)
878 CALL flagerror(
"Solver matrices have not been finished.",err,error,*999)
881 CALL flagerror(
"Solver matrix solver matrices is not associated.",err,error,*999)
885 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
888 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
891 exits(
"SOLVER_MATRIX_EQUATIONS_MATRIX_ADD")
893 999 errorsexits(
"SOLVER_MATRIX_EQUATIONS_MATRIX_ADD",err,error)
906 INTEGER(INTG),
INTENT(IN) :: interface_condition_idx
907 REAL(DP),
INTENT(IN) :: ALPHA(2)
909 INTEGER(INTG),
INTENT(OUT) :: ERR
912 INTEGER(INTG) :: interface_column_idx,interface_column_number,interface_row_idx,interface_row_number,INTERFACE_STORAGE_TYPE, &
913 & solver_column_idx,solver_column_number,solver_row_idx,solver_row_number
914 INTEGER(INTG),
POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
915 REAL(DP) :: column_coupling_coefficient,row_coupling_coefficient,VALUE
916 REAL(DP),
POINTER :: INTERFACE_MATRIX_DATA(:)
924 enters(
"SOLVER_MATRIX_INTERFACE_MATRIX_ADD",err,error,*999)
926 NULLIFY(interface_matrix_data)
927 NULLIFY(column_indices)
930 IF(
ASSOCIATED(solver_matrix))
THEN 931 IF(
ASSOCIATED(interface_matrix))
THEN 932 IF(abs(alpha(1))>zero_tolerance)
THEN 933 solver_matrices=>solver_matrix%SOLVER_MATRICES
934 IF(
ASSOCIATED(solver_matrices))
THEN 935 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 936 solver_mapping=>solver_matrices%SOLVER_MAPPING
937 IF(
ASSOCIATED(solver_mapping))
THEN 938 interface_matrices=>interface_matrix%INTERFACE_MATRICES
939 IF(
ASSOCIATED(interface_matrices))
THEN 940 IF(interface_matrices%INTERFACE_MATRICES_FINISHED)
THEN 941 IF(interface_condition_idx>0.AND.interface_condition_idx<=solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS)
THEN 942 interface_to_solver_map=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
943 & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)%INTERFACE_TO_SOLVER_MATRIX_MAPS( &
944 & solver_matrix%MATRIX_NUMBER)%PTR
945 IF(
ASSOCIATED(interface_to_solver_map))
THEN 946 solver_distributed_matrix=>solver_matrix%MATRIX
947 IF(
ASSOCIATED(solver_distributed_matrix))
THEN 948 interface_distributed_matrix=>interface_matrix%MATRIX
949 IF(
ASSOCIATED(interface_distributed_matrix))
THEN 953 SELECT CASE(interface_storage_type)
956 DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
958 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
959 & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
960 & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS
961 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
962 & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
963 & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
964 row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
965 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_IM(interface_matrix%MATRIX_NUMBER)% &
966 & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
968 DO interface_column_number=1,interface_matrices%TOTAL_NUMBER_OF_COLUMNS
970 DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
971 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
972 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
973 & interface_column_number)%NUMBER_OF_SOLVER_COLS
974 solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
975 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
976 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
977 & interface_column_number)%SOLVER_COLS(solver_column_idx)
978 column_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
979 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
980 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
981 & interface_column_number)%COUPLING_COEFFICIENTS(solver_column_idx)
983 VALUE=alpha(1)*interface_matrix_data(interface_row_number+ &
984 & (interface_column_number-1)*interface_matrix%TOTAL_NUMBER_OF_ROWS)* &
985 & row_coupling_coefficient*column_coupling_coefficient
987 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
994 DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
996 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
997 & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
998 & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS
999 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1000 & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
1001 & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
1002 row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1003 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_IM(interface_matrix%MATRIX_NUMBER)% &
1004 & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
1005 interface_column_number=interface_row_number
1007 DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1008 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1009 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1010 & interface_column_number)%NUMBER_OF_SOLVER_COLS
1011 solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1012 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1013 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1014 & interface_column_number)%SOLVER_COLS(solver_column_idx)
1015 column_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1016 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1017 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1018 & interface_column_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1020 VALUE=alpha(1)*interface_matrix_data(interface_row_number)* &
1021 & row_coupling_coefficient*column_coupling_coefficient
1023 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
1028 CALL flagerror(
"Not implemented.",err,error,*999)
1030 CALL flagerror(
"Not implemented.",err,error,*999)
1033 & row_indices,column_indices,err,error,*999)
1035 DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
1037 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1038 & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
1039 & interface_row_to_solver_rows_map(interface_row_number)%NUMBER_OF_SOLVER_ROWS
1040 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1041 & interface_to_solver_matrix_maps_im(interface_matrix%MATRIX_NUMBER)% &
1042 & interface_row_to_solver_rows_map(interface_row_number)%SOLVER_ROW
1043 row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1044 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_IM(interface_matrix%MATRIX_NUMBER)% &
1045 & interface_row_to_solver_rows_map(interface_row_number)%COUPLING_COEFFICIENT
1047 DO interface_column_idx=row_indices(interface_row_number),row_indices(interface_row_number+1)-1
1048 interface_column_number=column_indices(interface_column_idx)
1050 DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1051 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1052 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1053 & interface_column_number)%NUMBER_OF_SOLVER_COLS
1054 solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1055 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1056 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1057 & interface_column_number)%SOLVER_COLS(solver_column_idx)
1058 column_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1059 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM( &
1060 & solver_matrix%MATRIX_NUMBER)%INTERFACE_COL_TO_SOLVER_COLS_MAP( &
1061 & interface_column_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1063 VALUE=alpha(1)*interface_matrix_data(interface_column_idx)*row_coupling_coefficient* &
1064 & column_coupling_coefficient
1066 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
1072 CALL flagerror(
"Not implemented.",err,error,*999)
1074 CALL flagerror(
"Not implemented.",err,error,*999)
1076 local_error=
"The interface matrix storage type of "// &
1078 CALL flagerror(local_error,err,error,*999)
1082 IF(interface_matrix%HAS_TRANSPOSE)
THEN 1083 IF(abs(alpha(2))>zero_tolerance)
THEN 1084 interface_distributed_matrix=>interface_matrix%MATRIX_TRANSPOSE
1085 IF(
ASSOCIATED(interface_distributed_matrix))
THEN 1090 SELECT CASE(interface_storage_type)
1093 DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
1095 DO solver_row_idx=1,solver_mapping% &
1096 & interface_condition_to_solver_map(interface_condition_idx)% &
1097 & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
1098 solver_row_number=solver_mapping% &
1099 & interface_condition_to_solver_map(interface_condition_idx)% &
1100 & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
1101 row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1102 & interface_condition_idx)% &
1103 & interface_column_to_solver_rows_maps(interface_column_number)%COUPLING_COEFFICIENT
1105 DO interface_row_number=1,interface_matrix%TOTAL_NUMBER_OF_ROWS
1107 DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1108 & interface_row_number)%NUMBER_OF_SOLVER_COLS
1109 solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1110 & interface_row_number)%SOLVER_COLS(solver_column_idx)
1111 column_coupling_coefficient=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1112 & interface_row_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1114 VALUE=alpha(2)*interface_matrix_data(interface_column_number+ &
1115 & (interface_row_number-1)*interface_matrices%TOTAL_NUMBER_OF_COLUMNS)* &
1116 & row_coupling_coefficient*column_coupling_coefficient
1118 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
1125 DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
1127 DO solver_row_idx=1,solver_mapping% &
1128 & interface_condition_to_solver_map(interface_condition_idx)% &
1129 & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
1130 solver_row_number=solver_mapping% &
1131 & interface_condition_to_solver_map(interface_condition_idx)% &
1132 & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
1133 row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1134 & interface_condition_idx)% &
1135 & interface_column_to_solver_rows_maps(interface_column_number)%COUPLING_COEFFICIENT
1136 interface_row_number=interface_column_number
1138 DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1139 & interface_row_number)%NUMBER_OF_SOLVER_COLS
1140 solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1141 & interface_row_number)%SOLVER_COLS(solver_column_idx)
1142 column_coupling_coefficient=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1143 & interface_row_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1145 VALUE=alpha(2)*interface_matrix_data(interface_column_number)* &
1146 & row_coupling_coefficient*column_coupling_coefficient
1148 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
1153 CALL flagerror(
"Not implemented.",err,error,*999)
1155 CALL flagerror(
"Not implemented.",err,error,*999)
1158 & row_indices,column_indices,err,error,*999)
1160 DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
1162 DO solver_row_idx=1,solver_mapping% &
1163 & interface_condition_to_solver_map(interface_condition_idx)% &
1164 & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
1165 solver_row_number=solver_mapping% &
1166 & interface_condition_to_solver_map(interface_condition_idx)% &
1167 & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
1168 row_coupling_coefficient=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
1169 & interface_condition_idx)% &
1170 & interface_column_to_solver_rows_maps(interface_column_number)%COUPLING_COEFFICIENT
1172 DO interface_row_idx=row_indices(interface_column_number), &
1173 & row_indices(interface_column_number+1)-1
1174 interface_row_number=column_indices(interface_row_idx)
1176 DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1177 & interface_row_number)%NUMBER_OF_SOLVER_COLS
1178 solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1179 & interface_row_number)%SOLVER_COLS(solver_column_idx)
1180 column_coupling_coefficient=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
1181 & interface_row_number)%COUPLING_COEFFICIENTS(solver_column_idx)
1183 VALUE=alpha(2)*interface_matrix_data(interface_row_idx)*row_coupling_coefficient* &
1184 & column_coupling_coefficient
1186 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
1192 CALL flagerror(
"Not implemented.",err,error,*999)
1194 CALL flagerror(
"Not implemented.",err,error,*999)
1196 local_error=
"The interface matrix storage type of "// &
1198 CALL flagerror(local_error,err,error,*999)
1203 CALL flagerror(
"The transpose interface matrix distributed matrix is not associated", &
1209 CALL flagerror(
"The interface matrix distributed matrix is not associated",err,error,*999)
1212 CALL flagerror(
"Solver matrix distributed matrix is not associated.",err,error,*999)
1215 CALL flagerror(
"Interface to solver map is not associated.",err,error,*999)
1218 local_error=
"The specified interface condition index of "// &
1220 &
" is invalid. The interface condition index needs to be between 1 and "// &
1222 CALL flagerror(local_error,err,error,*999)
1225 CALL flagerror(
"Interface matrices have not been finished.",err,error,*999)
1228 CALL flagerror(
"Interface matrix interface matrices is not associated.",err,error,*999)
1231 CALL flagerror(
"Solver matrices solver mapping is not associated.",err,error,*999)
1234 CALL flagerror(
"Solver matrices have not been finished.",err,error,*999)
1237 CALL flagerror(
"Solver matrix solver matrices is not associated.",err,error,*999)
1241 CALL flagerror(
"Interface matrix is not associated.",err,error,*999)
1244 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
1247 exits(
"SOLVER_MATRIX_INTERFACE_MATRIX_ADD")
1249 999 errorsexits(
"SOLVER_MATRIX_INTERFACE_MATRIX_ADD",err,error)
1262 INTEGER(INTG),
INTENT(IN) :: equations_set_idx
1263 REAL(DP),
INTENT(IN) :: ALPHA
1265 INTEGER(INTG),
INTENT(OUT) :: ERR
1268 INTEGER(INTG) :: jacobian_column_idx,jacobian_column_number,jacobian_row_number,JACOBIAN_STORAGE_TYPE, &
1269 & solver_column_idx,solver_column_number,solver_row_idx,solver_row_number
1270 INTEGER(INTG),
POINTER :: COLUMN_INDICES(:),ROW_INDICES(:)
1271 REAL(DP) :: column_coupling_coefficient,row_coupling_coefficient,VALUE
1272 REAL(DP),
POINTER :: JACOBIAN_MATRIX_DATA(:)
1281 enters(
"SOLVER_MATRIX_JACOBIAN_MATRIX_ADD",err,error,*999)
1283 IF(
ASSOCIATED(solver_matrix))
THEN 1284 NULLIFY(solver_matrices)
1285 NULLIFY(solver_mapping)
1286 NULLIFY(nonlinear_matrices)
1287 NULLIFY(equations_matrices)
1288 NULLIFY(jacobian_to_solver_map)
1289 NULLIFY(solver_distributed_matrix)
1290 NULLIFY(jacobian_distributed_matrix)
1291 NULLIFY(jacobian_matrix_data)
1293 IF(
ASSOCIATED(jacobian_matrix))
THEN 1294 IF(abs(alpha)>zero_tolerance)
THEN 1295 solver_matrices=>solver_matrix%SOLVER_MATRICES
1296 IF(
ASSOCIATED(solver_matrices))
THEN 1297 IF(solver_matrices%SOLVER_MATRICES_FINISHED)
THEN 1298 solver_mapping=>solver_matrices%SOLVER_MAPPING
1299 IF(
ASSOCIATED(solver_mapping))
THEN 1300 nonlinear_matrices=>jacobian_matrix%NONLINEAR_MATRICES
1302 IF(
ASSOCIATED(nonlinear_matrices))
THEN 1303 equations_matrices=>nonlinear_matrices%EQUATIONS_MATRICES
1304 IF(
ASSOCIATED(equations_matrices))
THEN 1305 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 1306 IF(equations_set_idx>0.AND.equations_set_idx<=solver_mapping%NUMBER_OF_EQUATIONS_SETS)
THEN 1307 jacobian_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1308 & equations_to_solver_matrix_maps_sm(solver_matrix%MATRIX_NUMBER)%JACOBIAN_TO_SOLVER_MATRIX_MAPS( &
1309 & jacobian_matrix%JACOBIAN_NUMBER)%PTR
1310 IF(
ASSOCIATED(jacobian_to_solver_map))
THEN 1311 solver_distributed_matrix=>solver_matrix%MATRIX
1312 IF(
ASSOCIATED(solver_distributed_matrix))
THEN 1313 jacobian_distributed_matrix=>jacobian_matrix%JACOBIAN
1314 IF(
ASSOCIATED(jacobian_distributed_matrix))
THEN 1319 SELECT CASE(jacobian_storage_type)
1322 DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1324 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1325 & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1326 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1327 & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1328 & solver_rows(solver_row_idx)
1329 row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
1330 & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(jacobian_row_number)% &
1331 & coupling_coefficients(solver_row_idx)
1333 DO jacobian_column_number=1,jacobian_matrix%NUMBER_OF_COLUMNS
1335 DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1336 & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1337 solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1338 & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1339 column_coupling_coefficient=jacobian_to_solver_map% &
1340 & jacobian_col_to_solver_cols_map(jacobian_column_number)% &
1341 & coupling_coefficients(solver_column_idx)
1343 VALUE=alpha*jacobian_matrix_data(jacobian_row_number+(jacobian_column_number-1)* &
1344 & equations_matrices%TOTAL_NUMBER_OF_ROWS)*row_coupling_coefficient* &
1345 & column_coupling_coefficient
1347 & solver_column_number,
VALUE,err,error,*999)
1354 DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1356 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1357 & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1358 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1359 & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1360 & solver_rows(solver_row_idx)
1361 row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
1362 & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(jacobian_row_number)% &
1363 & coupling_coefficients(solver_row_idx)
1364 jacobian_column_number=jacobian_row_number
1366 DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1367 & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1368 solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1369 & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1370 column_coupling_coefficient=jacobian_to_solver_map% &
1371 & jacobian_col_to_solver_cols_map(jacobian_column_number)% &
1372 & coupling_coefficients(solver_column_idx)
1374 VALUE=alpha*jacobian_matrix_data(jacobian_row_number)* &
1375 & row_coupling_coefficient*column_coupling_coefficient
1377 & solver_row_number,solver_column_number,
VALUE,err,error,*999)
1382 CALL flagerror(
"Not implemented.",err,error,*999)
1384 CALL flagerror(
"Not implemented.",err,error,*999)
1387 & column_indices,err,error,*999)
1389 DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1391 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1392 & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1393 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1394 & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1395 & solver_rows(solver_row_idx)
1396 row_coupling_coefficient=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP( &
1397 & equations_set_idx)%EQUATIONS_ROW_TO_SOLVER_ROWS_MAPS(jacobian_row_number)% &
1398 & coupling_coefficients(solver_row_idx)
1400 DO jacobian_column_idx=row_indices(jacobian_row_number), &
1401 & row_indices(jacobian_row_number+1)-1
1402 jacobian_column_number=column_indices(jacobian_column_idx)
1404 DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1405 & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1406 solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1407 & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1408 column_coupling_coefficient=jacobian_to_solver_map% &
1409 & jacobian_col_to_solver_cols_map(jacobian_column_number)% &
1410 & coupling_coefficients(solver_column_idx)
1412 VALUE=alpha*jacobian_matrix_data(jacobian_column_idx)*row_coupling_coefficient* &
1413 & column_coupling_coefficient
1415 & solver_column_number,
VALUE,err,error,*999)
1421 CALL flagerror(
"Not implemented.",err,error,*999)
1423 CALL flagerror(
"Not implemented.",err,error,*999)
1425 local_error=
"The Jacobian matrix storage type of "// &
1427 CALL flagerror(local_error,err,error,*999)
1432 CALL flagerror(
"The Jacobian matrix distributed matrix is not associated",err,error,*999)
1435 CALL flagerror(
"Solver matrix distributed matrix is not associated.",err,error,*999)
1438 CALL flagerror(
"Jacobian to solver map is not associated.",err,error,*999)
1441 local_error=
"The specified equations set index of "// &
1443 &
" is invalid. The equations set index needs to be between 1 and "// &
1445 CALL flagerror(local_error,err,error,*999)
1448 CALL flagerror(
"Equations matrices have not been finished.",err,error,*999)
1451 CALL flagerror(
"Nonlinear matrices equations matrices is not associated.",err,error,*999)
1454 CALL flagerror(
"Jacobian matrix nonlinear matrices is not associated.",err,error,*999)
1457 CALL flagerror(
"Solver matrices solver mapping is not associated.",err,error,*999)
1460 CALL flagerror(
"Solver matrices have not been finished.",err,error,*999)
1463 CALL flagerror(
"Solver matrix solver matrices is not associated.",err,error,*999)
1467 CALL flagerror(
"Jacobian matrix is not associated.",err,error,*999)
1470 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
1473 exits(
"SOLVER_MATRIX_JACOBIAN_MATRIX_ADD")
1475 999 errorsexits(
"SOLVER_MATRIX_JACOBIAN_MATRIX_ADD",err,error)
1488 INTEGER(INTG),
INTENT(OUT) :: NUMBER_OF_NON_ZEROS
1489 INTEGER(INTG),
POINTER :: ROW_INDICES(:)
1490 INTEGER(INTG),
POINTER :: COLUMN_INDICES(:)
1491 INTEGER(INTG),
INTENT(OUT) :: ERR
1494 INTEGER(INTG) :: equations_column_idx,equations_column_number,DUMMY_ERR,equations_matrix_idx,equations_row_number, &
1495 & equations_set_idx,EQUATIONS_STORAGE_TYPE,interface_column_idx,interface_column_number,interface_condition_idx, &
1496 & interface_matrix_idx,interface_row_number,interface_row_idx,INTERFACE_STORAGE_TYPE,jacobian_column_idx, &
1497 & jacobian_column_number,jacobian_row_number,MAX_COLUMN_INDICES,MAX_COLUMNS_PER_ROW,MAX_TRANSPOSE_COLUMNS_PER_ROW, &
1498 & NUMBER_OF_COLUMNS,solver_column_idx,solver_column_number,solver_matrix_idx,solver_row_idx,solver_row_number
1499 INTEGER(INTG),
ALLOCATABLE :: COLUMNS(:)
1500 INTEGER(INTG),
POINTER :: EQUATIONS_ROW_INDICES(:),EQUATIONS_COLUMN_INDICES(:),INTERFACE_ROW_INDICES(:), &
1501 & INTERFACE_COLUMN_INDICES(:)
1502 REAL(DP) :: SPARSITY
1521 enters(
"SOLVER_MATRIX_STRUCTURE_CALCULATE",err,error,*999)
1523 number_of_non_zeros=0
1524 IF(
ASSOCIATED(solver_matrix))
THEN 1525 IF(.NOT.
ASSOCIATED(row_indices))
THEN 1526 IF(.NOT.
ASSOCIATED(column_indices))
THEN 1527 solver_distributed_matrix=>solver_matrix%MATRIX
1528 IF(
ASSOCIATED(solver_distributed_matrix))
THEN 1529 IF(solver_distributed_matrix%MATRIX_FINISHED)
THEN 1530 CALL flagerror(
"The solver distributed matrix has already been finished.",err,error,*998)
1532 solver_matrices=>solver_matrix%SOLVER_MATRICES
1533 IF(
ASSOCIATED(solver_matrices))
THEN 1534 solver_mapping=>solver_matrices%SOLVER_MAPPING
1535 IF(
ASSOCIATED(solver_mapping))
THEN 1536 SELECT CASE(solver_matrix%STORAGE_TYPE)
1538 CALL flagerror(
"Can not calcualte the structure for a block storage matrix.",err,error,*999)
1540 CALL flagerror(
"Can not calcualte the structure for a diagonal matrix.",err,error,*999)
1542 CALL flagerror(
"Not implemented.",err,error,*999)
1544 CALL flagerror(
"Not implemented.",err,error,*999)
1546 solver_matrix_idx=solver_matrix%MATRIX_NUMBER
1548 max_column_indices=0
1549 DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1550 IF(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1551 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES>0)
THEN 1552 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1553 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
1554 equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1555 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%DYNAMIC_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1556 & equations_matrix_idx)%PTR
1557 IF(
ASSOCIATED(equations_to_solver_map))
THEN 1558 equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
1559 IF(
ASSOCIATED(equations_matrix))
THEN 1560 dynamic_matrices=>equations_matrix%DYNAMIC_MATRICES
1561 IF(
ASSOCIATED(dynamic_matrices))
THEN 1562 equations_matrices=>dynamic_matrices%EQUATIONS_MATRICES
1563 IF(
ASSOCIATED(equations_matrices))
THEN 1564 distributed_matrix=>equations_matrix%MATRIX
1565 IF(
ASSOCIATED(distributed_matrix))
THEN 1568 max_column_indices=max_column_indices+max_columns_per_row
1570 CALL flagerror(
"Equations matrix distributed matrix is not associated.",err,error,*999)
1573 CALL flagerror(
"Dynamic matrices equations matrices is not associated.",err,error,*999)
1576 CALL flagerror(
"Equations matrix dynamic matrices is not associated.",err,error,*999)
1579 CALL flagerror(
"Equations matrix is not assocaited.",err,error,*999)
1582 CALL flagerror(
"Equations to solver matrix map is not assocaited.",err,error,*999)
1586 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1587 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
1588 equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1589 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%LINEAR_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1590 & equations_matrix_idx)%PTR
1591 IF(
ASSOCIATED(equations_to_solver_map))
THEN 1592 equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
1593 IF(
ASSOCIATED(equations_matrix))
THEN 1594 linear_matrices=>equations_matrix%LINEAR_MATRICES
1595 IF(
ASSOCIATED(linear_matrices))
THEN 1596 equations_matrices=>linear_matrices%EQUATIONS_MATRICES
1597 IF(
ASSOCIATED(equations_matrices))
THEN 1598 distributed_matrix=>equations_matrix%MATRIX
1599 IF(
ASSOCIATED(distributed_matrix))
THEN 1602 max_column_indices=max_column_indices+max_columns_per_row
1604 CALL flagerror(
"Equations matrix distributed matrix is not associated.",err,error,*999)
1607 CALL flagerror(
"Linear matrices equations matrices is not associated.",err,error,*999)
1610 CALL flagerror(
"Equations matrix linear matrices is not associated.",err,error,*999)
1613 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
1616 CALL flagerror(
"Equations to solver matrix map is not associated.",err,error,*999)
1619 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1620 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_EQUATIONS_JACOBIANS
1621 jacobian_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1622 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS( &
1623 & equations_matrix_idx)%PTR
1624 IF(
ASSOCIATED(jacobian_to_solver_map))
THEN 1625 jacobian_matrix=>jacobian_to_solver_map%JACOBIAN_MATRIX
1626 IF(
ASSOCIATED(jacobian_matrix))
THEN 1627 nonlinear_matrices=>jacobian_matrix%NONLINEAR_MATRICES
1628 IF(
ASSOCIATED(nonlinear_matrices))
THEN 1629 equations_matrices=>nonlinear_matrices%EQUATIONS_MATRICES
1630 IF(
ASSOCIATED(equations_matrices))
THEN 1631 distributed_matrix=>jacobian_matrix%JACOBIAN
1632 IF(
ASSOCIATED(distributed_matrix))
THEN 1635 max_column_indices=max_column_indices+max_columns_per_row
1637 CALL flagerror(
"Jacobian distributed matrix is not associated.",err,error,*999)
1640 CALL flagerror(
"Nonlinear matrices equations matrices is not associated.",err,error,*999)
1643 CALL flagerror(
"Jacobian matrix nonlinear matrices is not associated.",err,error,*999)
1646 CALL flagerror(
"Jacobian matrix is not associated.",err,error,*999)
1652 DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
1653 interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
1654 SELECT CASE(interface_condition%METHOD)
1656 DO interface_matrix_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1657 & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_INTERFACE_MATRICES
1658 interface_to_solver_map=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
1659 & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%INTERFACE_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1660 & interface_matrix_idx)%PTR
1661 IF(
ASSOCIATED(interface_to_solver_map))
THEN 1662 interface_matrix=>interface_to_solver_map%INTERFACE_MATRIX
1663 IF(
ASSOCIATED(interface_matrix))
THEN 1664 interface_matrices=>interface_matrix%INTERFACE_MATRICES
1665 IF(
ASSOCIATED(interface_matrices))
THEN 1666 distributed_matrix=>interface_matrix%MATRIX
1667 IF(
ASSOCIATED(distributed_matrix))
THEN 1671 CALL flagerror(
"Interface matrix distributed matrix is not associated.",err,error,*999)
1674 CALL flagerror(
"Interface matrix interface matrices is not associated.",err,error,*999)
1676 max_transpose_columns_per_row=0
1677 IF(interface_matrix%HAS_TRANSPOSE)
THEN 1678 distributed_matrix=>interface_matrix%MATRIX_TRANSPOSE
1679 IF(
ASSOCIATED(distributed_matrix))
THEN 1681 & max_transpose_columns_per_row,err,error,*999)
1683 CALL flagerror(
"Interface matrix distributed matrix transpose is not associated.",err,error,*999)
1686 max_column_indices=max_column_indices+max(max_columns_per_row,max_transpose_columns_per_row)
1688 CALL flagerror(
"Interface to solver map interface matrix is not associated.",err,error,*999)
1691 CALL flagerror(
"Interface to solver matrix map is not associated.",err,error,*999)
1695 CALL flagerror(
"Not implemented.",err,error,*999)
1697 CALL flagerror(
"Not implemented.",err,error,*999)
1699 local_error=
"The interface condition method of "// &
1702 CALL flagerror(local_error,err,error,*999)
1706 ALLOCATE(column_indices_lists(solver_mapping%NUMBER_OF_ROWS),stat=err)
1707 IF(err/=0)
CALL flagerror(
"Could not allocate column indices lists.",err,error,*999)
1709 ALLOCATE(row_indices(solver_mapping%NUMBER_OF_ROWS+1),stat=err)
1710 IF(err/=0)
CALL flagerror(
"Could not allocate row indices.",err,error,*999)
1713 DO solver_row_number=1,solver_mapping%NUMBER_OF_ROWS
1714 NULLIFY(column_indices_lists(solver_row_number)%PTR)
1715 CALL list_create_start(column_indices_lists(solver_row_number)%PTR,err,error,*999)
1716 CALL list_data_type_set(column_indices_lists(solver_row_number)%PTR,list_intg_type,err,error,*999)
1717 CALL list_initial_size_set(column_indices_lists(solver_row_number)%PTR,max_column_indices,err,error,*999)
1718 CALL list_create_finish(column_indices_lists(solver_row_number)%PTR,err,error,*999)
1721 DO equations_set_idx=1,solver_mapping%NUMBER_OF_EQUATIONS_SETS
1722 IF(solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1723 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES>0)
THEN 1725 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1726 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
1728 equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1729 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%DYNAMIC_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1730 & equations_matrix_idx)%PTR
1731 equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
1732 dynamic_matrices=>equations_matrix%DYNAMIC_MATRICES
1733 equations_matrices=>dynamic_matrices%EQUATIONS_MATRICES
1734 distributed_matrix=>equations_matrix%MATRIX
1736 SELECT CASE(equations_storage_type)
1739 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1741 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1742 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1743 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1744 & equations_row_to_solver_rows_maps(equations_row_number)% &
1745 & solver_rows(solver_row_idx)
1747 DO equations_column_number=1,equations_matrix%NUMBER_OF_COLUMNS
1749 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1750 & equations_column_number)%NUMBER_OF_SOLVER_COLS
1751 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1752 & equations_column_number)%SOLVER_COLS(solver_column_idx)
1753 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1761 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1763 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1764 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1765 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1766 & equations_row_to_solver_rows_maps(equations_row_number)% &
1767 & solver_rows(solver_row_idx)
1768 equations_column_number=equations_row_number
1770 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1771 & equations_column_number)%NUMBER_OF_SOLVER_COLS
1772 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1773 & equations_column_number)%SOLVER_COLS(solver_column_idx)
1774 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1780 CALL flagerror(
"Not implemented.",err,error,*999)
1782 CALL flagerror(
"Not implemented.",err,error,*999)
1785 & equations_column_indices,err,error,*999)
1787 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1789 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1790 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1791 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1792 & equations_row_to_solver_rows_maps(equations_row_number)% &
1793 & solver_rows(solver_row_idx)
1795 DO equations_column_idx=equations_row_indices(equations_row_number), &
1796 & equations_row_indices(equations_row_number+1)-1
1797 equations_column_number=equations_column_indices(equations_column_idx)
1799 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1800 & equations_column_number)%NUMBER_OF_SOLVER_COLS
1801 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1802 & equations_column_number)%SOLVER_COLS(solver_column_idx)
1803 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1810 CALL flagerror(
"Not implemented.",err,error,*999)
1812 CALL flagerror(
"Not implemented.",err,error,*999)
1814 local_error=
"The matrix storage type of "// &
1816 CALL flagerror(local_error,err,error,*999)
1821 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1822 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
1824 equations_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1825 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%LINEAR_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
1826 & equations_matrix_idx)%PTR
1827 equations_matrix=>equations_to_solver_map%EQUATIONS_MATRIX
1828 linear_matrices=>equations_matrix%LINEAR_MATRICES
1829 equations_matrices=>linear_matrices%EQUATIONS_MATRICES
1830 distributed_matrix=>equations_matrix%MATRIX
1832 SELECT CASE(equations_storage_type)
1835 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1837 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1838 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1839 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1840 & equations_row_to_solver_rows_maps(equations_row_number)% &
1841 & solver_rows(solver_row_idx)
1843 DO equations_column_number=1,equations_matrix%NUMBER_OF_COLUMNS
1845 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1846 & equations_column_number)%NUMBER_OF_SOLVER_COLS
1847 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1848 & equations_column_number)%SOLVER_COLS(solver_column_idx)
1849 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1857 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1859 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1860 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1861 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1862 & equations_row_to_solver_rows_maps(equations_row_number)% &
1863 & solver_rows(solver_row_idx)
1864 equations_column_number=equations_row_number
1866 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1867 & equations_column_number)%NUMBER_OF_SOLVER_COLS
1868 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1869 & equations_column_number)%SOLVER_COLS(solver_column_idx)
1870 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1876 CALL flagerror(
"Not implemented.",err,error,*999)
1878 CALL flagerror(
"Not implemented.",err,error,*999)
1881 & equations_column_indices,err,error,*999)
1883 DO equations_row_number=1,equations_matrices%NUMBER_OF_ROWS
1885 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1886 & equations_row_to_solver_rows_maps(equations_row_number)%NUMBER_OF_SOLVER_ROWS
1887 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1888 & equations_row_to_solver_rows_maps(equations_row_number)% &
1889 & solver_rows(solver_row_idx)
1891 DO equations_column_idx=equations_row_indices(equations_row_number), &
1892 & equations_row_indices(equations_row_number+1)-1
1893 equations_column_number=equations_column_indices(equations_column_idx)
1895 DO solver_column_idx=1,equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1896 & equations_column_number)%NUMBER_OF_SOLVER_COLS
1897 solver_column_number=equations_to_solver_map%EQUATIONS_COL_TO_SOLVER_COLS_MAP( &
1898 & equations_column_number)%SOLVER_COLS(solver_column_idx)
1899 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1906 CALL flagerror(
"Not implemented.",err,error,*999)
1908 CALL flagerror(
"Not implemented.",err,error,*999)
1910 local_error=
"The matrix storage type of "// &
1912 CALL flagerror(local_error,err,error,*999)
1916 DO equations_matrix_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1917 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_EQUATIONS_JACOBIANS
1918 jacobian_to_solver_map=>solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1919 & equations_to_solver_matrix_maps_sm(solver_matrix_idx)%JACOBIAN_TO_SOLVER_MATRIX_MAPS( &
1920 & equations_matrix_idx)%PTR
1921 IF(
ASSOCIATED(jacobian_to_solver_map))
THEN 1923 jacobian_matrix=>jacobian_to_solver_map%JACOBIAN_MATRIX
1924 nonlinear_matrices=>jacobian_matrix%NONLINEAR_MATRICES
1925 equations_matrices=>nonlinear_matrices%EQUATIONS_MATRICES
1926 distributed_matrix=>jacobian_matrix%JACOBIAN
1928 SELECT CASE(equations_storage_type)
1931 DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1933 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1934 & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1935 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1936 & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1937 & solver_rows(solver_row_idx)
1939 DO jacobian_column_number=1,jacobian_matrix%NUMBER_OF_COLUMNS
1941 DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1942 & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1943 solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1944 & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1945 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1953 DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1955 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1956 & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1957 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1958 & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1959 & solver_rows(solver_row_idx)
1960 jacobian_column_number=jacobian_row_number
1962 DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1963 & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1964 solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1965 & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1966 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
1972 CALL flagerror(
"Not implemented.",err,error,*999)
1974 CALL flagerror(
"Not implemented.",err,error,*999)
1977 & equations_column_indices,err,error,*999)
1979 DO jacobian_row_number=1,equations_matrices%NUMBER_OF_ROWS
1981 DO solver_row_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1982 & equations_row_to_solver_rows_maps(jacobian_row_number)%NUMBER_OF_SOLVER_ROWS
1983 solver_row_number=solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
1984 & equations_row_to_solver_rows_maps(jacobian_row_number)% &
1985 & solver_rows(solver_row_idx)
1987 DO jacobian_column_idx=equations_row_indices(jacobian_row_number), &
1988 & equations_row_indices(jacobian_row_number+1)-1
1989 jacobian_column_number=equations_column_indices(jacobian_column_idx)
1991 DO solver_column_idx=1,jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1992 & jacobian_column_number)%NUMBER_OF_SOLVER_COLS
1993 solver_column_number=jacobian_to_solver_map%JACOBIAN_COL_TO_SOLVER_COLS_MAP( &
1994 & jacobian_column_number)%SOLVER_COLS(solver_column_idx)
1995 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2002 CALL flagerror(
"Not implemented.",err,error,*999)
2004 CALL flagerror(
"Not implemented.",err,error,*999)
2006 local_error=
"The Jacobian storage type of "// &
2008 CALL flagerror(local_error,err,error,*999)
2014 DO interface_condition_idx=1,solver_mapping%EQUATIONS_SET_TO_SOLVER_MAP(equations_set_idx)% &
2015 & number_of_interface_conditions
2019 DO interface_condition_idx=1,solver_mapping%NUMBER_OF_INTERFACE_CONDITIONS
2020 interface_condition=>solver_mapping%INTERFACE_CONDITIONS(interface_condition_idx)%PTR
2021 SELECT CASE(interface_condition%METHOD)
2023 DO interface_matrix_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2024 & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%NUMBER_OF_INTERFACE_MATRICES
2025 interface_to_solver_map=>solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2026 & interface_to_solver_matrix_maps_sm(solver_matrix_idx)%INTERFACE_EQUATIONS_TO_SOLVER_MATRIX_MAPS( &
2027 & interface_matrix_idx)%PTR
2028 interface_matrix=>interface_to_solver_map%INTERFACE_MATRIX
2029 interface_matrices=>interface_matrix%INTERFACE_MATRICES
2030 distributed_matrix=>interface_matrix%MATRIX
2032 SELECT CASE(interface_storage_type)
2035 DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
2037 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2038 & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2039 interface_row_number)%NUMBER_OF_SOLVER_ROWS
2040 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2041 & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2042 & interface_row_number)%SOLVER_ROW
2044 DO interface_column_number=1,interface_matrices%TOTAL_NUMBER_OF_COLUMNS
2046 DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2047 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2048 & interface_col_to_solver_cols_map(interface_column_number)%NUMBER_OF_SOLVER_COLS
2049 solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2050 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2051 & interface_col_to_solver_cols_map(interface_column_number)%SOLVER_COLS(solver_column_idx)
2052 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2060 DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
2062 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2063 & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2064 interface_row_number)%NUMBER_OF_SOLVER_ROWS
2065 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2066 & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2067 & interface_row_number)%SOLVER_ROW
2068 interface_column_number=interface_row_number
2070 DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2071 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2072 & interface_col_to_solver_cols_map(interface_column_number)%NUMBER_OF_SOLVER_COLS
2073 solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2074 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2075 & interface_col_to_solver_cols_map(interface_column_number)%SOLVER_COLS(solver_column_idx)
2076 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2082 CALL flagerror(
"Not implemented.",err,error,*999)
2084 CALL flagerror(
"Not implemented.",err,error,*999)
2087 & interface_column_indices,err,error,*999)
2089 DO interface_row_number=1,interface_matrix%NUMBER_OF_ROWS
2091 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2092 & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2093 interface_row_number)%NUMBER_OF_SOLVER_ROWS
2094 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2095 & interface_to_solver_matrix_maps_im(interface_matrix_idx)%INTERFACE_ROW_TO_SOLVER_ROWS_MAP( &
2096 & interface_row_number)%SOLVER_ROW
2098 DO interface_column_idx=interface_row_indices(interface_row_number), &
2099 & interface_row_indices(interface_row_number+1)-1
2100 interface_column_number=interface_column_indices(interface_column_idx)
2102 DO solver_column_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2103 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2104 & interface_col_to_solver_cols_map(interface_column_number)%NUMBER_OF_SOLVER_COLS
2105 solver_column_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP( &
2106 & interface_condition_idx)%INTERFACE_TO_SOLVER_MATRIX_MAPS_SM(solver_matrix_idx)% &
2107 & interface_col_to_solver_cols_map(interface_column_number)%SOLVER_COLS(solver_column_idx)
2108 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2115 CALL flagerror(
"Not implemented.",err,error,*999)
2117 CALL flagerror(
"Not implemented.",err,error,*999)
2119 local_error=
"The matrix storage type of "// &
2121 CALL flagerror(local_error,err,error,*999)
2123 IF(interface_matrix%HAS_TRANSPOSE)
THEN 2124 distributed_matrix=>interface_matrix%MATRIX_TRANSPOSE
2127 SELECT CASE(interface_storage_type)
2130 DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
2132 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2133 & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
2134 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2135 & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
2137 DO interface_row_number=1,interface_matrix%TOTAL_NUMBER_OF_ROWS
2139 DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2140 & interface_row_number)%NUMBER_OF_SOLVER_COLS
2141 solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2142 & interface_row_number)%SOLVER_COLS(solver_column_idx)
2143 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2151 DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
2153 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2154 & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
2155 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2156 & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
2157 interface_row_number=interface_column_number
2159 DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2160 & interface_row_number)%NUMBER_OF_SOLVER_COLS
2161 solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2162 & interface_row_number)%SOLVER_COLS(solver_column_idx)
2163 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2169 CALL flagerror(
"Not implemented.",err,error,*999)
2171 CALL flagerror(
"Not implemented.",err,error,*999)
2174 & interface_column_indices,err,error,*999)
2176 DO interface_column_number=1,interface_matrices%NUMBER_OF_COLUMNS
2178 DO solver_row_idx=1,solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2179 & interface_column_to_solver_rows_maps(interface_column_number)%NUMBER_OF_SOLVER_ROWS
2180 solver_row_number=solver_mapping%INTERFACE_CONDITION_TO_SOLVER_MAP(interface_condition_idx)% &
2181 & interface_column_to_solver_rows_maps(interface_column_number)%SOLVER_ROW
2183 DO interface_row_idx=interface_row_indices(interface_column_number), &
2184 & interface_row_indices(interface_column_number+1)-1
2185 interface_row_number=interface_column_indices(interface_row_idx)
2187 DO solver_column_idx=1,interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2188 & interface_row_number)%NUMBER_OF_SOLVER_COLS
2189 solver_column_number=interface_to_solver_map%INTERFACE_ROW_TO_SOLVER_COLS_MAP( &
2190 & interface_row_number)%SOLVER_COLS(solver_column_idx)
2191 CALL list_item_add(column_indices_lists(solver_row_number)%PTR,solver_column_number, &
2198 CALL flagerror(
"Not implemented.",err,error,*999)
2200 CALL flagerror(
"Not implemented.",err,error,*999)
2202 local_error=
"The matrix storage type of "// &
2204 CALL flagerror(local_error,err,error,*999)
2209 CALL flagerror(
"Not implemented.",err,error,*999)
2211 CALL flagerror(
"Not implemented.",err,error,*999)
2213 local_error=
"The interface condition method of "// &
2216 CALL flagerror(local_error,err,error,*999)
2220 DO solver_row_number=1,solver_mapping%NUMBER_OF_ROWS
2221 CALL list_remove_duplicates(column_indices_lists(solver_row_number)%PTR,err,error,*999)
2222 CALL list_number_of_items_get(column_indices_lists(solver_row_number)%PTR,number_of_columns,err,error,*999)
2223 number_of_non_zeros=number_of_non_zeros+number_of_columns
2224 row_indices(solver_row_number+1)=number_of_non_zeros+1
2227 ALLOCATE(column_indices(number_of_non_zeros),stat=err)
2228 IF(err/=0)
CALL flagerror(
"Could not allocate column indices.",err,error,*999)
2229 DO solver_row_number=1,solver_mapping%NUMBER_OF_ROWS
2230 CALL list_detach_and_destroy(column_indices_lists(solver_row_number)%PTR,number_of_columns,columns, &
2232 DO solver_column_idx=1,number_of_columns
2233 column_indices(row_indices(solver_row_number)+solver_column_idx-1)=columns(solver_column_idx)
2238 CALL flagerror(
"Not implemented.",err,error,*999)
2240 CALL flagerror(
"Not implemented.",err,error,*999)
2242 local_error=
"The matrix storage type of "// &
2244 CALL flagerror(local_error,err,error,*999)
2253 CALL write_string_value(
diagnostic_output_type,
" Number of columns = ",solver_matrix%NUMBER_OF_COLUMNS, &
2255 CALL write_string_value(
diagnostic_output_type,
" Number of non zeros = ",number_of_non_zeros,err,error,*999)
2256 IF(solver_matrices%NUMBER_OF_ROWS*solver_matrix%NUMBER_OF_COLUMNS/=0)
THEN 2257 sparsity=
REAL(number_of_non_zeros,
dp)/
REAL(solver_matrices%number_of_rows* &
2258 & SOLVER_MATRIX%NUMBER_OF_COLUMNS,DP)*100.0_DP
2263 &
'(" Row indices :",8(X,I13))',
'(18X,8(X,I13))',err,error,*999)
2265 &
'(" Column indices :",8(X,I13))',
'(18X,8(X,I13))', err,error,*999)
2269 CALL flagerror(
"Solver matrices solver mapping is not associated",err,error,*999)
2272 CALL flagerror(
"Solver matrix solver matrices is not associated",err,error,*999)
2276 CALL flagerror(
"Solver matrix distributed matrix is not associated",err,error,*999)
2279 CALL flagerror(
"Column indices is already associated",err,error,*998)
2282 CALL flagerror(
"Row indices is already associated",err,error,*998)
2285 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
2288 exits(
"SOLVER_MATRIX_STRUCTURE_CALCULATE")
2290 999
IF(
ASSOCIATED(row_indices))
DEALLOCATE(row_indices)
2291 IF(
ASSOCIATED(column_indices))
DEALLOCATE(column_indices)
2292 IF(
ALLOCATED(columns))
DEALLOCATE(columns)
2293 IF(
ALLOCATED(column_indices_lists))
THEN 2294 DO solver_row_number=1,solver_mapping%NUMBER_OF_ROWS
2295 IF(
ASSOCIATED(column_indices_lists(solver_row_number)%PTR)) &
2296 &
CALL list_destroy(column_indices_lists(solver_row_number)%PTR,dummy_err,dummy_error,*998)
2298 DEALLOCATE(column_indices_lists)
2300 998 errorsexits(
"SOLVER_MATRIX_STRUCTURE_CALCULATE",err,error)
2314 INTEGER(INTG),
INTENT(OUT) :: ERR
2318 enters(
"SOLVER_MATRIX_FINALISE",err,error,*999)
2320 IF(
ASSOCIATED(solver_matrix))
THEN 2323 DEALLOCATE(solver_matrix)
2326 exits(
"SOLVER_MATRIX_FINALISE")
2328 999 errorsexits(
"SOLVER_MATRIX_FINALISE",err,error)
2342 INTEGER(INTG),
INTENT(OUT) :: ERR
2346 enters(
"SOLVER_MATRIX_FORM",err,error,*999)
2348 IF(
ASSOCIATED(solver_matrix))
THEN 2351 CALL flagerror(
"Solver matrix is not associated.",err,error,*999)
2354 exits(
"SOLVER_MATRIX_FORM")
2356 999 errorsexits(
"SOLVER_MATRIX_FORM",err,error)
2370 INTEGER(INTG),
INTENT(IN) :: MATRIX_NUMBER
2371 INTEGER(INTG),
INTENT(OUT) :: ERR
2374 INTEGER(INTG) :: DUMMY_ERR
2379 enters(
"SOLVER_MATRIX_INITIALISE",err,error,*998)
2381 IF(
ASSOCIATED(solver_matrices))
THEN 2382 IF(matrix_number>0.AND.matrix_number<=solver_matrices%NUMBER_OF_MATRICES)
THEN 2383 solver_mapping=>solver_matrices%SOLVER_MAPPING
2384 IF(
ASSOCIATED(solver_mapping))
THEN 2385 IF(
ASSOCIATED(solver_matrices%MATRICES(matrix_number)%PTR))
THEN 2386 CALL flagerror(
"Solver matrix is already associated.",err,error,*998)
2388 ALLOCATE(solver_matrices%MATRICES(matrix_number)%PTR,stat=err)
2389 IF(err/=0)
CALL flagerror(
"Could not allocate solver matrix.",err,error,*999)
2390 solver_matrix=>solver_matrices%MATRICES(matrix_number)%PTR
2391 solver_matrix%MATRIX_NUMBER=matrix_number
2392 solver_matrix%SOLVER_MATRICES=>solver_matrices
2394 solver_matrix%UPDATE_MATRIX=.true.
2395 solver_matrix%NUMBER_OF_COLUMNS=solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(matrix_number)%NUMBER_OF_COLUMNS
2396 solver_mapping%SOLVER_COL_TO_EQUATIONS_COLS_MAP(matrix_number)%SOLVER_MATRIX=>solver_matrix
2397 NULLIFY(solver_matrix%SOLVER_VECTOR)
2398 NULLIFY(solver_matrix%MATRIX)
2401 CALL flagerror(
"Solver mapping is not associated.",err,error,*998)
2404 local_error=
"The specified matrix number of "//
trim(
number_to_vstring(matrix_number,
"*",err,error))// &
2405 &
" is invalid. The number must be > 0 and <= "// &
2407 CALL flagerror(local_error,err,error,*998)
2410 CALL flagerror(
"Solver matrices is not associated.",err,error,*998)
2413 exits(
"SOLVER_MATRIX_INITIALISE")
2416 998 errorsexits(
"SOLVER_MATRIX_INITIALISE",err,error)
subroutine, public enters(NAME, ERR, ERROR,)
Records the entry into the named procedure and initialises the error code.
subroutine, public distributed_matrix_create_finish(DISTRIBUTED_MATRIX, ERR, ERROR,)
Finishes the creation of a distributed matrix.
integer, parameter ptr
Pointer integer kind.
subroutine, public distributed_matrix_library_type_set(DISTRIBUTED_MATRIX, LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the library type for a distributed matrix.
Contains information on the Jacobian matrix for nonlinear problems.
subroutine solver_matrix_form(SOLVER_MATRIX, ERR, ERROR,)
Forms a solver matrix by initialising the structure of the matrix to zero.
integer(intg), parameter, public matrix_vector_dp_type
Double precision real matrix-vector data type.
This module handles all solver matrix and rhs routines.
subroutine, public solver_matrix_jacobian_matrix_add(SOLVER_MATRIX, equations_set_idx, ALPHA, JACOBIAN_MATRIX, ERR, ERROR,)
Adds alpha times the Jacobian matrix into the solver matrix.
This module handles all problem wide constants.
Converts a number to its equivalent varying string representation.
subroutine, public distributed_vector_create_start(DOMAIN_MAPPING, DISTRIBUTED_VECTOR, ERR, ERROR,)
Starts the creation a distributed vector.
subroutine, public distributed_vector_create_finish(DISTRIBUTED_VECTOR, ERR, ERROR,)
Finishes the creation a distributed vector.
subroutine, public distributed_matrix_data_type_set(DISTRIBUTED_MATRIX, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type of a distributed matrix.
Contains information about an interface matrix.
integer(intg), parameter, public distributed_matrix_row_major_storage_type
Distributed matrix row major storage type.
subroutine, public solver_matrices_create_finish(SOLVER_MATRICES, ERR, ERROR,)
Finishes the process of creating the solver matrices.
subroutine, public distributed_matrix_create_start(ROW_DOMAIN_MAPPING, COLUMN_DOMAIN_MAPPING, DISTRIBUTED_MATRIX, ERR, ERROR,)
Starts the creation of a distributed matrix.
integer(intg), parameter, public matrix_compressed_column_storage_type
Matrix compressed column storage type.
integer(intg), parameter interface_condition_lagrange_multipliers_method
Lagrange multipliers interface condition method.
integer(intg), parameter, public distributed_matrix_vector_cmiss_type
CMISS distributed matrix-vector library type.
subroutine, public distributed_matrix_storage_type_set(DISTRIBUTED_MATRIX, STORAGE_TYPE, ERR, ERROR,)
Sets/changes the storage type of a distributed matrix.
integer(intg), parameter, public solver_matrices_residual_only
Select only the residual solver vector.
This module contains all string manipulation and transformation routines.
Contains information for the interface condition data.
subroutine, public distributed_matrix_form(DISTRIBUTED_MATRIX, ERR, ERROR,)
Forms a distributed matrix by initialising the structure of the matrix to zero.
integer(intg), parameter, public solver_matrices_rhs_residual_only
Select only the residual and RHS solver vectors.
logical, save, public diagnostics2
.TRUE. if level 2 diagnostic output is active in the current routine
This module provides an iso_varying_string module, conformant to the API specified in ISO/IEC 1539-2:...
integer(intg), parameter, public solver_matrices_rhs_only
Select only the RHS solver vector.
integer(intg), parameter interface_condition_augmented_lagrange_method
Augmented Lagrange multiplers interface condition method.
subroutine, public solver_matrices_create_start(SOLVER_EQUATIONS, SOLVER_MATRICES, ERR, ERROR,)
Starts the process of creating the solver matrices.
integer(intg), parameter, public matrix_row_major_storage_type
Matrix row major storage type.
integer(intg), parameter, public distributed_matrix_column_major_storage_type
Distributed matrix column major storage type.
subroutine, public solver_matrices_storage_type_set(SOLVER_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Sets the storage type (sparsity) of the solver matrices.
subroutine, public solver_matrix_equations_matrix_add(SOLVER_MATRIX, equations_set_idx, ALPHA, EQUATIONS_MATRIX, ERR, ERROR,)
Adds alpha times the equations matrix into the solver matrix.
subroutine, public distributed_matrix_max_columns_per_row_get(DISTRIBUTED_MATRIX, MAX_COLUMNS_PER_ROW, ERR, ERROR,)
Gets the maximum number of columns in each row of a distributed matrix.
subroutine solver_matrix_structure_calculate(SOLVER_MATRIX, NUMBER_OF_NON_ZEROS, ROW_INDICES, COLUMN_INDICES, ERR, ERROR,)
Calculates the structure (sparsity) of the solver matrix from the soluton mapping.
subroutine, public distributed_matrix_storage_locations_set(DISTRIBUTED_MATRIX, ROW_INDICES, COLUMN_INDICES, ERR, ERROR,)
Sets the storage locations (sparsity pattern) in a distributed matrix to that specified by the row an...
integer, parameter dp
Double precision real kind.
subroutine, public exits(NAME)
Records the exit out of the named procedure.
This module contains all type definitions in order to avoid cyclic module references.
Contains information on the equations matrices and vectors.
subroutine solver_matrices_storage_type_get(SOLVER_MATRICES, STORAGE_TYPE, ERR, ERROR,)
Gets the storage type (sparsity) of the solver matrices.
This module contains all the low-level base routines e.g., all debug, control, and low-level communic...
integer(intg), parameter, public solver_matrices_linear_only
Select only the linear solver matrices and vectors.
subroutine solver_matrices_initialise(SOLVER_EQUATIONS, ERR, ERROR,)
Initialises the solver matrices for solver equations.
Contains information of the linear matrices for equations matrices.
subroutine, public distributed_matrix_destroy(DISTRIBUTED_MATRIX, ERR, ERROR,)
Destroys a distributed matrix.
Contains information on the solver matrix.
integer(intg), parameter interface_condition_penalty_method
Penalty interface condition method.
subroutine solver_matrices_library_type_get(SOLVER_MATRICES, LIBRARY_TYPE, ERR, ERROR,)
Gets the library type for the solver matrices (and vectors)
Contains information about the solver equations for a solver.
integer(intg), parameter, public matrix_compressed_row_storage_type
Matrix compressed row storage type.
subroutine solver_matrix_initialise(SOLVER_MATRICES, MATRIX_NUMBER, ERR, ERROR,)
Initialises a solver matrix.
subroutine, public distributed_matrix_storage_type_get(DISTRIBUTED_MATRIX, STORAGE_TYPE, ERR, ERROR,)
Gets the storage type of a distributed matrix.
subroutine, public distributed_vector_output(ID, DISTRIBUTED_VECTOR, ERR, ERROR,)
Outputs a distributed vector to the specified output ID.
integer(intg), parameter, public matrix_diagonal_storage_type
Matrix diagonal storage type.
subroutine, public distributed_matrix_storage_locations_get(DISTRIBUTED_MATRIX, ROW_INDICES, COLUMN_INDICES, ERR, ERROR,)
Gets the storage locations (sparsity pattern) for a distributed matrix.
logical, save, public diagnostics1
.TRUE. if level 1 diagnostic output is active in the current routine
This module handles all distributed matrix vector routines.
This module defines all constants shared across interface condition routines.
integer(intg), parameter, public distributed_matrix_compressed_column_storage_type
Distributed matrix compressed column storage type.
integer(intg), parameter interface_condition_point_to_point_method
Point to point interface condition method.
Contains information about an equations matrix.
integer(intg), parameter problem_solver_nonlinear
Nonlinear problem.
subroutine, public distributed_vector_library_type_set(DISTRIBUTED_VECTOR, LIBRARY_TYPE, ERR, ERROR,)
Sets/changes the library type for a distributed vector.
subroutine solver_matrix_finalise(SOLVER_MATRIX, ERR, ERROR,)
Finalises a solver matrix and deallocates all memory.
subroutine, public distributed_matrix_output(ID, DISTRIBUTED_MATRIX, ERR, ERROR,)
Outputs a distributed matrix.
subroutine, public distributed_vector_data_type_set(DISTRIBUTED_VECTOR, DATA_TYPE, ERR, ERROR,)
Sets/changes the data type of a distributed vector.
This module contains all routines dealing with (non-distributed) matrix and vectors types...
integer(intg), parameter, public distributed_matrix_block_storage_type
Distributed matrix block storage type.
subroutine, public distributed_vector_destroy(DISTRIBUTED_VECTOR, ERR, ERROR,)
Destroys a distributed vector.
integer(intg), parameter, public solver_matrices_nonlinear_only
Select only the nonlinear solver matrices and vectors.
integer(intg), parameter, public matrix_row_column_storage_type
Matrix row-column storage type.
subroutine, public solver_matrices_destroy(SOLVER_MATRICES, ERR, ERROR,)
Destroy the solver matrices.
integer(intg), parameter, public diagnostic_output_type
Diagnostic output type.
Contains information on the solver mapping between the global equation sets and the solver matrices...
integer(intg), parameter, public solver_matrices_jacobian_only
Select only the Jacobian solver matrix.
Contains information on the solver matrices and rhs vector.
subroutine, public solver_matrix_interface_matrix_add(SOLVER_MATRIX, interface_condition_idx, ALPHA, INTERFACE_MATRIX, ERR, ERROR,)
Adds alpha times the interface matrix into the solver matrix.
integer(intg), parameter, public solver_matrices_all
Select all the solver matrices and vectors.
Contains information on the domain mappings (i.e., local and global numberings).
Contains information of the nolinear matrices and vectors for equations matrices. ...
Contains information on the interface matrices.
subroutine solver_matrices_finalise(SOLVER_MATRICES, ERR, ERROR,)
Finalises the solver matrices and deallocates all memory.
Contains the information for a matrix that is distributed across a number of domains.
integer(intg), parameter, public matrix_block_storage_type
Matrix block storage type.
integer(intg), parameter, public distributed_matrix_vector_petsc_type
PETSc distributed matrix-vector library type.
integer(intg), parameter, public distributed_matrix_row_column_storage_type
Distributed matrix row-column storage type.
subroutine, public distributed_matrix_number_non_zeros_set(DISTRIBUTED_MATRIX, NUMBER_NON_ZEROS, ERR, ERROR,)
Sets/changes the number of non zeros for a distributed matrix.
integer(intg), parameter, public matrix_column_major_storage_type
Matrix column major storage type.
Flags an error condition.
Buffer type to allow arrays of pointers to a list.
integer(intg), parameter, public distributed_matrix_diagonal_storage_type
Distributed matrix diagonal storage type.
subroutine, public solver_matrices_library_type_set(SOLVER_MATRICES, LIBRARY_TYPE, ERR, ERROR,)
Sets the library type for the solver matrices (and vectors)
This module contains all kind definitions.
subroutine, public solver_matrices_output(ID, SELECTION_TYPE, SOLVER_MATRICES, ERR, ERROR,)
Outputs the solver matrices.
integer(intg), parameter, public distributed_matrix_compressed_row_storage_type
Distributed matrix compressed row storage type.
Contains information of the dynamic matrices for equations matrices.