306 INTEGER(INTG),
INTENT(OUT) :: ERR
310 enters(
"EQUATIONS_JACOBIAN_FINALISE",err,error,*999)
312 IF(
ASSOCIATED(equations_jacobian))
THEN 318 exits(
"EQUATIONS_JACOBIAN_FINALISE")
320 999 errorsexits(
"EQUATIONS_JACOBIAN_FINALISE",err,error)
333 INTEGER(INTG),
INTENT(IN) :: MATRIX_NUMBER
334 INTEGER(INTG),
INTENT(OUT) :: ERR
337 INTEGER(INTG) :: DUMMY_ERR
343 enters(
"EQUATIONS_JACOBIAN_INITIALISE",err,error,*998)
345 IF(
ASSOCIATED(nonlinear_matrices))
THEN 346 equations_matrices=>nonlinear_matrices%EQUATIONS_MATRICES
347 IF(
ASSOCIATED(equations_matrices))
THEN 348 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
349 IF(
ASSOCIATED(equations_mapping))
THEN 350 nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
351 IF(
ASSOCIATED(nonlinear_mapping))
THEN 352 IF(
ALLOCATED(nonlinear_matrices%JACOBIANS))
THEN 353 IF(
ASSOCIATED(nonlinear_matrices%JACOBIANS(matrix_number)%PTR))
THEN 354 CALL flagerror(
"Nonlinear matrices Jacobian is already associated.",err,error,*998)
356 ALLOCATE(nonlinear_matrices%JACOBIANS(matrix_number)%PTR,stat=err)
357 IF(err/=0)
CALL flagerror(
"Could not allocate equations Jacobian.",err,error,*999)
358 nonlinear_matrices%JACOBIANS(matrix_number)%PTR%JACOBIAN_NUMBER=matrix_number
359 nonlinear_matrices%JACOBIANS(matrix_number)%PTR%NONLINEAR_MATRICES=>nonlinear_matrices
362 nonlinear_matrices%JACOBIANS(matrix_number)%PTR%NUMBER_OF_COLUMNS= &
363 & nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_number)%NUMBER_OF_COLUMNS
364 nonlinear_matrices%JACOBIANS(matrix_number)%PTR%UPDATE_JACOBIAN=.true.
365 nonlinear_matrices%JACOBIANS(matrix_number)%PTR%FIRST_ASSEMBLY=.true.
366 nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_number)%JACOBIAN=>nonlinear_matrices%JACOBIANS(matrix_number)%PTR
367 NULLIFY(nonlinear_matrices%JACOBIANS(matrix_number)%PTR%JACOBIAN)
369 & element_jacobian,err,error,*999)
371 & nodaljacobian,err,error,*999)
372 nonlinear_matrices%JACOBIANS(matrix_number)%PTR%JACOBIAN_CALCULATION_TYPE= &
376 CALL flagerror(
"Equations matrices nonlinear matrieces Jacobian is not allocated.",err,error,*999)
379 CALL flagerror(
"Equations mapping nonlinear mapping is not associated.",err,error,*999)
382 CALL flagerror(
"Equations mapping is not associated.",err,error,*998)
385 CALL flagerror(
"Nonlinear matrices equations matrices is not associated.",err,error,*998)
388 CALL flagerror(
"Nonlinear matrices is not associated.",err,error,*998)
391 exits(
"EQUATIONS_JACOBIAN_INITIALISE")
394 998 errorsexits(
"EQUATIONS_JACOBIAN_INITIALISE",err,error)
407 INTEGER(INTG),
INTENT(OUT) :: ERR
410 INTEGER(INTG) :: DUMMY_ERR,matrix_idx,NUMBER_OF_NON_ZEROS
411 INTEGER(INTG),
POINTER :: ROW_INDICES(:),COLUMN_INDICES(:)
427 NULLIFY(column_indices)
429 enters(
"EQUATIONS_MATRICES_CREATE_FINISH",err,error,*998)
431 IF(
ASSOCIATED(equations_matrices))
THEN 432 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 433 CALL flagerror(
"Equations matrices have already been finished.",err,error,*998)
435 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
436 IF(
ASSOCIATED(equations_mapping))
THEN 437 row_domain_map=>equations_mapping%ROW_DOFS_MAPPING
438 IF(
ASSOCIATED(row_domain_map))
THEN 439 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
440 IF(
ASSOCIATED(dynamic_matrices))
THEN 442 dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
443 IF(
ASSOCIATED(dynamic_mapping))
THEN 445 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
446 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
447 IF(
ASSOCIATED(equations_matrix))
THEN 448 column_domain_map=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_DOFS_MAPPING
449 IF(
ASSOCIATED(column_domain_map))
THEN 452 & dynamic_matrices%MATRICES(matrix_idx)%PTR%MATRIX,err,error,*999)
459 & list,err,error,*999)
464 IF(
ASSOCIATED(row_indices))
DEALLOCATE(row_indices)
465 IF(
ASSOCIATED(column_indices))
DEALLOCATE(column_indices)
469 local_error=
"Column domain map for dynamic matrix number "// &
471 CALL flagerror(local_error,err,error,*999)
474 local_error=
"Equations matrix for dynamic matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
475 &
" is not associated." 476 CALL flagerror(local_error,err,error,*999)
480 CALL flagerror(
"Equations mapping dynamic mapping is not associated.",err,error,*999)
483 linear_matrices=>equations_matrices%LINEAR_MATRICES
484 IF(
ASSOCIATED(linear_matrices))
THEN 486 linear_mapping=>equations_mapping%LINEAR_MAPPING
487 IF(
ASSOCIATED(linear_mapping))
THEN 489 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
490 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
491 IF(
ASSOCIATED(equations_matrix))
THEN 492 column_domain_map=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%COLUMN_DOFS_MAPPING
493 IF(
ASSOCIATED(column_domain_map))
THEN 496 & linear_matrices%MATRICES(matrix_idx)%PTR%MATRIX,err,error,*999)
503 & list,err,error,*999)
508 IF(
ASSOCIATED(row_indices))
DEALLOCATE(row_indices)
509 IF(
ASSOCIATED(column_indices))
DEALLOCATE(column_indices)
513 local_error=
"Column domain map for linear matrix number "// &
515 CALL flagerror(local_error,err,error,*999)
518 local_error=
"Equations matrix for linear matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
519 &
" is not associated." 520 CALL flagerror(local_error,err,error,*999)
524 CALL flagerror(
"Equations mapping linear mapping is not associated.",err,error,*999)
527 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
528 IF(
ASSOCIATED(nonlinear_matrices))
THEN 530 nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
531 IF(
ASSOCIATED(nonlinear_mapping))
THEN 533 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
534 jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
535 IF(
ASSOCIATED(jacobian_matrix))
THEN 536 column_domain_map=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%COLUMN_DOFS_MAPPING
537 IF(
ASSOCIATED(column_domain_map))
THEN 551 IF(
ASSOCIATED(row_indices))
DEALLOCATE(row_indices)
552 IF(
ASSOCIATED(column_indices))
DEALLOCATE(column_indices)
556 CALL flagerror(
"Column domain map is not associated.",err,error,*999)
559 local_error=
"Jacobian matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))//
" is not associated." 560 CALL flagerror(local_error,err,error,*999)
570 CALL flagerror(
"Equations mapping nonlinear mapping is not associated.",err,error,*999)
573 rhs_vector=>equations_matrices%RHS_VECTOR
574 IF(
ASSOCIATED(rhs_vector))
THEN 580 source_vector=>equations_matrices%SOURCE_VECTOR
581 IF(
ASSOCIATED(source_vector))
THEN 588 equations_matrices%EQUATIONS_MATRICES_FINISHED=.true.
590 CALL flagerror(
"Row domain map is not associated.",err,error,*999)
593 CALL flagerror(
"Equations mapping is not associated.",err,error,*998)
597 CALL flagerror(
"Equations matrices is not associated.",err,error,*998)
600 exits(
"EQUATIONS_MATRICES_CREATE_FINISH")
602 999
IF(
ASSOCIATED(row_indices))
DEALLOCATE(row_indices)
603 IF(
ASSOCIATED(column_indices))
DEALLOCATE(column_indices)
605 998 errorsexits(
"EQUATIONS_MATRICES_CREATE_FINISH",err,error)
619 INTEGER(INTG),
INTENT(OUT) :: ERR
622 INTEGER(INTG) :: DUMMY_ERR
625 enters(
"EQUATIONS_MATRICES_CREATE_START",err,error,*998)
627 IF(
ASSOCIATED(equations))
THEN 628 IF(equations%EQUATIONS_FINISHED)
THEN 629 IF(
ASSOCIATED(equations_matrices))
THEN 630 CALL flagerror(
"Equations matrices is already associated.",err,error,*998)
632 NULLIFY(equations_matrices)
635 equations_matrices=>equations%EQUATIONS_MATRICES
638 CALL flagerror(
"Equations has not been finished.",err,error,*999)
641 CALL flagerror(
"Equations is not associated.",err,error,*998)
644 exits(
"EQUATIONS_MATRICES_CREATE_START")
647 998 errorsexits(
"EQUATIONS_MATRICES_CREATE_START",err,error)
660 INTEGER(INTG),
INTENT(OUT) :: ERR
664 enters(
"EQUATIONS_MATRICES_DESTROY",err,error,*999)
666 IF(
ASSOCIATED(equations_matrices))
THEN 669 CALL flagerror(
"Equations matrices is not associated",err,error,*999)
672 exits(
"EQUATIONS_MATRICES_DESTROY")
674 999 errorsexits(
"EQUATIONS_MATRICES_DESTROY",err,error)
685 & rows_field_variable,cols_field_variable,err,error,*)
689 LOGICAL :: UPDATE_MATRIX
690 INTEGER(INTG),
INTENT(IN) :: ROW_ELEMENT_NUMBERS(:)
691 INTEGER(INTG),
INTENT(IN) :: COLUMN_ELEMENT_NUMBERS(:)
694 INTEGER(INTG),
INTENT(OUT) :: ERR
697 INTEGER(INTG) :: component_idx,derivative,derivative_idx,global_ny,local_ny,node,node_idx,version,dataPointIdx, &
698 & localDataPointNumber,elementIdx,rowElementNumber,colElementNumber
704 enters(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_CALCULATE",err,error,*999)
706 IF(
ASSOCIATED(rows_field_variable))
THEN 707 IF(
ASSOCIATED(cols_field_variable))
THEN 708 element_matrix%NUMBER_OF_ROWS=0
709 element_matrix%NUMBER_OF_COLUMNS=0
710 IF(update_matrix)
THEN 711 IF(
ASSOCIATED(rows_field_variable,cols_field_variable))
THEN 713 DO component_idx=1,rows_field_variable%NUMBER_OF_COMPONENTS
714 elements_topology=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY%ELEMENTS
715 DO elementidx=1,
SIZE(row_element_numbers)
716 rowelementnumber=row_element_numbers(elementidx)
717 IF(rowelementnumber>=1.AND.rowelementnumber<=elements_topology%TOTAL_NUMBER_OF_ELEMENTS)
THEN 718 SELECT CASE(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
719 CASE(field_constant_interpolation)
720 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
721 global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
722 element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
723 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
724 element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
725 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
726 CASE(field_element_based_interpolation)
727 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
728 & elements(rowelementnumber)
729 global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
730 element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
731 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
732 element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
733 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
734 CASE(field_node_based_interpolation)
735 basis=>elements_topology%ELEMENTS(rowelementnumber)%BASIS
736 DO node_idx=1,basis%NUMBER_OF_NODES
737 node=elements_topology%ELEMENTS(rowelementnumber)%ELEMENT_NODES(node_idx)
738 DO derivative_idx=1,basis%NUMBER_OF_DERIVATIVES(node_idx)
739 derivative=elements_topology%ELEMENTS(rowelementnumber)%ELEMENT_DERIVATIVES(derivative_idx,node_idx)
740 version=elements_topology%ELEMENTS(rowelementnumber)%elementVersions(derivative_idx,node_idx)
741 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
742 & derivatives(derivative)%VERSIONS(version)
743 global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
744 element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
745 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
746 element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
747 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
750 CASE(field_grid_point_based_interpolation)
751 CALL flagerror(
"Not implemented.",err,error,*999)
752 CASE(field_gauss_point_based_interpolation)
753 CALL flagerror(
"Not implemented.",err,error,*999)
754 CASE(field_data_point_based_interpolation)
755 decompositiondata=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%DECOMPOSITION%TOPOLOGY%dataPoints
756 DO datapointidx=1,decompositiondata%elementDataPoint(rowelementnumber)%numberOfProjectedData
757 localdatapointnumber=decompositiondata%elementDataPoint(rowelementnumber)% &
758 & dataindices(datapointidx)%localNumber
759 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP% &
760 & data_points(localdatapointnumber)
761 global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
762 element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
763 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
764 element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
765 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
768 local_error=
"The interpolation type of "// &
769 &
trim(
numbertovstring(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE,
"*",err,error))// &
770 &
" is invalid for component number "// &
772 &
" of rows field variable type "// &
774 CALL flagerror(local_error,err,error,*999)
778 &
" is invalid for component number "//
trim(
numbertovstring(component_idx,
"*",err,error))// &
779 &
" of rows field variable type "// &
781 &
". The element number must be between 1 and "// &
783 CALL flagerror(local_error,err,error,*999)
790 DO component_idx=1,rows_field_variable%NUMBER_OF_COMPONENTS
791 elements_topology=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY%ELEMENTS
792 DO elementidx=1,
SIZE(row_element_numbers)
793 rowelementnumber=row_element_numbers(elementidx)
794 IF(rowelementnumber>=1.AND.rowelementnumber<=elements_topology%TOTAL_NUMBER_OF_ELEMENTS)
THEN 795 SELECT CASE(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
796 CASE(field_constant_interpolation)
797 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
798 element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
799 element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
800 CASE(field_element_based_interpolation)
801 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
802 & elements(rowelementnumber)
803 element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
804 element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
805 CASE(field_node_based_interpolation)
806 basis=>elements_topology%ELEMENTS(rowelementnumber)%BASIS
807 DO node_idx=1,basis%NUMBER_OF_NODES
808 node=elements_topology%ELEMENTS(rowelementnumber)%ELEMENT_NODES(node_idx)
809 DO derivative_idx=1,basis%NUMBER_OF_DERIVATIVES(node_idx)
810 derivative=elements_topology%ELEMENTS(rowelementnumber)%ELEMENT_DERIVATIVES(derivative_idx,node_idx)
811 version=elements_topology%ELEMENTS(rowelementnumber)%elementVersions(derivative_idx,node_idx)
812 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
813 & derivatives(derivative)%VERSIONS(version)
814 element_matrix%NUMBER_OF_ROWS=element_matrix%NUMBER_OF_ROWS+1
815 element_matrix%ROW_DOFS(element_matrix%NUMBER_OF_ROWS)=local_ny
818 CASE(field_grid_point_based_interpolation)
819 CALL flagerror(
"Not implemented.",err,error,*999)
820 CASE(field_gauss_point_based_interpolation)
821 CALL flagerror(
"Not implemented.",err,error,*999)
822 CASE(field_data_point_based_interpolation)
823 decompositiondata=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%DECOMPOSITION%TOPOLOGY%dataPoints
824 DO datapointidx=1,decompositiondata%elementDataPoint(colelementnumber)%numberOfProjectedData
825 localdatapointnumber=decompositiondata%elementDataPoint(colelementnumber)% &
826 & dataindices(datapointidx)%localNumber
827 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP% &
828 & data_points(localdatapointnumber)
829 global_ny=rows_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
830 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
831 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
834 local_error=
"The interpolation type of "// &
835 &
trim(
numbertovstring(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE,
"*",err,error))// &
836 &
" is invalid for component number "// &
838 &
" of rows field variable type "// &
840 CALL flagerror(local_error,err,error,*999)
843 local_error=
"Row element number "//
trim(
numbertovstring(rowelementnumber,
"*",err,error))// &
844 &
" is invalid for component number "//
trim(
numbertovstring(component_idx,
"*",err,error))// &
845 &
" of rows field variable type "// &
847 &
". The element number must be between 1 and "// &
849 CALL flagerror(local_error,err,error,*999)
854 DO component_idx=1,cols_field_variable%NUMBER_OF_COMPONENTS
855 elements_topology=>cols_field_variable%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY%ELEMENTS
856 DO elementidx=1,
SIZE(column_element_numbers)
857 colelementnumber=column_element_numbers(elementidx)
858 IF(colelementnumber>=1.AND.colelementnumber<=elements_topology%TOTAL_NUMBER_OF_ELEMENTS)
THEN 859 SELECT CASE(cols_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
860 CASE(field_constant_interpolation)
861 local_ny=cols_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
862 global_ny=cols_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
863 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
864 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
865 CASE(field_element_based_interpolation)
866 local_ny=cols_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
867 & elements(colelementnumber)
868 global_ny=cols_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
869 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
870 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
871 CASE(field_node_based_interpolation)
872 basis=>elements_topology%ELEMENTS(colelementnumber)%BASIS
873 DO node_idx=1,basis%NUMBER_OF_NODES
874 node=elements_topology%ELEMENTS(colelementnumber)%ELEMENT_NODES(node_idx)
875 DO derivative_idx=1,basis%NUMBER_OF_DERIVATIVES(node_idx)
876 derivative=elements_topology%ELEMENTS(colelementnumber)%ELEMENT_DERIVATIVES(derivative_idx,node_idx)
877 version=elements_topology%ELEMENTS(colelementnumber)%elementVersions(derivative_idx,node_idx)
878 local_ny=cols_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
879 & derivatives(derivative)%VERSIONS(version)
880 global_ny=cols_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
881 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
882 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
885 CASE(field_grid_point_based_interpolation)
886 CALL flagerror(
"Not implemented.",err,error,*999)
887 CASE(field_gauss_point_based_interpolation)
888 CALL flagerror(
"Not implemented.",err,error,*999)
889 CASE(field_data_point_based_interpolation)
890 decompositiondata=>cols_field_variable%COMPONENTS(component_idx)%DOMAIN%DECOMPOSITION%TOPOLOGY%dataPoints
891 DO datapointidx=1,decompositiondata%elementDataPoint(colelementnumber)%numberOfProjectedData
892 localdatapointnumber=decompositiondata%elementDataPoint(colelementnumber)% &
893 & dataindices(datapointidx)%localNumber
894 local_ny=cols_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP% &
895 & data_points(localdatapointnumber)
896 global_ny=cols_field_variable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(local_ny)
897 element_matrix%NUMBER_OF_COLUMNS=element_matrix%NUMBER_OF_COLUMNS+1
898 element_matrix%COLUMN_DOFS(element_matrix%NUMBER_OF_COLUMNS)=global_ny
901 local_error=
"The interpolation type of "// &
902 &
trim(
numbertovstring(cols_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE,
"*",err,error))// &
903 &
" is invalid for component number "// &
905 &
" of column field variable type "// &
907 CALL flagerror(local_error,err,error,*999)
910 local_error=
"Column element number "//
trim(
numbertovstring(colelementnumber,
"*",err,error))// &
911 &
" is invalid for component number "//
trim(
numbertovstring(component_idx,
"*",err,error))// &
912 &
" of column field variable type "// &
914 &
". The element number must be between 1 and "// &
916 CALL flagerror(local_error,err,error,*999)
921 element_matrix%MATRIX=0.0_dp
924 CALL flagerror(
"Columns field variable is not associated.",err,error,*999)
927 CALL flagerror(
"Rows field variable is not associated.",err,error,*999)
930 exits(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_CALCULATE")
932 999 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_CALCULATE",err,error)
946 INTEGER(INTG),
INTENT(OUT) :: ERR
950 enters(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_FINALISE",err,error,*999)
952 element_matrix%MAX_NUMBER_OF_ROWS=0
953 element_matrix%MAX_NUMBER_OF_COLUMNS=0
954 IF(
ALLOCATED(element_matrix%ROW_DOFS))
DEALLOCATE(element_matrix%ROW_DOFS)
955 IF(
ALLOCATED(element_matrix%COLUMN_DOFS))
DEALLOCATE(element_matrix%COLUMN_DOFS)
956 IF(
ALLOCATED(element_matrix%MATRIX))
DEALLOCATE(element_matrix%MATRIX)
958 exits(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_FINALISE")
960 999 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_FINALISE",err,error)
973 INTEGER(INTG),
INTENT(OUT) :: ERR
977 enters(
"EquationsMatrices_ElementMatrixInitialise",err,error,*999)
979 element_matrix%EQUATIONS_MATRIX_NUMBER=0
980 element_matrix%NUMBER_OF_ROWS=0
981 element_matrix%NUMBER_OF_COLUMNS=0
982 element_matrix%MAX_NUMBER_OF_ROWS=0
983 element_matrix%MAX_NUMBER_OF_COLUMNS=0
985 exits(
"EquationsMatrices_ElementMatrixInitialise")
987 999 errorsexits(
"EquationsMatrices_ElementMatrixInitialise",err,error)
997 & rowsnumberofelements,colsnumberofelements,err,error,*)
1003 INTEGER(INTG),
INTENT(IN) :: rowsNumberOfElements
1004 INTEGER(INTG),
INTENT(IN) :: colsNumberOfElements
1005 INTEGER(INTG),
INTENT(OUT) :: err
1008 INTEGER(INTG) :: dummyErr, componentIdx
1011 enters(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_SETUP",err,error,*998)
1013 IF(
ASSOCIATED(rowsfieldvariable))
THEN 1014 IF(
ASSOCIATED(columnsfieldvariable))
THEN 1015 elementmatrix%MAX_NUMBER_OF_ROWS = 0
1016 DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1017 elementmatrix%MAX_NUMBER_OF_ROWS=elementmatrix%MAX_NUMBER_OF_ROWS+ &
1018 & rowsfieldvariable%COMPONENTS(componentidx)%maxNumberElementInterpolationParameters
1020 elementmatrix%MAX_NUMBER_OF_ROWS=elementmatrix%MAX_NUMBER_OF_ROWS*rowsnumberofelements
1021 elementmatrix%MAX_NUMBER_OF_COLUMNS = 0
1022 DO componentidx=1,columnsfieldvariable%NUMBER_OF_COMPONENTS
1023 elementmatrix%MAX_NUMBER_OF_COLUMNS=elementmatrix%MAX_NUMBER_OF_COLUMNS+ &
1024 & columnsfieldvariable%COMPONENTS(componentidx)%maxNumberElementInterpolationParameters
1026 elementmatrix%MAX_NUMBER_OF_COLUMNS=elementmatrix%MAX_NUMBER_OF_COLUMNS*colsnumberofelements
1027 IF(
ALLOCATED(elementmatrix%ROW_DOFS))
THEN 1028 CALL flagerror(
"Element matrix row dofs already allocated.",err,error,*999)
1030 ALLOCATE(elementmatrix%ROW_DOFS(elementmatrix%MAX_NUMBER_OF_ROWS),stat=err)
1031 IF(err/=0)
CALL flagerror(
"Could not allocate element matrix row dofs.",err,error,*999)
1033 IF(
ALLOCATED(elementmatrix%COLUMN_DOFS))
THEN 1034 CALL flagerror(
"Element matrix column dofs already allocated.",err,error,*999)
1036 ALLOCATE(elementmatrix%COLUMN_DOFS(elementmatrix%MAX_NUMBER_OF_COLUMNS),stat=err)
1037 IF(err/=0)
CALL flagerror(
"Could not allocate element matrix column dofs.",err,error,*999)
1039 IF(
ALLOCATED(elementmatrix%MATRIX))
THEN 1040 CALL flagerror(
"Element matrix already allocated.",err,error,*999)
1042 ALLOCATE(elementmatrix%MATRIX(elementmatrix%MAX_NUMBER_OF_ROWS,elementmatrix%MAX_NUMBER_OF_COLUMNS),stat=err)
1043 IF(err/=0)
CALL flagerror(
"Could not allocate element matrix.",err,error,*999)
1046 CALL flagerror(
"Columns field variable is not associated.",err,error,*999)
1049 CALL flagerror(
"Rows field variable is not associated.",err,error,*999)
1052 exits(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_SETUP")
1055 998 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_MATRIX_SETUP",err,error)
1069 LOGICAL :: UPDATE_VECTOR
1070 INTEGER(INTG),
INTENT(IN) :: ELEMENT_NUMBER
1072 INTEGER(INTG),
INTENT(OUT) :: ERR
1075 INTEGER(INTG) :: component_idx,derivative,derivative_idx,local_ny,node,node_idx,version,dataPointIdx,localDataPointNumber
1081 enters(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_CALCULATE",err,error,*999)
1083 IF(
ASSOCIATED(rows_field_variable))
THEN 1085 element_vector%NUMBER_OF_ROWS=0
1086 IF(update_vector)
THEN 1087 DO component_idx=1,rows_field_variable%NUMBER_OF_COMPONENTS
1088 elements_topology=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%TOPOLOGY%ELEMENTS
1089 IF(element_number>=1.AND.element_number<=elements_topology%TOTAL_NUMBER_OF_ELEMENTS)
THEN 1090 SELECT CASE(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE)
1091 CASE(field_constant_interpolation)
1092 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1093 element_vector%NUMBER_OF_ROWS=element_vector%NUMBER_OF_ROWS+1
1094 element_vector%ROW_DOFS(element_vector%NUMBER_OF_ROWS)=local_ny
1095 CASE(field_element_based_interpolation)
1096 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1097 & elements(element_number)
1098 element_vector%NUMBER_OF_ROWS=element_vector%NUMBER_OF_ROWS+1
1099 element_vector%ROW_DOFS(element_vector%NUMBER_OF_ROWS)=local_ny
1100 CASE(field_node_based_interpolation)
1101 basis=>elements_topology%ELEMENTS(element_number)%BASIS
1102 DO node_idx=1,basis%NUMBER_OF_NODES
1103 node=elements_topology%ELEMENTS(element_number)%ELEMENT_NODES(node_idx)
1104 DO derivative_idx=1,basis%NUMBER_OF_DERIVATIVES(node_idx)
1105 derivative=elements_topology%ELEMENTS(element_number)%ELEMENT_DERIVATIVES(derivative_idx,node_idx)
1106 version=elements_topology%ELEMENTS(element_number)%elementVersions(derivative_idx,node_idx)
1107 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP%NODES(node)% &
1108 & derivatives(derivative)%VERSIONS(version)
1109 element_vector%NUMBER_OF_ROWS=element_vector%NUMBER_OF_ROWS+1
1110 element_vector%ROW_DOFS(element_vector%NUMBER_OF_ROWS)=local_ny
1113 CASE(field_grid_point_based_interpolation)
1114 CALL flagerror(
"Not implemented.",err,error,*999)
1115 CASE(field_gauss_point_based_interpolation)
1116 CALL flagerror(
"Not implemented.",err,error,*999)
1117 CASE(field_data_point_based_interpolation)
1118 decompositiondata=>rows_field_variable%COMPONENTS(component_idx)%DOMAIN%DECOMPOSITION%TOPOLOGY%dataPoints
1119 DO datapointidx=1,decompositiondata%elementDataPoint(element_number)%numberOfProjectedData
1120 localdatapointnumber=decompositiondata%elementDataPoint(element_number)% &
1121 & dataindices(datapointidx)%localNumber
1122 local_ny=rows_field_variable%COMPONENTS(component_idx)%PARAM_TO_DOF_MAP%DATA_POINT_PARAM2DOF_MAP% &
1123 & data_points(localdatapointnumber)
1124 element_vector%NUMBER_OF_ROWS=element_vector%NUMBER_OF_ROWS+1
1125 element_vector%ROW_DOFS(element_vector%NUMBER_OF_ROWS)=local_ny
1128 local_error=
"The interpolation type of "// &
1129 &
trim(
numbertovstring(rows_field_variable%COMPONENTS(component_idx)%INTERPOLATION_TYPE,
"*",err,error))// &
1130 &
" is invalid for component number "// &
1132 &
" of rows field variable type "// &
1134 CALL flagerror(local_error,err,error,*999)
1138 &
" is invalid for component number "//
trim(
numbertovstring(component_idx,
"*",err,error))// &
1139 &
" of rows field variable type "//
trim(
numbertovstring(rows_field_variable%VARIABLE_TYPE,
"*",err,error))// &
1140 &
". The element number must be between 1 and "// &
1142 CALL flagerror(local_error,err,error,*999)
1145 element_vector%VECTOR=0.0_dp
1148 CALL flagerror(
"Rows field variable is not associated.",err,error,*999)
1151 exits(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_CALCULATE")
1153 999 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_CALCULATE",err,error)
1167 INTEGER(INTG),
INTENT(OUT) :: ERR
1171 enters(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_FINALISE",err,error,*999)
1173 IF(
ALLOCATED(element_vector%ROW_DOFS))
DEALLOCATE(element_vector%ROW_DOFS)
1174 IF(
ALLOCATED(element_vector%VECTOR))
DEALLOCATE(element_vector%VECTOR)
1176 exits(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_FINALISE")
1178 999 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_FINALISE",err,error)
1192 INTEGER(INTG),
INTENT(OUT) :: ERR
1196 enters(
"EquationsMatrices_ElementVectorInitialise",err,error,*999)
1198 element_vector%NUMBER_OF_ROWS=0
1199 element_vector%MAX_NUMBER_OF_ROWS=0
1201 exits(
"EquationsMatrices_ElementVectorInitialise")
1203 999 errorsexits(
"EquationsMatrices_ElementVectorInitialise",err,error)
1217 INTEGER(INTG),
INTENT(OUT) :: err
1220 INTEGER(INTG) :: DUMMY_ERR,componentIdx
1223 enters(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_SETUP",err,error,*998)
1225 IF(
ASSOCIATED(rowsfieldvariable))
THEN 1226 elementvector%MAX_NUMBER_OF_ROWS = 0
1227 DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1228 elementvector%MAX_NUMBER_OF_ROWS=elementvector%MAX_NUMBER_OF_ROWS+ &
1229 & rowsfieldvariable%COMPONENTS(componentidx)%maxNumberElementInterpolationParameters
1231 IF(
ALLOCATED(elementvector%ROW_DOFS))
THEN 1232 CALL flagerror(
"Element vector row dofs is already allocated.",err,error,*999)
1234 ALLOCATE(elementvector%ROW_DOFS(elementvector%MAX_NUMBER_OF_ROWS),stat=err)
1235 IF(err/=0)
CALL flagerror(
"Could not allocate element vector row dofs.",err,error,*999)
1237 IF(
ALLOCATED(elementvector%VECTOR))
THEN 1238 CALL flagerror(
"Element vector vector already allocated.",err,error,*999)
1240 ALLOCATE(elementvector%VECTOR(elementvector%MAX_NUMBER_OF_ROWS),stat=err)
1241 IF(err/=0)
CALL flagerror(
"Could not allocate element vector vector.",err,error,*999)
1244 CALL flagerror(
"Rows field variable is not associated.",err,error,*999)
1247 exits(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_SETUP")
1250 998 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_VECTOR_SETUP",err,error)
1263 INTEGER(INTG),
INTENT(OUT) :: ERR
1266 INTEGER(INTG) :: column_idx,matrix_idx,row_idx
1277 CALL tau_static_phase_start(
"EQUATIONS_MATRICES_ELEMENT_ADD()")
1280 enters(
"EQUATIONS_MATRICES_ELEMENT_ADD",err,error,*999)
1282 IF(
ASSOCIATED(equations_matrices))
THEN 1283 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
1284 IF(
ASSOCIATED(dynamic_matrices))
THEN 1286 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
1287 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
1288 IF(
ASSOCIATED(equations_matrix))
THEN 1289 IF(equations_matrix%UPDATE_MATRIX)
THEN 1291 IF(equations_matrix%LUMPED)
THEN 1292 DO row_idx=1,equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS
1294 DO column_idx=1,equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS
1295 sum=sum+equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,column_idx)
1296 equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,column_idx)=0.0_dp
1298 equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,row_idx)=sum
1301 & equations_matrix%ELEMENT_MATRIX%COLUMN_DOFS(row_idx),equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx, &
1302 & row_idx),err,error,*999)
1307 & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS),equations_matrix%ELEMENT_MATRIX%COLUMN_DOFS(1: &
1308 & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS),equations_matrix%ELEMENT_MATRIX%MATRIX(1: &
1309 & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS,1:equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS), &
1314 local_error=
"Equations matrix for dynamic matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
1315 &
" is not associated." 1316 CALL flagerror(local_error,err,error,*999)
1320 linear_matrices=>equations_matrices%LINEAR_MATRICES
1321 IF(
ASSOCIATED(linear_matrices))
THEN 1323 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
1324 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
1325 IF(
ASSOCIATED(equations_matrix))
THEN 1326 IF(equations_matrix%UPDATE_MATRIX)
THEN 1328 IF(equations_matrix%LUMPED)
THEN 1329 DO row_idx=1,equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS
1331 DO column_idx=1,equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS
1332 sum=sum+equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,column_idx)
1333 equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,column_idx)=0.0_dp
1335 equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx,row_idx)=sum
1338 & equations_matrix%ELEMENT_MATRIX%COLUMN_DOFS(row_idx),equations_matrix%ELEMENT_MATRIX%MATRIX(row_idx, &
1339 & row_idx),err,error,*999)
1344 & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS),equations_matrix%ELEMENT_MATRIX%COLUMN_DOFS(1: &
1345 & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS),equations_matrix%ELEMENT_MATRIX%MATRIX(1: &
1346 & equations_matrix%ELEMENT_MATRIX%NUMBER_OF_ROWS,1:equations_matrix%ELEMENT_MATRIX%NUMBER_OF_COLUMNS), &
1351 local_error=
"Equations matrix for linear matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
1352 &
" is not associated." 1353 CALL flagerror(local_error,err,error,*999)
1357 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
1358 IF(
ASSOCIATED(nonlinear_matrices))
THEN 1359 IF(nonlinear_matrices%UPDATE_RESIDUAL)
THEN 1362 & nonlinear_matrices%ELEMENT_RESIDUAL%NUMBER_OF_ROWS),nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR(1:nonlinear_matrices% &
1363 & element_residual%NUMBER_OF_ROWS),err,error,*999)
1366 rhs_vector=>equations_matrices%RHS_VECTOR
1367 IF(
ASSOCIATED(rhs_vector))
THEN 1368 IF(rhs_vector%UPDATE_VECTOR)
THEN 1371 & rhs_vector%ELEMENT_VECTOR%NUMBER_OF_ROWS),rhs_vector%ELEMENT_VECTOR%VECTOR(1:rhs_vector% &
1372 & element_vector%NUMBER_OF_ROWS),err,error,*999)
1375 source_vector=>equations_matrices%SOURCE_VECTOR
1376 IF(
ASSOCIATED(source_vector))
THEN 1377 IF(source_vector%UPDATE_VECTOR)
THEN 1380 & source_vector%ELEMENT_VECTOR%NUMBER_OF_ROWS),source_vector%ELEMENT_VECTOR%VECTOR(1:source_vector% &
1381 & element_vector%NUMBER_OF_ROWS),err,error,*999)
1385 CALL flagerror(
"Equations matrices is not allocated.",err,error,*999)
1388 CALL tau_static_phase_stop(
"EQUATIONS_MATRICES_ELEMENT_ADD()")
1391 exits(
"EQUATIONS_MATRICES_ELEMENT_ADD")
1393 999 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_ADD",err,error)
1406 INTEGER(INTG),
INTENT(IN) :: ELEMENT_NUMBER
1407 INTEGER(INTG),
INTENT(OUT) :: ERR
1410 INTEGER(INTG) :: matrix_idx
1427 CALL tau_static_phase_start(
"EQUATIONS_MATRICES_ELEMENT_CALCULATE()")
1430 enters(
"EQUATIONS_MATRICES_ELEMENT_CALCULATE",err,error,*999)
1432 IF(
ASSOCIATED(equations_matrices))
THEN 1433 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
1434 IF(
ASSOCIATED(equations_mapping))
THEN 1435 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
1436 IF(
ASSOCIATED(dynamic_matrices))
THEN 1438 dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
1439 IF(
ASSOCIATED(dynamic_mapping))
THEN 1440 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
1441 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
1442 IF(
ASSOCIATED(equations_matrix))
THEN 1443 field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE
1445 & [element_number],[element_number],field_variable,field_variable,err,error,*999)
1447 local_error=
"Equations matrix for dynamic matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
1448 &
" is not associated." 1449 CALL flagerror(local_error,err,error,*999)
1453 CALL flagerror(
"Equations mapping dynamic mapping is not associated.",err,error,*999)
1456 linear_matrices=>equations_matrices%LINEAR_MATRICES
1457 IF(
ASSOCIATED(linear_matrices))
THEN 1459 linear_mapping=>equations_mapping%LINEAR_MAPPING
1460 IF(
ASSOCIATED(linear_mapping))
THEN 1461 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
1462 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
1463 IF(
ASSOCIATED(equations_matrix))
THEN 1464 field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE
1466 & [element_number],[element_number],field_variable,field_variable,err,error,*999)
1468 local_error=
"Equations matrix for linear matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
1469 &
" is not associated." 1470 CALL flagerror(local_error,err,error,*999)
1474 CALL flagerror(
"Equations mapping linear mapping is not associated.",err,error,*999)
1477 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
1478 IF(
ASSOCIATED(nonlinear_matrices))
THEN 1480 nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
1481 IF(
ASSOCIATED(nonlinear_mapping))
THEN 1482 field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
1483 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
1484 jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
1485 IF(
ASSOCIATED(jacobian_matrix))
THEN 1486 col_field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%VARIABLE
1488 & [element_number],[element_number],field_variable,col_field_variable,err,error,*999)
1490 CALL flagerror(
"Jacobian matrix is not associated.",err,error,*999)
1494 rhs_mapping=>equations_mapping%RHS_MAPPING
1495 IF(
ASSOCIATED(rhs_mapping))
THEN 1496 field_variable=>rhs_mapping%RHS_VARIABLE
1498 field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
1501 & update_residual,element_number,field_variable,err,error,*999)
1502 nonlinear_matrices%ELEMENT_RESIDUAL_CALCULATED=0
1504 CALL flagerror(
"Equations mapping nonlinear mapping is not associated.",err,error,*999)
1507 rhs_vector=>equations_matrices%RHS_VECTOR
1508 IF(
ASSOCIATED(rhs_vector))
THEN 1509 rhs_mapping=>equations_mapping%RHS_MAPPING
1510 IF(
ASSOCIATED(rhs_mapping))
THEN 1512 field_variable=>rhs_mapping%RHS_VARIABLE
1514 & field_variable,err,error,*999)
1516 CALL flagerror(
"Equations mapping rhs mapping is not associated.",err,error,*999)
1519 source_vector=>equations_matrices%SOURCE_VECTOR
1520 IF(
ASSOCIATED(source_vector))
THEN 1523 rhs_mapping=>equations_mapping%RHS_MAPPING
1524 IF(
ASSOCIATED(rhs_mapping))
THEN 1525 field_variable=>rhs_mapping%RHS_VARIABLE
1527 & element_number,field_variable,err,error,*999)
1529 CALL flagerror(
"Equations mapping rhs mapping is not associated.",err,error,*999)
1533 CALL flagerror(
"Equations mapping is not associated.",err,error,*999)
1536 CALL flagerror(
"Equations matrices is not allocated",err,error,*999)
1540 CALL tau_static_phase_stop(
"EQUATIONS_MATRICES_ELEMENT_CALCULATE()")
1543 exits(
"EQUATIONS_MATRICES_ELEMENT_CALCULATE")
1545 999 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_CALCULATE",err,error)
1558 INTEGER(INTG),
INTENT(IN) :: nodeNumber
1559 INTEGER(INTG),
INTENT(OUT) :: err
1562 INTEGER(INTG) :: matrixIdx
1579 CALL tau_static_phase_start(
"EquationsMatrices_NodalCalculate()")
1582 enters(
"EquationsMatrices_NodalCalculate",err,error,*999)
1584 IF(
ASSOCIATED(equationsmatrices))
THEN 1585 equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
1586 IF(
ASSOCIATED(equationsmapping))
THEN 1587 dynamicmatrices=>equationsmatrices%DYNAMIC_MATRICES
1588 IF(
ASSOCIATED(dynamicmatrices))
THEN 1590 dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
1591 IF(
ASSOCIATED(dynamicmapping))
THEN 1592 DO matrixidx=1,dynamicmatrices%NUMBER_OF_DYNAMIC_MATRICES
1593 equationsmatrix=>dynamicmatrices%MATRICES(matrixidx)%PTR
1594 IF(
ASSOCIATED(equationsmatrix))
THEN 1595 fieldvariable=>dynamicmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixidx)%VARIABLE
1597 & nodenumber,nodenumber,fieldvariable,fieldvariable,err,error,*999)
1599 localerror=
"Equations matrix for dynamic matrix number "//
trim(
numbertovstring(matrixidx,
"*",err,error))// &
1600 &
" is not associated." 1601 CALL flagerror(localerror,err,error,*999)
1605 CALL flagerror(
"Equations mapping dynamic mapping is not associated.",err,error,*999)
1608 linearmatrices=>equationsmatrices%LINEAR_MATRICES
1609 IF(
ASSOCIATED(linearmatrices))
THEN 1611 linearmapping=>equationsmapping%LINEAR_MAPPING
1612 IF(
ASSOCIATED(linearmapping))
THEN 1613 DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
1614 equationsmatrix=>linearmatrices%MATRICES(matrixidx)%PTR
1615 IF(
ASSOCIATED(equationsmatrix))
THEN 1616 fieldvariable=>linearmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixidx)%VARIABLE
1618 & nodenumber,nodenumber,fieldvariable,fieldvariable,err,error,*999)
1620 localerror=
"Equations matrix for linear matrix number "//
trim(
numbertovstring(matrixidx,
"*",err,error))// &
1621 &
" is not associated." 1622 CALL flagerror(localerror,err,error,*999)
1626 CALL flagerror(
"Equations mapping linear mapping is not associated.",err,error,*999)
1629 nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
1630 IF(
ASSOCIATED(nonlinearmatrices))
THEN 1632 nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
1633 IF(
ASSOCIATED(nonlinearmapping))
THEN 1634 fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
1635 DO matrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
1636 jacobianmatrix=>nonlinearmatrices%JACOBIANS(matrixidx)%PTR
1637 IF(
ASSOCIATED(jacobianmatrix))
THEN 1638 columnfieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(matrixidx)%VARIABLE
1640 & nodenumber,nodenumber,fieldvariable,columnfieldvariable,err,error,*999)
1642 CALL flagerror(
"Jacobian matrix is not associated.",err,error,*999)
1646 rhsmapping=>equationsmapping%RHS_MAPPING
1647 IF(
ASSOCIATED(rhsmapping))
THEN 1648 fieldvariable=>rhsmapping%RHS_VARIABLE
1650 fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
1653 & update_residual,nodenumber,fieldvariable,err,error,*999)
1654 nonlinearmatrices%NodalResidualCalculated=0
1656 CALL flagerror(
"Equations mapping nonlinear mapping is not associated.",err,error,*999)
1659 rhsvector=>equationsmatrices%RHS_VECTOR
1660 IF(
ASSOCIATED(rhsvector))
THEN 1661 rhsmapping=>equationsmapping%RHS_MAPPING
1662 IF(
ASSOCIATED(rhsmapping))
THEN 1664 fieldvariable=>rhsmapping%RHS_VARIABLE
1666 & fieldvariable,err,error,*999)
1668 CALL flagerror(
"Equations mapping rhs mapping is not associated.",err,error,*999)
1671 sourcevector=>equationsmatrices%SOURCE_VECTOR
1672 IF(
ASSOCIATED(sourcevector))
THEN 1675 rhsmapping=>equationsmapping%RHS_MAPPING
1676 IF(
ASSOCIATED(rhsmapping))
THEN 1677 fieldvariable=>rhsmapping%RHS_VARIABLE
1679 & nodenumber,fieldvariable,err,error,*999)
1681 CALL flagerror(
"Equations mapping rhs mapping is not associated.",err,error,*999)
1685 CALL flagerror(
"Equations mapping is not associated.",err,error,*999)
1688 CALL flagerror(
"Equations matrices is not allocated",err,error,*999)
1692 CALL tau_static_phase_stop(
"EquationsMatrices_NodalCalculate()")
1695 exits(
"EquationsMatrices_NodalCalculate")
1697 999 errorsexits(
"EquationsMatrices_NodalCalculate",err,error)
1707 & rowsfieldvariable,colsfieldvariable,err,error,*)
1711 LOGICAL :: updateMatrix
1712 INTEGER(INTG),
INTENT(IN) :: rowNodeNumber
1713 INTEGER(INTG),
INTENT(IN) :: columnNodeNumber
1716 INTEGER(INTG),
INTENT(OUT) :: err
1719 INTEGER(INTG) :: componentIdx
1720 INTEGER(INTG) :: localRow,globalRow,localColumn,globalColumn
1721 INTEGER(INTG) :: numberOfDerivatives,numberOfVersions,versionIdx,derivativeIdx
1725 enters(
"EquationsMatrices_NodalMatrixCalculate",err,error,*999)
1727 IF(
ASSOCIATED(rowsfieldvariable))
THEN 1728 IF(
ASSOCIATED(colsfieldvariable))
THEN 1729 nodalmatrix%numberOfRows=0
1730 nodalmatrix%numberOfColumns=0
1731 IF(updatematrix)
THEN 1732 IF(
ASSOCIATED(rowsfieldvariable,colsfieldvariable))
THEN 1734 DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1735 nodestopology=>rowsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES
1736 IF(rownodenumber>=1.AND.rownodenumber<=nodestopology%TOTAL_NUMBER_OF_NODES)
THEN 1737 SELECT CASE(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE)
1738 CASE(field_constant_interpolation)
1739 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1740 globalrow=rowsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localrow)
1741 nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1742 nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1743 nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1744 nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalrow
1745 CASE(field_element_based_interpolation)
1746 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1747 & elements(rownodenumber)
1748 globalrow=rowsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localrow)
1749 nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1750 nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1751 nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1752 nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalrow
1753 CASE(field_node_based_interpolation)
1754 numberofderivatives=rowsfieldvariable%components(componentidx)%domain%topology%nodes%nodes(rownodenumber)% &
1755 & number_of_derivatives
1756 DO derivativeidx=1,numberofderivatives
1757 numberofversions=rowsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES%NODES(rownodenumber)% &
1758 & derivatives(derivativeidx)%numberOfVersions
1759 DO versionidx=1,numberofversions
1760 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1761 & nodes(rownodenumber)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
1762 globalrow=rowsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localrow)
1763 nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1764 nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1765 nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1766 nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalrow
1769 CASE(field_grid_point_based_interpolation)
1770 CALL flagerror(
"Not implemented.",err,error,*999)
1771 CASE(field_gauss_point_based_interpolation)
1772 CALL flagerror(
"Not implemented.",err,error,*999)
1774 localerror=
"The interpolation type of "// &
1775 &
trim(
numbertovstring(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE,
"*",err,error))// &
1776 &
" is invalid for component number "// &
1778 &
" of rows field variable type "// &
1780 CALL flagerror(localerror,err,error,*999)
1784 &
" is invalid for component number "//
trim(
numbertovstring(componentidx,
"*",err,error))// &
1785 &
" of rows field variable type "// &
1787 &
". The nodal number must be between 1 and "// &
1789 CALL flagerror(localerror,err,error,*999)
1795 DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1796 nodestopology=>rowsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES
1797 IF(rownodenumber>=1.AND.rownodenumber<=nodestopology%TOTAL_NUMBER_OF_NODES)
THEN 1798 SELECT CASE(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE)
1799 CASE(field_constant_interpolation)
1800 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1801 nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1802 nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1803 CASE(field_element_based_interpolation)
1804 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1805 & elements(rownodenumber)
1806 nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1807 nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1808 CASE(field_node_based_interpolation)
1809 numberofderivatives=rowsfieldvariable%components(componentidx)%domain%topology%nodes%nodes(rownodenumber)% &
1810 & number_of_derivatives
1811 DO derivativeidx=1,numberofderivatives
1812 numberofversions=colsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES%NODES(rownodenumber)% &
1813 & derivatives(derivativeidx)%numberOfVersions
1814 DO versionidx=1,numberofversions
1815 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1816 & nodes(rownodenumber)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
1817 nodalmatrix%numberOfRows=nodalmatrix%numberOfRows+1
1818 nodalmatrix%rowDofs(nodalmatrix%numberOfRows)=localrow
1821 CASE(field_grid_point_based_interpolation)
1822 CALL flagerror(
"Not implemented.",err,error,*999)
1823 CASE(field_gauss_point_based_interpolation)
1824 CALL flagerror(
"Not implemented.",err,error,*999)
1826 localerror=
"The interpolation type of "// &
1827 &
trim(
numbertovstring(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE,
"*",err,error))// &
1828 &
" is invalid for component number "// &
1830 &
" of rows field variable type "// &
1832 CALL flagerror(localerror,err,error,*999)
1836 &
" is invalid for component number "//
trim(
numbertovstring(componentidx,
"*",err,error))// &
1837 &
" of rows field variable type "// &
1839 &
". The nodal number must be between 1 and "// &
1841 CALL flagerror(localerror,err,error,*999)
1845 DO componentidx=1,colsfieldvariable%NUMBER_OF_COMPONENTS
1846 nodestopology=>colsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES
1847 IF(columnnodenumber>=1.AND.columnnodenumber<=nodestopology%TOTAL_NUMBER_OF_NODES)
THEN 1848 SELECT CASE(colsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE)
1849 CASE(field_constant_interpolation)
1850 localcolumn=colsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1851 globalcolumn=colsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
1852 nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1853 nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalcolumn
1854 CASE(field_element_based_interpolation)
1855 localcolumn=colsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1856 & elements(columnnodenumber)
1857 globalcolumn=colsfieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
1858 nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1859 nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=globalcolumn
1860 CASE(field_node_based_interpolation)
1861 numberofderivatives=colsfieldvariable%components(componentidx)%domain%topology%nodes%nodes(rownodenumber)% &
1862 & number_of_derivatives
1863 DO derivativeidx=1,numberofderivatives
1864 numberofversions=colsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES%NODES(rownodenumber)% &
1865 & derivatives(derivativeidx)%numberOfVersions
1866 DO versionidx=1,numberofversions
1867 localrow=colsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1868 & nodes(rownodenumber)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
1869 nodalmatrix%numberOfColumns=nodalmatrix%numberOfColumns+1
1870 nodalmatrix%columnDofs(nodalmatrix%numberOfColumns)=localrow
1873 CASE(field_grid_point_based_interpolation)
1874 CALL flagerror(
"Not implemented.",err,error,*999)
1875 CASE(field_gauss_point_based_interpolation)
1876 CALL flagerror(
"Not implemented.",err,error,*999)
1878 localerror=
"The interpolation type of "// &
1879 &
trim(
numbertovstring(colsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE,
"*",err,error))// &
1880 &
" is invalid for component number "// &
1882 &
" of column field variable type "// &
1884 CALL flagerror(localerror,err,error,*999)
1887 localerror=
"Column nodal number "//
trim(
numbertovstring(columnnodenumber,
"*",err,error))// &
1888 &
" is invalid for component number "//
trim(
numbertovstring(componentidx,
"*",err,error))// &
1889 &
" of column field variable type "// &
1891 &
". The nodal number must be between 1 and "// &
1893 CALL flagerror(localerror,err,error,*999)
1897 nodalmatrix%matrix=0.0_dp
1900 CALL flagerror(
"Columns field variable is not associated.",err,error,*999)
1903 CALL flagerror(
"Rows field variable is not associated.",err,error,*999)
1906 exits(
"EquationsMatrices_NodalMatrixCalculate")
1908 999 errorsexits(
"EquationsMatrices_NodalMatrixCalculate",err,error)
1923 LOGICAL :: updateVector
1924 INTEGER(INTG),
INTENT(IN) :: rowNodeNumber
1926 INTEGER(INTG),
INTENT(OUT) :: err
1929 INTEGER(INTG) :: componentIdx,localRow
1930 INTEGER(INTG) :: numberOfDerivatives,numberOfVersions,versionIdx,derivativeIdx
1934 enters(
"EquationsMatrices_NodalVectorCalculate",err,error,*999)
1936 IF(
ASSOCIATED(rowsfieldvariable))
THEN 1938 nodalvector%numberOfRows=0
1939 IF(updatevector)
THEN 1940 DO componentidx=1,rowsfieldvariable%NUMBER_OF_COMPONENTS
1941 nodestopology=>rowsfieldvariable%components(componentidx)%domain%topology%nodes
1942 IF(rownodenumber>=1.AND.rownodenumber<=nodestopology%TOTAL_NUMBER_OF_NODES)
THEN 1943 SELECT CASE(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE)
1944 CASE(field_constant_interpolation)
1945 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%CONSTANT_PARAM2DOF_MAP
1946 nodalvector%numberOfRows=nodalvector%numberOfRows+1
1947 nodalvector%rowDofs(nodalvector%numberOfRows)=localrow
1948 CASE(field_element_based_interpolation)
1949 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%ELEMENT_PARAM2DOF_MAP% &
1950 & elements(rownodenumber)
1951 nodalvector%numberOfRows=nodalvector%numberOfRows+1
1952 nodalvector%rowDofs(nodalvector%numberOfRows)=localrow
1953 CASE(field_node_based_interpolation)
1954 numberofderivatives=rowsfieldvariable%components(componentidx)%domain%topology%nodes%nodes(rownodenumber)% &
1955 & number_of_derivatives
1956 DO derivativeidx=1,numberofderivatives
1957 numberofversions=rowsfieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES%NODES(rownodenumber)% &
1958 & derivatives(derivativeidx)%numberOfVersions
1959 DO versionidx=1,numberofversions
1960 localrow=rowsfieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
1961 & nodes(rownodenumber)%derivatives(derivativeidx)%versions(versionidx)
1962 nodalvector%numberOfRows=nodalvector%numberOfRows+1
1963 nodalvector%rowDofs(nodalvector%numberOfRows)=localrow
1966 CASE(field_grid_point_based_interpolation)
1967 CALL flagerror(
"Not implemented.",err,error,*999)
1968 CASE(field_gauss_point_based_interpolation)
1969 CALL flagerror(
"Not implemented.",err,error,*999)
1971 localerror=
"The interpolation type of "// &
1972 &
trim(
numbertovstring(rowsfieldvariable%COMPONENTS(componentidx)%INTERPOLATION_TYPE,
"*",err,error))// &
1973 &
" is invalid for component number "// &
1975 &
" of rows field variable type "// &
1977 CALL flagerror(localerror,err,error,*999)
1981 &
" is invalid for component number "//
trim(
numbertovstring(componentidx,
"*",err,error))// &
1982 &
" of rows field variable type "//
trim(
numbertovstring(rowsfieldvariable%VARIABLE_TYPE,
"*",err,error))// &
1983 &
". The nodal number must be between 1 and "// &
1985 CALL flagerror(localerror,err,error,*999)
1988 nodalvector%vector=0.0_dp
1991 CALL flagerror(
"Rows field variable is not associated.",err,error,*999)
1994 exits(
"EquationsMatrices_NodalVectorCalculate")
1996 999 errorsexits(
"EquationsMatrices_NodalVectorCalculate",err,error)
2010 INTEGER(INTG),
INTENT(OUT) :: err
2013 INTEGER(INTG) :: columnIdx,matrixIdx,rowIdx
2024 CALL tau_static_phase_start(
"EquationsMatrices_NodeAdd()")
2027 enters(
"EquationsMatrices_NodeAdd",err,error,*999)
2029 IF(
ASSOCIATED(equationsmatrices))
THEN 2030 dynamicmatrices=>equationsmatrices%DYNAMIC_MATRICES
2031 IF(
ASSOCIATED(dynamicmatrices))
THEN 2033 DO matrixidx=1,dynamicmatrices%NUMBER_OF_DYNAMIC_MATRICES
2034 equationsmatrix=>dynamicmatrices%MATRICES(matrixidx)%PTR
2035 IF(
ASSOCIATED(equationsmatrix))
THEN 2036 IF(equationsmatrix%UPDATE_MATRIX)
THEN 2038 IF(equationsmatrix%LUMPED)
THEN 2039 DO rowidx=1,equationsmatrix%NodalMatrix%numberOfRows
2041 DO columnidx=1,equationsmatrix%NodalMatrix%numberOfColumns
2042 sum=sum+equationsmatrix%NodalMatrix%matrix(rowidx,columnidx)
2043 equationsmatrix%NodalMatrix%matrix(rowidx,columnidx)=0.0_dp
2045 equationsmatrix%NodalMatrix%matrix(rowidx,rowidx)=sum
2048 & equationsmatrix%NodalMatrix%columnDofs(rowidx),equationsmatrix%NodalMatrix%matrix(rowidx, &
2049 & rowidx),err,error,*999)
2054 & equationsmatrix%NodalMatrix%numberOfRows),equationsmatrix%NodalMatrix%columnDofs(1: &
2055 & equationsmatrix%NodalMatrix%numberOfColumns),equationsmatrix%NodalMatrix%matrix(1: &
2056 & equationsmatrix%NodalMatrix%numberOfRows,1:equationsmatrix%NodalMatrix%numberOfColumns), &
2061 localerror=
"Equations matrix for dynamic matrix number "//
trim(
numbertovstring(matrixidx,
"*",err,error))// &
2062 &
" is not associated." 2063 CALL flagerror(localerror,err,error,*999)
2067 linearmatrices=>equationsmatrices%LINEAR_MATRICES
2068 IF(
ASSOCIATED(linearmatrices))
THEN 2070 DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
2071 equationsmatrix=>linearmatrices%MATRICES(matrixidx)%PTR
2072 IF(
ASSOCIATED(equationsmatrix))
THEN 2073 IF(equationsmatrix%UPDATE_MATRIX)
THEN 2075 IF(equationsmatrix%LUMPED)
THEN 2076 DO rowidx=1,equationsmatrix%NodalMatrix%numberOfRows
2078 DO columnidx=1,equationsmatrix%NodalMatrix%numberOfColumns
2079 sum=sum+equationsmatrix%NodalMatrix%matrix(rowidx,columnidx)
2080 equationsmatrix%NodalMatrix%matrix(rowidx,columnidx)=0.0_dp
2082 equationsmatrix%NodalMatrix%matrix(rowidx,rowidx)=sum
2085 & equationsmatrix%NodalMatrix%columnDofs(rowidx),equationsmatrix%NodalMatrix%matrix(rowidx, &
2086 & rowidx),err,error,*999)
2091 & equationsmatrix%NodalMatrix%numberOfRows),equationsmatrix%NodalMatrix%columnDofs(1: &
2092 & equationsmatrix%NodalMatrix%numberOfColumns),equationsmatrix%NodalMatrix%matrix(1: &
2093 & equationsmatrix%NodalMatrix%numberOfRows,1:equationsmatrix%NodalMatrix%numberOfColumns), &
2098 localerror=
"Equations matrix for linear matrix number "//
trim(
numbertovstring(matrixidx,
"*",err,error))// &
2099 &
" is not associated." 2100 CALL flagerror(localerror,err,error,*999)
2104 nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
2105 IF(
ASSOCIATED(nonlinearmatrices))
THEN 2106 IF(nonlinearmatrices%UPDATE_RESIDUAL)
THEN 2109 & nonlinearmatrices%NodalResidual%numberOfRows),nonlinearmatrices%NodalResidual%vector(1:nonlinearmatrices% &
2110 & nodalresidual%numberOfRows),err,error,*999)
2113 rhsvector=>equationsmatrices%RHS_VECTOR
2114 IF(
ASSOCIATED(rhsvector))
THEN 2115 IF(rhsvector%UPDATE_VECTOR)
THEN 2118 & rhsvector%NodalVector%numberOfRows),rhsvector%NodalVector%vector(1:rhsvector% &
2119 & nodalvector%numberOfRows),err,error,*999)
2122 sourcevector=>equationsmatrices%SOURCE_VECTOR
2123 IF(
ASSOCIATED(sourcevector))
THEN 2124 IF(sourcevector%UPDATE_VECTOR)
THEN 2127 & sourcevector%NodalVector%numberOfRows),sourcevector%NodalVector%vector(1:sourcevector% &
2128 & nodalvector%numberOfRows),err,error,*999)
2132 CALL flagerror(
"Equations matrices is not allocated.",err,error,*999)
2135 CALL tau_static_phase_stop(
"EquationsMatrices_NodeAdd()")
2138 exits(
"EquationsMatrices_NodeAdd")
2140 999 errorsexits(
"EquationsMatrices_NodeAdd",err,error)
2153 INTEGER(INTG),
INTENT(OUT) :: err
2156 INTEGER(INTG) :: matrixIdx
2172 enters(
"EquationsMatrices_NodalInitialise",err,error,*999)
2174 IF(
ASSOCIATED(equationsmatrices))
THEN 2175 equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
2176 IF(
ASSOCIATED(equationsmapping))
THEN 2177 dynamicmatrices=>equationsmatrices%DYNAMIC_MATRICES
2178 IF(
ASSOCIATED(dynamicmatrices))
THEN 2180 dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
2181 IF(
ASSOCIATED(dynamicmapping))
THEN 2182 DO matrixidx=1,dynamicmatrices%NUMBER_OF_DYNAMIC_MATRICES
2183 equationsmatrix=>dynamicmatrices%MATRICES(matrixidx)%PTR
2184 IF(
ASSOCIATED(equationsmatrix))
THEN 2185 fieldvariable=>dynamicmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixidx)%VARIABLE
2189 localerror=
"Equations dynamic matrix number "//
trim(
numbertovstring(matrixidx,
"*",err,error))// &
2190 &
" is not associated." 2191 CALL flagerror(localerror,err,error,*999)
2195 CALL flagerror(
"Equations mapping dynamic mapping is not associated.",err,error,*999)
2198 linearmatrices=>equationsmatrices%LINEAR_MATRICES
2199 IF(
ASSOCIATED(linearmatrices))
THEN 2201 linearmapping=>equationsmapping%LINEAR_MAPPING
2202 IF(
ASSOCIATED(linearmapping))
THEN 2203 DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
2204 equationsmatrix=>linearmatrices%MATRICES(matrixidx)%PTR
2205 IF(
ASSOCIATED(equationsmatrix))
THEN 2206 fieldvariable=>linearmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixidx)%VARIABLE
2210 localerror=
"Equations linear matrix number "//
trim(
numbertovstring(matrixidx,
"*",err,error))// &
2211 &
" is not associated." 2212 CALL flagerror(localerror,err,error,*999)
2216 CALL flagerror(
"Equations mapping linear mapping is not associated.",err,error,*999)
2219 nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
2220 IF(
ASSOCIATED(nonlinearmatrices))
THEN 2222 nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
2223 IF(
ASSOCIATED(nonlinearmapping))
THEN 2224 fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
2225 DO matrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
2226 jacobianmatrix=>nonlinearmatrices%JACOBIANS(matrixidx)%PTR
2227 IF(
ASSOCIATED(jacobianmatrix))
THEN 2228 columnfieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(matrixidx)%VARIABLE
2232 CALL flagerror(
"Jacobian matrix is not associated.",err,error,*999)
2236 rhsmapping=>equationsmapping%RHS_MAPPING
2237 IF(
ASSOCIATED(rhsmapping))
THEN 2238 fieldvariable=>rhsmapping%RHS_VARIABLE
2240 fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
2243 nonlinearmatrices%NodalResidualCalculated=0
2245 CALL flagerror(
"Equations mapping nonlinear mapping is not associated.",err,error,*999)
2248 rhsvector=>equationsmatrices%RHS_VECTOR
2249 IF(
ASSOCIATED(rhsvector))
THEN 2251 rhsmapping=>equationsmapping%RHS_MAPPING
2252 IF(
ASSOCIATED(rhsmapping))
THEN 2253 fieldvariable=>rhsmapping%RHS_VARIABLE
2256 CALL flagerror(
"RHS mapping is not associated.",err,error,*999)
2259 sourcevector=>equationsmatrices%SOURCE_VECTOR
2260 IF(
ASSOCIATED(sourcevector))
THEN 2263 IF(
ASSOCIATED(rhsvector))
THEN 2265 rhsmapping=>equationsmapping%RHS_MAPPING
2266 IF(
ASSOCIATED(rhsmapping))
THEN 2267 fieldvariable=>rhsmapping%RHS_VARIABLE
2270 CALL flagerror(
"RHS mapping is not associated.",err,error,*999)
2273 CALL flagerror(
"Not implemented.",err,error,*999)
2277 CALL flagerror(
"Equations matrices mapping is not associated.",err,error,*999)
2280 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
2283 exits(
"EquationsMatrices_NodalInitialise")
2285 999 errorsexits(
"EquationsMatrices_NodalInitialise",err,error)
2300 INTEGER(INTG),
INTENT(OUT) :: err
2303 INTEGER(INTG) :: dummyErr
2306 enters(
"EquationsMatrices_NodalMatrixSetup",err,error,*998)
2308 IF(
ASSOCIATED(rowsfieldvariable))
THEN 2309 IF(
ASSOCIATED(colsfieldvariable))
THEN 2310 nodalmatrix%maxNumberOfRows=rowsfieldvariable%maxNumberNodeInterpolationParameters* &
2311 & rowsfieldvariable%NUMBER_OF_COMPONENTS
2312 nodalmatrix%maxNumberOfColumns=colsfieldvariable%maxNumberNodeInterpolationParameters* &
2313 & colsfieldvariable%NUMBER_OF_COMPONENTS
2314 IF(
ALLOCATED(nodalmatrix%rowDofs))
THEN 2315 CALL flagerror(
"Nodal matrix row dofs already allocated.",err,error,*999)
2317 ALLOCATE(nodalmatrix%rowDofs(nodalmatrix%maxNumberOfRows),stat=err)
2318 IF(err/=0)
CALL flagerror(
"Could not allocate nodal matrix row dofs.",err,error,*999)
2320 IF(
ALLOCATED(nodalmatrix%columnDofs))
THEN 2321 CALL flagerror(
"Nodal matrix column dofs already allocated.",err,error,*999)
2323 ALLOCATE(nodalmatrix%columnDofs(nodalmatrix%maxNumberOfColumns),stat=err)
2324 IF(err/=0)
CALL flagerror(
"Could not allocate nodal matrix column dofs.",err,error,*999)
2326 IF(
ALLOCATED(nodalmatrix%matrix))
THEN 2327 CALL flagerror(
"Nodal matrix already allocated.",err,error,*999)
2329 ALLOCATE(nodalmatrix%matrix(nodalmatrix%maxNumberOfRows,nodalmatrix%maxNumberOfColumns),stat=err)
2330 IF(err/=0)
CALL flagerror(
"Could not allocate nodal matrix.",err,error,*999)
2333 CALL flagerror(
"Columns field variable is not associated.",err,error,*999)
2336 CALL flagerror(
"Rows field variable is not associated.",err,error,*999)
2339 exits(
"EquationsMatrices_NodalMatrixSetup")
2342 998 errorsexits(
"EquationsMatrices_NodalMatrixSetup",err,error)
2356 INTEGER(INTG),
INTENT(OUT) :: err
2359 INTEGER(INTG) :: dummyErr
2362 enters(
"EquationsMatrices_NodalVectorSetup",err,error,*998)
2364 IF(
ASSOCIATED(rowsfieldvariable))
THEN 2365 nodalvector%maxNumberOfRows=rowsfieldvariable%maxNumberNodeInterpolationParameters* &
2366 & rowsfieldvariable%NUMBER_OF_COMPONENTS
2367 IF(
ALLOCATED(nodalvector%rowDofs))
THEN 2368 CALL flagerror(
"Nodal vector row dofs is already allocated.",err,error,*999)
2370 ALLOCATE(nodalvector%rowDofs(nodalvector%maxNumberOfRows),stat=err)
2371 IF(err/=0)
CALL flagerror(
"Could not allocate nodal vector row dofs.",err,error,*999)
2373 IF(
ALLOCATED(nodalvector%vector))
THEN 2374 CALL flagerror(
"Nodal vector vector already allocated.",err,error,*999)
2376 ALLOCATE(nodalvector%vector(nodalvector%maxNumberOfRows),stat=err)
2377 IF(err/=0)
CALL flagerror(
"Could not allocate nodal vector vector.",err,error,*999)
2380 CALL flagerror(
"Rows field variable is not associated.",err,error,*999)
2383 exits(
"EquationsMatrices_NodalVectorSetup")
2386 998 errorsexits(
"EquationsMatrices_NodalVectorSetup",err,error)
2399 INTEGER(INTG),
INTENT(OUT) :: err
2402 INTEGER(INTG) :: matrixIdx
2412 enters(
"EquationsMatrices_NodalFinalise",err,error,*999)
2414 IF(
ASSOCIATED(equationsmatrices))
THEN 2415 dynamicmatrices=>equationsmatrices%DYNAMIC_MATRICES
2416 IF(
ASSOCIATED(dynamicmatrices))
THEN 2418 DO matrixidx=1,dynamicmatrices%NUMBER_OF_DYNAMIC_MATRICES
2419 equationsmatrix=>dynamicmatrices%MATRICES(matrixidx)%PTR
2420 IF(
ASSOCIATED(equationsmatrix))
THEN 2421 equationsmatrix%NodalMatrix%maxNumberOfRows=0
2422 equationsmatrix%NodalMatrix%maxNumberOfColumns=0
2423 IF(
ALLOCATED(equationsmatrix%NodalMatrix%rowDofs))
DEALLOCATE(equationsmatrix%NodalMatrix%rowDofs)
2424 IF(
ALLOCATED(equationsmatrix%NodalMatrix%columnDofs))
DEALLOCATE(equationsmatrix%NodalMatrix%columnDofs)
2425 IF(
ALLOCATED(equationsmatrix%NodalMatrix%matrix))
DEALLOCATE(equationsmatrix%NodalMatrix%matrix)
2427 localerror=
"Equations matrix for dynamic matrix number "//
trim(
numbertovstring(matrixidx,
"*",err,error))// &
2428 &
" is not associated." 2429 CALL flagerror(localerror,err,error,*999)
2433 linearmatrices=>equationsmatrices%LINEAR_MATRICES
2434 IF(
ASSOCIATED(linearmatrices))
THEN 2436 DO matrixidx=1,linearmatrices%NUMBER_OF_LINEAR_MATRICES
2437 equationsmatrix=>linearmatrices%MATRICES(matrixidx)%PTR
2438 IF(
ASSOCIATED(equationsmatrix))
THEN 2439 equationsmatrix%NodalMatrix%maxNumberOfRows=0
2440 equationsmatrix%NodalMatrix%maxNumberOfColumns=0
2441 IF(
ALLOCATED(equationsmatrix%NodalMatrix%rowDofs))
DEALLOCATE(equationsmatrix%NodalMatrix%rowDofs)
2442 IF(
ALLOCATED(equationsmatrix%NodalMatrix%columnDofs))
DEALLOCATE(equationsmatrix%NodalMatrix%columnDofs)
2443 IF(
ALLOCATED(equationsmatrix%NodalMatrix%matrix))
DEALLOCATE(equationsmatrix%NodalMatrix%matrix)
2445 localerror=
"Equations matrix for linear matrix number "//
trim(
numbertovstring(matrixidx,
"*",err,error))// &
2446 &
" is not associated." 2447 CALL flagerror(localerror,err,error,*999)
2451 nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
2452 IF(
ASSOCIATED(nonlinearmatrices))
THEN 2453 DO matrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
2454 jacobianmatrix=>nonlinearmatrices%JACOBIANS(matrixidx)%PTR
2455 IF(
ASSOCIATED(jacobianmatrix))
THEN 2456 jacobianmatrix%NodalJacobian%maxNumberOfRows=0
2457 jacobianmatrix%NodalJacobian%maxNumberOfColumns=0
2458 IF(
ALLOCATED(jacobianmatrix%NodalJacobian%rowDofs))
DEALLOCATE(jacobianmatrix%NodalJacobian%rowDofs)
2459 IF(
ALLOCATED(jacobianmatrix%NodalJacobian%columnDofs))
DEALLOCATE(jacobianmatrix%NodalJacobian%columnDofs)
2460 IF(
ALLOCATED(jacobianmatrix%NodalJacobian%matrix))
DEALLOCATE(jacobianmatrix%NodalJacobian%matrix)
2463 &
" is not associated.",err,error,*999)
2466 nonlinearmatrices%NodalResidual%maxNumberOfRows=0
2467 IF(
ALLOCATED(nonlinearmatrices%NodalResidual%rowDofs))
DEALLOCATE(nonlinearmatrices%NodalResidual%rowDofs)
2468 IF(
ALLOCATED(nonlinearmatrices%NodalResidual%vector))
DEALLOCATE(nonlinearmatrices%NodalResidual%vector)
2470 rhsvector=>equationsmatrices%RHS_VECTOR
2471 IF(
ASSOCIATED(rhsvector))
THEN 2473 rhsvector%NodalVector%maxNumberOfRows=0
2474 IF(
ALLOCATED(rhsvector%NodalVector%rowDofs))
DEALLOCATE(rhsvector%NodalVector%rowDofs)
2475 IF(
ALLOCATED(rhsvector%NodalVector%vector))
DEALLOCATE(rhsvector%NodalVector%vector)
2477 sourcevector=>equationsmatrices%SOURCE_VECTOR
2478 IF(
ASSOCIATED(sourcevector))
THEN 2480 sourcevector%NodalVector%maxNumberOfRows=0
2481 IF(
ALLOCATED(sourcevector%NodalVector%rowDofs))
DEALLOCATE(sourcevector%NodalVector%rowDofs)
2482 IF(
ALLOCATED(sourcevector%NodalVector%vector))
DEALLOCATE(sourcevector%NodalVector%vector)
2485 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
2488 exits(
"EquationsMatrices_NodalFinalise")
2490 999 errorsexits(
"EquationsMatrices_NodalFinalise",err,error)
2503 INTEGER(INTG),
INTENT(OUT) :: err
2507 enters(
"EquationsMatrices_NodalMatrixInitialise",err,error,*999)
2509 nodalmatrix%equationsMatrixNumber=0
2510 nodalmatrix%numberOfRows=0
2511 nodalmatrix%numberOfColumns=0
2512 nodalmatrix%maxNumberOfRows=0
2513 nodalmatrix%maxNumberOfColumns=0
2515 exits(
"EquationsMatrices_NodalMatrixInitialise")
2517 999 errorsexits(
"EquationsMatrices_NodalMatrixInitialise",err,error)
2530 INTEGER(INTG),
INTENT(OUT) :: err
2534 enters(
"EquationsMatrices_NodalMatrixFinalise",err,error,*999)
2536 IF(
ALLOCATED(nodalmatrix%rowDofs))
DEALLOCATE(nodalmatrix%rowDofs)
2537 IF(
ALLOCATED(nodalmatrix%columnDofs))
DEALLOCATE(nodalmatrix%columnDofs)
2538 IF(
ALLOCATED(nodalmatrix%matrix))
DEALLOCATE(nodalmatrix%matrix)
2540 exits(
"EquationsMatrices_NodalMatrixFinalise")
2542 999 errorsexits(
"EquationsMatrices_NodalMatrixFinalise",err,error)
2555 INTEGER(INTG),
INTENT(OUT) :: err
2559 enters(
"EquationsMatrices_NodalVectorInitialise",err,error,*999)
2561 nodalvector%numberOfRows=0
2562 nodalvector%maxNumberOfRows=0
2564 exits(
"EquationsMatrices_NodalVectorInitialise")
2566 999 errorsexits(
"EquationsMatrices_NodalVectorInitialise",err,error)
2579 INTEGER(INTG),
INTENT(OUT) :: err
2583 enters(
"EquationsMatrices_NodalVectorFinalise",err,error,*999)
2585 IF(
ALLOCATED(nodalvector%rowDofs))
DEALLOCATE(nodalvector%rowDofs)
2586 IF(
ALLOCATED(nodalvector%vector))
DEALLOCATE(nodalvector%vector)
2588 exits(
"EquationsMatrices_NodalVectorFinalise")
2590 999 errorsexits(
"EquationsMatrices_NodalVectorFinalise",err,error)
2604 INTEGER(INTG),
INTENT(OUT) :: err
2607 INTEGER(INTG) :: jacobianMatrixIdx
2613 CALL tau_static_phase_start(
"EquationsMatrices_JacobianNodeAdd()")
2616 enters(
"EquationsMatrices_JacobianNodeAdd",err,error,*999)
2618 IF(
ASSOCIATED(equationsmatrices))
THEN 2619 nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
2620 IF(
ASSOCIATED(nonlinearmatrices))
THEN 2621 DO jacobianmatrixidx=1,nonlinearmatrices%NUMBER_OF_JACOBIANS
2622 jacobianmatrix=>nonlinearmatrices%JACOBIANS(jacobianmatrixidx)%PTR
2623 IF(
ASSOCIATED(jacobianmatrix))
THEN 2624 IF(jacobianmatrix%UPDATE_JACOBIAN)
THEN 2627 & jacobianmatrix%NodalJacobian%numberOfRows),jacobianmatrix%NodalJacobian%columnDofs(1: &
2628 & jacobianmatrix%NodalJacobian%numberOfColumns),jacobianmatrix%NodalJacobian%matrix(1: &
2629 & jacobianmatrix%NodalJacobian%numberOfRows,1:jacobianmatrix%NodalJacobian%numberOfColumns), &
2633 localerror=
"Jacobian matrix for Jacobian matrix index "// &
2635 CALL flagerror(localerror,err,error,*999)
2640 CALL flagerror(
"Equations matrices is not allocated.",err,error,*999)
2643 CALL tau_static_phase_stop(
"EquationsMatrices_JacobianNodeAdd()")
2646 exits(
"EquationsMatrices_JacobianNodeAdd")
2648 999 errorsexits(
"EquationsMatrices_JacobianNodeAdd",err,error)
2661 INTEGER(INTG),
INTENT(OUT) :: ERR
2664 INTEGER(INTG) :: matrix_idx
2674 enters(
"EQUATIONS_MATRICES_ELEMENT_FINALISE",err,error,*999)
2676 IF(
ASSOCIATED(equations_matrices))
THEN 2677 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2678 IF(
ASSOCIATED(dynamic_matrices))
THEN 2680 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
2681 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
2682 IF(
ASSOCIATED(equations_matrix))
THEN 2685 local_error=
"Equations matrix for dynamic matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
2686 &
" is not associated." 2687 CALL flagerror(local_error,err,error,*999)
2691 linear_matrices=>equations_matrices%LINEAR_MATRICES
2692 IF(
ASSOCIATED(linear_matrices))
THEN 2694 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
2695 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
2696 IF(
ASSOCIATED(equations_matrix))
THEN 2699 local_error=
"Equations matrix for linear matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
2700 &
" is not associated." 2701 CALL flagerror(local_error,err,error,*999)
2705 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2706 IF(
ASSOCIATED(nonlinear_matrices))
THEN 2707 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
2708 jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
2709 IF(
ASSOCIATED(jacobian_matrix))
THEN 2710 jacobian_matrix%ELEMENT_JACOBIAN%MAX_NUMBER_OF_ROWS=0
2711 jacobian_matrix%ELEMENT_JACOBIAN%MAX_NUMBER_OF_COLUMNS=0
2712 IF(
ALLOCATED(jacobian_matrix%ELEMENT_JACOBIAN%ROW_DOFS))
DEALLOCATE(jacobian_matrix%ELEMENT_JACOBIAN%ROW_DOFS)
2713 IF(
ALLOCATED(jacobian_matrix%ELEMENT_JACOBIAN%COLUMN_DOFS))
DEALLOCATE(jacobian_matrix%ELEMENT_JACOBIAN%COLUMN_DOFS)
2714 IF(
ALLOCATED(jacobian_matrix%ELEMENT_JACOBIAN%MATRIX))
DEALLOCATE(jacobian_matrix%ELEMENT_JACOBIAN%MATRIX)
2717 &
" is not associated.",err,error,*999)
2720 nonlinear_matrices%ELEMENT_RESIDUAL%MAX_NUMBER_OF_ROWS=0
2721 IF(
ALLOCATED(nonlinear_matrices%ELEMENT_RESIDUAL%ROW_DOFS))
DEALLOCATE(nonlinear_matrices%ELEMENT_RESIDUAL%ROW_DOFS)
2722 IF(
ALLOCATED(nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR))
DEALLOCATE(nonlinear_matrices%ELEMENT_RESIDUAL%VECTOR)
2724 rhs_vector=>equations_matrices%RHS_VECTOR
2725 IF(
ASSOCIATED(rhs_vector))
THEN 2727 rhs_vector%ELEMENT_VECTOR%MAX_NUMBER_OF_ROWS=0
2728 IF(
ALLOCATED(rhs_vector%ELEMENT_VECTOR%ROW_DOFS))
DEALLOCATE(rhs_vector%ELEMENT_VECTOR%ROW_DOFS)
2729 IF(
ALLOCATED(rhs_vector%ELEMENT_VECTOR%VECTOR))
DEALLOCATE(rhs_vector%ELEMENT_VECTOR%VECTOR)
2731 source_vector=>equations_matrices%SOURCE_VECTOR
2732 IF(
ASSOCIATED(source_vector))
THEN 2734 source_vector%ELEMENT_VECTOR%MAX_NUMBER_OF_ROWS=0
2735 IF(
ALLOCATED(source_vector%ELEMENT_VECTOR%ROW_DOFS))
DEALLOCATE(source_vector%ELEMENT_VECTOR%ROW_DOFS)
2736 IF(
ALLOCATED(source_vector%ELEMENT_VECTOR%VECTOR))
DEALLOCATE(source_vector%ELEMENT_VECTOR%VECTOR)
2739 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
2742 exits(
"EQUATIONS_MATRICES_ELEMENT_FINALISE")
2744 999 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_FINALISE",err,error)
2757 INTEGER(INTG),
INTENT(OUT) :: ERR
2760 INTEGER(INTG) :: matrix_idx
2761 INTEGER(INTG) :: rowsNumberOfElements,colsNumberOfElements
2777 enters(
"EQUATIONS_MATRICES_ELEMENT_INITIALISE",err,error,*999)
2779 IF(
ASSOCIATED(equations_matrices))
THEN 2780 rowsnumberofelements=1
2781 colsnumberofelements=1
2782 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
2783 IF(
ASSOCIATED(equations_mapping))
THEN 2784 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
2785 IF(
ASSOCIATED(dynamic_matrices))
THEN 2787 dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2788 IF(
ASSOCIATED(dynamic_mapping))
THEN 2789 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
2790 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
2791 IF(
ASSOCIATED(equations_matrix))
THEN 2792 field_variable=>dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE
2794 & rowsnumberofelements,colsnumberofelements,err,error,*999)
2796 local_error=
"Equations dynamic matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
2797 &
" is not associated." 2798 CALL flagerror(local_error,err,error,*999)
2802 CALL flagerror(
"Equations mapping dynamic mapping is not associated.",err,error,*999)
2805 linear_matrices=>equations_matrices%LINEAR_MATRICES
2806 IF(
ASSOCIATED(linear_matrices))
THEN 2808 linear_mapping=>equations_mapping%LINEAR_MAPPING
2809 IF(
ASSOCIATED(linear_mapping))
THEN 2810 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
2811 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
2812 IF(
ASSOCIATED(equations_matrix))
THEN 2813 field_variable=>linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_idx)%VARIABLE
2815 & rowsnumberofelements,colsnumberofelements,err,error,*999)
2817 local_error=
"Equations linear matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))// &
2818 &
" is not associated." 2819 CALL flagerror(local_error,err,error,*999)
2823 CALL flagerror(
"Equations mapping linear mapping is not associated.",err,error,*999)
2826 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
2827 IF(
ASSOCIATED(nonlinear_matrices))
THEN 2829 nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
2830 IF(
ASSOCIATED(nonlinear_mapping))
THEN 2831 field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
2832 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
2833 jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
2834 IF(
ASSOCIATED(jacobian_matrix))
THEN 2835 col_field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(matrix_idx)%VARIABLE
2837 & rowsnumberofelements,colsnumberofelements,err,error,*999)
2839 CALL flagerror(
"Jacobian matrix is not associated.",err,error,*999)
2843 rhs_mapping=>equations_mapping%RHS_MAPPING
2844 IF(
ASSOCIATED(rhs_mapping))
THEN 2845 field_variable=>rhs_mapping%RHS_VARIABLE
2847 field_variable=>nonlinear_mapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
2850 nonlinear_matrices%ELEMENT_RESIDUAL_CALCULATED=0
2852 CALL flagerror(
"Equations mapping nonlinear mapping is not associated.",err,error,*999)
2855 rhs_vector=>equations_matrices%RHS_VECTOR
2856 IF(
ASSOCIATED(rhs_vector))
THEN 2858 rhs_mapping=>equations_mapping%RHS_MAPPING
2859 IF(
ASSOCIATED(rhs_mapping))
THEN 2860 field_variable=>rhs_mapping%RHS_VARIABLE
2863 CALL flagerror(
"RHS mapping is not associated.",err,error,*999)
2866 source_vector=>equations_matrices%SOURCE_VECTOR
2867 IF(
ASSOCIATED(source_vector))
THEN 2870 IF(
ASSOCIATED(rhs_vector))
THEN 2872 rhs_mapping=>equations_mapping%RHS_MAPPING
2873 IF(
ASSOCIATED(rhs_mapping))
THEN 2874 field_variable=>rhs_mapping%RHS_VARIABLE
2877 CALL flagerror(
"RHS mapping is not associated.",err,error,*999)
2880 CALL flagerror(
"Not implemented.",err,error,*999)
2884 CALL flagerror(
"Equations matrices mapping is not associated.",err,error,*999)
2887 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
2890 exits(
"EQUATIONS_MATRICES_ELEMENT_INITIALISE")
2892 999 errorsexits(
"EQUATIONS_MATRICES_ELEMENT_INITIALISE",err,error)
2905 INTEGER(INTG),
INTENT(OUT) :: ERR
2909 enters(
"EQUATIONS_MATRIX_FINALISE",err,error,*999)
2911 IF(
ASSOCIATED(equations_matrix))
THEN 2918 exits(
"EQUATIONS_MATRIX_FINALISE")
2920 999 errorsexits(
"EQUATIONS_MATRIX_FINALISE",err,error)
2933 INTEGER(INTG) :: MATRIX_NUMBER
2934 INTEGER(INTG),
INTENT(OUT) :: ERR
2937 INTEGER(INTG) :: DUMMY_ERR
2944 enters(
"EQUATIONS_MATRIX_DYNAMIC_INITIALISE",err,error,*998)
2946 IF(
ASSOCIATED(dynamic_matrices))
THEN 2947 IF(matrix_number>0.AND.matrix_number<=dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES)
THEN 2948 equations_matrices=>dynamic_matrices%EQUATIONS_MATRICES
2949 IF(
ASSOCIATED(equations_matrices))
THEN 2950 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
2951 IF(
ASSOCIATED(equations_mapping))
THEN 2952 dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
2953 IF(
ASSOCIATED(dynamic_mapping))
THEN 2954 IF(
ASSOCIATED(dynamic_matrices%MATRICES(matrix_number)%PTR))
THEN 2955 local_error=
"Equations matrix for dynamic matrix number "//
trim(
numbertovstring(matrix_number,
"*",err,error))// &
2956 &
" is already associated." 2957 CALL flagerror(local_error,err,error,*998)
2959 ALLOCATE(dynamic_matrices%MATRICES(matrix_number)%PTR,stat=err)
2960 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrix.",err,error,*999)
2961 equations_matrix=>dynamic_matrices%MATRICES(matrix_number)%PTR
2962 equations_matrix%MATRIX_NUMBER=matrix_number
2963 equations_matrix%DYNAMIC_MATRICES=>dynamic_matrices
2964 NULLIFY(equations_matrix%LINEAR_MATRICES)
2967 equations_matrix%LUMPED=.false.
2968 equations_matrix%UPDATE_MATRIX=.true.
2969 equations_matrix%FIRST_ASSEMBLY=.true.
2970 equations_matrix%NUMBER_OF_COLUMNS=dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_number)%NUMBER_OF_COLUMNS
2971 dynamic_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_number)%EQUATIONS_MATRIX=>equations_matrix
2972 NULLIFY(equations_matrix%MATRIX)
2975 NULLIFY(equations_matrix%TEMP_VECTOR)
2978 CALL flagerror(
"Equations mapping dynamic mapping is not associated.",err,error,*998)
2981 CALL flagerror(
"Equations mapping is not associated.",err,error,*998)
2984 CALL flagerror(
"Dynamic matrices equations matrices is not associated.",err,error,*998)
2987 local_error=
"The specified dynamic matrix number of "//
trim(
numbertovstring(matrix_number,
"*",err,error))// &
2988 &
" is invalid. The matrix number must be > 0 and <= "// &
2990 CALL flagerror(local_error,err,error,*998)
2993 CALL flagerror(
"Dynamic matrices is not associated.",err,error,*998)
2996 exits(
"EQUATIONS_MATRIX_DYNAMIC_INITIALISE")
2999 998 errorsexits(
"EQUATIONS_MATRIX_DYNAMIC_INITIALISE",err,error)
3012 INTEGER(INTG) :: MATRIX_NUMBER
3013 INTEGER(INTG),
INTENT(OUT) :: ERR
3016 INTEGER(INTG) :: DUMMY_ERR
3023 enters(
"EQUATIONS_MATRIX_LINEAR_INITIALISE",err,error,*998)
3025 IF(
ASSOCIATED(linear_matrices))
THEN 3026 IF(matrix_number>0.AND.matrix_number<=linear_matrices%NUMBER_OF_LINEAR_MATRICES)
THEN 3027 equations_matrices=>linear_matrices%EQUATIONS_MATRICES
3028 IF(
ASSOCIATED(equations_matrices))
THEN 3029 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3030 IF(
ASSOCIATED(equations_mapping))
THEN 3031 linear_mapping=>equations_mapping%LINEAR_MAPPING
3032 IF(
ASSOCIATED(linear_mapping))
THEN 3033 IF(
ASSOCIATED(linear_matrices%MATRICES(matrix_number)%PTR))
THEN 3034 local_error=
"Equations matrix for linear matrix number "//
trim(
numbertovstring(matrix_number,
"*",err,error))// &
3035 &
" is already associated." 3036 CALL flagerror(local_error,err,error,*998)
3038 ALLOCATE(linear_matrices%MATRICES(matrix_number)%PTR,stat=err)
3039 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrix.",err,error,*999)
3040 equations_matrix=>linear_matrices%MATRICES(matrix_number)%PTR
3041 equations_matrix%MATRIX_NUMBER=matrix_number
3042 NULLIFY(equations_matrix%DYNAMIC_MATRICES)
3043 equations_matrix%LINEAR_MATRICES=>linear_matrices
3046 equations_matrix%LUMPED=.false.
3047 equations_matrix%UPDATE_MATRIX=.true.
3048 equations_matrix%FIRST_ASSEMBLY=.true.
3049 equations_matrix%NUMBER_OF_COLUMNS=linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_number)%NUMBER_OF_COLUMNS
3050 linear_mapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrix_number)%EQUATIONS_MATRIX=>equations_matrix
3051 NULLIFY(equations_matrix%MATRIX)
3054 NULLIFY(equations_matrix%TEMP_VECTOR)
3057 CALL flagerror(
"Equations mapping linear mapping is not associated.",err,error,*998)
3060 CALL flagerror(
"Equations mapping is not associated.",err,error,*998)
3063 CALL flagerror(
"Linear matrices equations matrices is not associated.",err,error,*998)
3066 local_error=
"The specified linear matrix number of "//
trim(
numbertovstring(matrix_number,
"*",err,error))// &
3067 &
" is invalid. The matrix number must be > 0 and <= "// &
3069 CALL flagerror(local_error,err,error,*998)
3072 CALL flagerror(
"Linear matrices is not associated.",err,error,*998)
3075 exits(
"EQUATIONS_MATRIX_LINEAR_INITIALISE")
3078 998 errorsexits(
"EQUATIONS_MATRIX_LINEAR_INITIALISE",err,error)
3091 INTEGER(INTG),
INTENT(OUT) :: ERR
3094 INTEGER(INTG) :: matrix_idx
3096 enters(
"EQUATIONS_MATRICES_DYNAMIC_FINALISE",err,error,*999)
3098 IF(
ASSOCIATED(dynamic_matrices))
THEN 3099 IF(
ALLOCATED(dynamic_matrices%MATRICES))
THEN 3100 DO matrix_idx=1,
SIZE(dynamic_matrices%MATRICES,1)
3103 DEALLOCATE(dynamic_matrices%MATRICES)
3106 DEALLOCATE(dynamic_matrices)
3109 exits(
"EQUATIONS_MATRICES_DYNAMIC_FINALISE")
3111 999 errorsexits(
"EQUATIONS_MATRICES_DYNAMIC_FINALISE",err,error)
3124 INTEGER(INTG),
INTENT(OUT) :: ERR
3127 INTEGER(INTG) :: DUMMY_ERR,matrix_idx
3132 enters(
"EQUATIONS_MATRICES_DYNAMIC_INITIALISE",err,error,*998)
3134 IF(
ASSOCIATED(equations_matrices))
THEN 3135 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3136 IF(
ASSOCIATED(equations_mapping))
THEN 3137 dynamic_mapping=>equations_mapping%DYNAMIC_MAPPING
3138 IF(
ASSOCIATED(dynamic_mapping))
THEN 3139 IF(
ASSOCIATED(equations_matrices%DYNAMIC_MATRICES))
THEN 3140 CALL flagerror(
"Equations matrices dynamic matrices is already associated.",err,error,*998)
3142 ALLOCATE(equations_matrices%DYNAMIC_MATRICES,stat=err)
3143 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrices dynamic matrices.",err,error,*999)
3144 equations_matrices%DYNAMIC_MATRICES%EQUATIONS_MATRICES=>equations_matrices
3145 equations_matrices%DYNAMIC_MATRICES%NUMBER_OF_DYNAMIC_MATRICES=dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
3146 ALLOCATE(equations_matrices%DYNAMIC_MATRICES%MATRICES(dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES),stat=err)
3147 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrices dynamic matrices matrices.",err,error,*999)
3148 DO matrix_idx=1,dynamic_mapping%NUMBER_OF_DYNAMIC_EQUATIONS_MATRICES
3149 NULLIFY(equations_matrices%DYNAMIC_MATRICES%MATRICES(matrix_idx)%PTR)
3152 NULLIFY(equations_matrices%DYNAMIC_MATRICES%TEMP_VECTOR)
3156 CALL flagerror(
"Equations matrices equations mapping is not associated.",err,error,*998)
3159 CALL flagerror(
"Equations matrices is not associated.",err,error,*998)
3162 exits(
"EQUATIONS_MATRICES_DYNAMIC_INITIALISE")
3165 998 errorsexits(
"EQUATIONS_MATRICES_DYNAMIC_INITIALISE",err,error)
3178 INTEGER(INTG),
INTENT(OUT) :: ERR
3181 INTEGER(INTG) :: jacobian_matrix_idx
3187 CALL tau_static_phase_start(
"EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD()")
3190 enters(
"EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD",err,error,*999)
3192 IF(
ASSOCIATED(equations_matrices))
THEN 3193 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3194 IF(
ASSOCIATED(nonlinear_matrices))
THEN 3195 DO jacobian_matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
3196 jacobian_matrix=>nonlinear_matrices%JACOBIANS(jacobian_matrix_idx)%PTR
3197 IF(
ASSOCIATED(jacobian_matrix))
THEN 3198 IF(jacobian_matrix%UPDATE_JACOBIAN)
THEN 3201 & jacobian_matrix%ELEMENT_JACOBIAN%NUMBER_OF_ROWS),jacobian_matrix%ELEMENT_JACOBIAN%COLUMN_DOFS(1: &
3202 & jacobian_matrix%ELEMENT_JACOBIAN%NUMBER_OF_COLUMNS),jacobian_matrix%ELEMENT_JACOBIAN%MATRIX(1: &
3203 & jacobian_matrix%ELEMENT_JACOBIAN%NUMBER_OF_ROWS,1:jacobian_matrix%ELEMENT_JACOBIAN%NUMBER_OF_COLUMNS), &
3207 local_error=
"Jacobian matrix for Jacobian matrix index "// &
3209 CALL flagerror(local_error,err,error,*999)
3214 CALL flagerror(
"Equations matrices is not allocated.",err,error,*999)
3217 CALL tau_static_phase_stop(
"EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD()")
3220 exits(
"EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD")
3222 999 errorsexits(
"EQUATIONS_MATRICES_JACOBIAN_ELEMENT_ADD",err,error)
3234 INTEGER(INTG),
INTENT(IN) :: ID
3236 INTEGER(INTG),
INTENT(OUT) :: ERR
3239 INTEGER(INTG) :: jacobian_matrix_idx
3244 enters(
"EQUATIONS_MATRICES_JACOBIAN_OUTPUT",err,error,*999)
3246 IF(
ASSOCIATED(equations_matrices))
THEN 3247 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 3248 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3249 IF(
ASSOCIATED(nonlinear_matrices))
THEN 3251 CALL write_string(id,
"Jacobian matrices:",err,error,*999)
3252 DO jacobian_matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
3253 jacobian_matrix=>nonlinear_matrices%JACOBIANS(jacobian_matrix_idx)%PTR
3254 IF(
ASSOCIATED(jacobian_matrix))
THEN 3255 CALL write_string(id,
"Jacobian matrix:",err,error,*999)
3258 local_error=
"Jacobian matrix for Jacobian matrix index "// &
3260 CALL flagerror(local_error,err,error,*999)
3265 CALL flagerror(
"Equations matrices have not been finished.",err,error,*999)
3268 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
3271 exits(
"EQUATIONS_MATRICES_JACOBIAN_OUTPUT")
3273 999 errorsexits(
"EQUATIONS_MATRICES_JACOBIAN_OUTPUT",err,error)
3286 INTEGER(INTG),
INTENT(IN) :: jacobianTypes(:)
3287 INTEGER(INTG),
INTENT(OUT) :: err
3291 INTEGER(INTG) :: matrixIdx,numberOfjacobians,jacobianType
3294 enters(
"EquationsMatrices_JacobianTypesSet",err,error,*999)
3296 IF(
ASSOCIATED(equationsmatrices))
THEN 3297 nonlinearmatrices=>equationsmatrices%NONLINEAR_MATRICES
3298 IF(
ASSOCIATED(nonlinearmatrices))
THEN 3299 numberofjacobians=
SIZE(jacobiantypes,1)
3300 IF(numberofjacobians==nonlinearmatrices%NUMBER_OF_JACOBIANS)
THEN 3301 DO matrixidx=1,numberofjacobians
3302 jacobiantype=jacobiantypes(matrixidx)
3303 SELECT CASE(jacobiantype)
3306 nonlinearmatrices%JACOBIANS(matrixidx)%PTR%JACOBIAN_CALCULATION_TYPE=jacobiantype
3308 localerror=
"Invalid Jacobian calculation type of " &
3310 CALL flagerror(localerror,err,error,*999)
3314 localerror=
"Invalid number of Jacobian calculation types. The number of types " &
3316 & //
" should be "//
trim(
numbertovstring(nonlinearmatrices%NUMBER_OF_JACOBIANS,
"*",err,error))
3317 CALL flagerror(localerror,err,error,*999)
3320 CALL flagerror(
"Equations matrices nonlinear matrices are not associated",err,error,*999)
3323 CALL flagerror(
"Equations matrices are not associated",err,error,*999)
3326 exits(
"EquationsMatrices_JacobianTypesSet")
3328 999 errorsexits(
"EquationsMatrices_JacobianTypesSet",err,error)
3341 INTEGER(INTG),
INTENT(OUT) :: ERR
3344 INTEGER(INTG) :: matrix_idx
3346 enters(
"EQUATIONS_MATRICES_LINEAR_FINALISE",err,error,*999)
3348 IF(
ASSOCIATED(linear_matrices))
THEN 3349 IF(
ALLOCATED(linear_matrices%MATRICES))
THEN 3350 DO matrix_idx=1,
SIZE(linear_matrices%MATRICES,1)
3353 DEALLOCATE(linear_matrices%MATRICES)
3355 DEALLOCATE(linear_matrices)
3358 exits(
"EQUATIONS_MATRICES_LINEAR_FINALISE")
3360 999 errorsexits(
"EQUATIONS_MATRICES_LINEAR_FINALISE",err,error)
3373 INTEGER(INTG),
INTENT(OUT) :: ERR
3376 INTEGER(INTG) :: DUMMY_ERR,matrix_idx
3381 enters(
"EQUATIONS_MATRICES_LINEAR_INITIALISE",err,error,*998)
3383 IF(
ASSOCIATED(equations_matrices))
THEN 3384 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3385 IF(
ASSOCIATED(equations_mapping))
THEN 3386 linear_mapping=>equations_mapping%LINEAR_MAPPING
3387 IF(
ASSOCIATED(linear_mapping))
THEN 3388 IF(
ASSOCIATED(equations_matrices%LINEAR_MATRICES))
THEN 3389 CALL flagerror(
"Equations matrices linear matrices is already associated.",err,error,*998)
3391 ALLOCATE(equations_matrices%LINEAR_MATRICES,stat=err)
3392 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrices linear matrices.",err,error,*999)
3393 equations_matrices%LINEAR_MATRICES%EQUATIONS_MATRICES=>equations_matrices
3394 equations_matrices%LINEAR_MATRICES%NUMBER_OF_LINEAR_MATRICES=linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
3395 ALLOCATE(equations_matrices%LINEAR_MATRICES%MATRICES(linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES),stat=err)
3396 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrices linear matrices matrices.",err,error,*999)
3397 DO matrix_idx=1,linear_mapping%NUMBER_OF_LINEAR_EQUATIONS_MATRICES
3398 NULLIFY(equations_matrices%LINEAR_MATRICES%MATRICES(matrix_idx)%PTR)
3404 CALL flagerror(
"Equations matrices equations mapping is not associated.",err,error,*998)
3407 CALL flagerror(
"Equations matrices is not associated.",err,error,*998)
3410 exits(
"EQUATIONS_MATRICES_LINEAR_INITIALISE")
3413 998 errorsexits(
"EQUATIONS_MATRICES_LINEAR_INITIALISE",err,error)
3426 INTEGER(INTG),
INTENT(OUT) :: ERR
3429 INTEGER(INTG) :: matrix_idx
3431 enters(
"EQUATIONS_MATRICES_NONLINEAR_FINALISE",err,error,*999)
3433 IF(
ASSOCIATED(nonlinear_matrices))
THEN 3434 IF(
ALLOCATED(nonlinear_matrices%JACOBIANS))
THEN 3435 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
3438 DEALLOCATE(nonlinear_matrices%JACOBIANS)
3443 DEALLOCATE(nonlinear_matrices)
3446 exits(
"EQUATIONS_MATRICES_NONLINEAR_FINALISE")
3448 999 errorsexits(
"EQUATIONS_MATRICES_NONLINEAR_FINALISE",err,error)
3461 INTEGER(INTG),
INTENT(OUT) :: ERR
3464 INTEGER(INTG) :: matrix_idx,DUMMY_ERR
3469 enters(
"EQUATIONS_MATRICES_NONLINEAR_INITIALISE",err,error,*998)
3471 IF(
ASSOCIATED(equations_matrices))
THEN 3472 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3473 IF(
ASSOCIATED(equations_mapping))
THEN 3474 nonlinear_mapping=>equations_mapping%NONLINEAR_MAPPING
3475 IF(
ASSOCIATED(nonlinear_mapping))
THEN 3476 IF(
ASSOCIATED(equations_matrices%NONLINEAR_MATRICES))
THEN 3477 CALL flagerror(
"Equations matrices nonlinear matrices is already associated.",err,error,*998)
3479 ALLOCATE(equations_matrices%NONLINEAR_MATRICES,stat=err)
3480 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrices nonlinear matrices.",err,error,*999)
3481 equations_matrices%NONLINEAR_MATRICES%EQUATIONS_MATRICES=>equations_matrices
3482 equations_matrices%NONLINEAR_MATRICES%UPDATE_RESIDUAL=.true.
3483 equations_matrices%NONLINEAR_MATRICES%FIRST_ASSEMBLY=.true.
3484 NULLIFY(equations_matrices%NONLINEAR_MATRICES%RESIDUAL)
3487 equations_matrices%NONLINEAR_MATRICES%NUMBER_OF_JACOBIANS=nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
3488 ALLOCATE(equations_matrices%NONLINEAR_MATRICES%JACOBIANS(nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES),stat=err)
3489 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrices Jacobian matrices.",err,error,*999)
3490 DO matrix_idx=1,nonlinear_mapping%NUMBER_OF_RESIDUAL_VARIABLES
3491 NULLIFY(equations_matrices%NONLINEAR_MATRICES%JACOBIANS(matrix_idx)%PTR)
3497 CALL flagerror(
"Equations matrices equations mapping is not associated.",err,error,*999)
3500 CALL flagerror(
"Equations matrices is not associated.",err,error,*998)
3503 exits(
"EQUATIONS_MATRICES_NONLINEAR_INITIALISE")
3506 998 errorsexits(
"EQUATIONS_MATRICES_NONLINEAR_INITIALISE",err,error)
3518 INTEGER(INTG),
INTENT(IN) :: ID
3520 INTEGER(INTG),
INTENT(OUT) :: ERR
3523 INTEGER(INTG) :: matrix_idx
3531 enters(
"EQUATIONS_MATRICES_OUTPUT",err,error,*999)
3533 IF(
ASSOCIATED(equations_matrices))
THEN 3534 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 3536 CALL write_string(id,
"Equations matrices:",err,error,*999)
3537 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
3538 IF(
ASSOCIATED(dynamic_matrices))
THEN 3539 CALL write_string(id,
"Dynamic matrices:",err,error,*999)
3540 CALL write_string_value(id,
"Number of dynamic matrices = ",dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES,err,error,*999)
3541 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
3542 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
3543 IF(
ASSOCIATED(equations_matrix))
THEN 3547 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
3551 linear_matrices=>equations_matrices%LINEAR_MATRICES
3552 IF(
ASSOCIATED(linear_matrices))
THEN 3553 CALL write_string(id,
"Linear matrices:",err,error,*999)
3554 CALL write_string_value(id,
"Number of linear matrices = ",linear_matrices%NUMBER_OF_LINEAR_MATRICES,err,error,*999)
3555 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
3556 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
3557 IF(
ASSOCIATED(equations_matrix))
THEN 3561 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
3565 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3566 IF(
ASSOCIATED(nonlinear_matrices))
THEN 3567 CALL write_string(id,
"Nonlinear vectors:",err,error,*999)
3568 IF(
ASSOCIATED(nonlinear_matrices%RESIDUAL))
THEN 3569 CALL write_string(id,
"Residual vector:",err,error,*999)
3572 CALL flagerror(
"Nonlinear matrices residual is not associated.",err,error,*999)
3575 rhs_vector=>equations_matrices%RHS_VECTOR
3576 IF(
ASSOCIATED(rhs_vector))
THEN 3580 source_vector=>equations_matrices%SOURCE_VECTOR
3581 IF(
ASSOCIATED(source_vector))
THEN 3586 CALL flagerror(
"Equations matrices have not been finished.",err,error,*999)
3589 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
3592 exits(
"EQUATIONS_MATRICES_OUTPUT")
3594 999 errorsexits(
"EQUATIONS_MATRICES_OUTPUT",err,error)
3607 INTEGER(INTG),
INTENT(OUT) :: ERR
3611 enters(
"EQUATIONS_MATRICES_RHS_FINALISE",err,error,*999)
3613 IF(
ASSOCIATED(rhs_vector))
THEN 3617 DEALLOCATE(rhs_vector)
3620 exits(
"EQUATIONS_MATRICES_RHS_FINALISE")
3622 999 errorsexits(
"EQUATIONS_MATRICES_RHS_FINALISE",err,error)
3635 INTEGER(INTG),
INTENT(OUT) :: ERR
3638 INTEGER(INTG) :: DUMMY_ERR
3643 enters(
"EQUATIONS_MATRICES_RHS_INITIALISE",err,error,*998)
3645 IF(
ASSOCIATED(equations_matrices))
THEN 3646 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3647 IF(
ASSOCIATED(equations_mapping))
THEN 3648 rhs_mapping=>equations_mapping%RHS_MAPPING
3649 IF(
ASSOCIATED(rhs_mapping))
THEN 3650 IF(
ASSOCIATED(equations_matrices%RHS_VECTOR))
THEN 3651 CALL flagerror(
"Equations matrices RHS vector is already associated.",err,error,*998)
3653 ALLOCATE(equations_matrices%RHS_VECTOR,stat=err)
3654 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrices RHS vector.",err,error,*999)
3655 equations_matrices%RHS_VECTOR%UPDATE_VECTOR=.true.
3656 equations_matrices%RHS_VECTOR%FIRST_ASSEMBLY=.true.
3657 NULLIFY(equations_matrices%RHS_VECTOR%VECTOR)
3663 CALL flagerror(
"Equations matrices equation mapping is not associated.",err,error,*998)
3666 CALL flagerror(
"Equations matrices is not associated.",err,error,*998)
3669 exits(
"EQUATIONS_MATRICES_RHS_INITIALISE")
3672 998 errorsexits(
"EQUATIONS_MATRICES_RHS_INITIALISE",err,error)
3685 INTEGER(INTG),
INTENT(OUT) :: ERR
3689 enters(
"EQUATIONS_MATRICES_SOURCE_FINALISE",err,error,*999)
3691 IF(
ASSOCIATED(source_vector))
THEN 3695 DEALLOCATE(source_vector)
3698 exits(
"EQUATIONS_MATRICES_SOURCE_FINALISE")
3700 999 errorsexits(
"EQUATIONS_MATRICES_SOURCE_FINALISE",err,error)
3713 INTEGER(INTG),
INTENT(OUT) :: ERR
3716 INTEGER(INTG) :: DUMMY_ERR
3721 enters(
"EQUATIONS_MATRICES_SOURCE_INITIALISE",err,error,*998)
3723 IF(
ASSOCIATED(equations_matrices))
THEN 3724 equations_mapping=>equations_matrices%EQUATIONS_MAPPING
3725 IF(
ASSOCIATED(equations_mapping))
THEN 3726 source_mapping=>equations_mapping%SOURCE_MAPPING
3727 IF(
ASSOCIATED(source_mapping))
THEN 3728 IF(
ASSOCIATED(equations_matrices%SOURCE_VECTOR))
THEN 3729 CALL flagerror(
"Equations matrices source vector is already associated.",err,error,*998)
3731 ALLOCATE(equations_matrices%SOURCE_VECTOR,stat=err)
3732 IF(err/=0)
CALL flagerror(
"Could not allocate equations matrices source vector.",err,error,*999)
3733 equations_matrices%SOURCE_VECTOR%UPDATE_VECTOR=.true.
3734 equations_matrices%SOURCE_VECTOR%FIRST_ASSEMBLY=.true.
3735 NULLIFY(equations_matrices%SOURCE_VECTOR%VECTOR)
3741 CALL flagerror(
"Equations matrices equation mapping is not associated.",err,error,*998)
3744 CALL flagerror(
"Equations matrices is not associated.",err,error,*998)
3747 exits(
"EQUATIONS_MATRICES_SOURCE_INITIALISE")
3750 998 errorsexits(
"EQUATIONS_MATRICES_SOURCE_INITIALISE",err,error)
3763 INTEGER(INTG),
INTENT(IN) :: LUMPING_TYPE(:)
3764 INTEGER(INTG),
INTENT(OUT) :: ERR
3767 INTEGER(INTG) :: matrix_idx
3772 enters(
"EQUATIONS_MATRICES_DYNAMIC_LUMPING_TYPE_SET",err,error,*999)
3774 IF(
ASSOCIATED(equations_matrices))
THEN 3775 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 3776 CALL flagerror(
"Equations matrices have already been finished.",err,error,*999)
3778 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
3779 IF(
ASSOCIATED(dynamic_matrices))
THEN 3780 IF(
SIZE(lumping_type,1)==dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES)
THEN 3781 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
3782 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
3783 IF(
ASSOCIATED(equations_matrix))
THEN 3784 SELECT CASE(lumping_type(matrix_idx))
3786 equations_matrix%LUMPED=.false.
3788 equations_matrix%LUMPED=.true.
3790 local_error=
"The specified lumping type of "//
trim(
numbertovstring(lumping_type(matrix_idx),
"*",err,error))// &
3791 &
" for the dynamic matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))//
" is invalid." 3792 CALL flagerror(local_error,err,error,*999)
3795 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
3799 local_error=
"The size of the lumping type array ("//
trim(
numbertovstring(
SIZE(lumping_type,1),
"*",err,error))// &
3800 &
") is not equal to the number of dynamic matrices ("// &
3802 CALL flagerror(local_error,err,error,*999)
3805 CALL flagerror(
"Equations matrices dynamic matrices is not associated.",err,error,*999)
3809 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
3812 exits(
"EQUATIONS_MATRICES_DYNAMIC_LUMPING_TYPE_SET")
3814 999 errorsexits(
"EQUATIONS_MATRICES_DYNAMIC_LUMPING_TYPE_SET",err,error)
3827 INTEGER(INTG),
INTENT(IN) :: STORAGE_TYPE(:)
3828 INTEGER(INTG),
INTENT(OUT) :: ERR
3831 INTEGER(INTG) :: matrix_idx
3836 enters(
"EQUATIONS_MATRICES_DYNAMIC_STORAGE_TYPE_SET",err,error,*999)
3838 IF(
ASSOCIATED(equations_matrices))
THEN 3839 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 3840 CALL flagerror(
"Equations matrices have already been finished.",err,error,*999)
3842 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
3843 IF(
ASSOCIATED(dynamic_matrices))
THEN 3844 IF(
SIZE(storage_type,1)==dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES)
THEN 3845 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
3846 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
3847 IF(
ASSOCIATED(equations_matrix))
THEN 3848 SELECT CASE(storage_type(matrix_idx))
3864 local_error=
"The specified storage type of "//
trim(
numbertovstring(storage_type(matrix_idx),
"*",err,error))// &
3865 &
" for the dynamic matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))//
" is invalid." 3866 CALL flagerror(local_error,err,error,*999)
3869 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
3873 local_error=
"The size of the storage type array ("//
trim(
numbertovstring(
SIZE(storage_type,1),
"*",err,error))// &
3874 &
") is not equal to the number of dynamic matrices ("// &
3876 CALL flagerror(local_error,err,error,*999)
3879 CALL flagerror(
"Equations matrices dynamic matrices is not associated.",err,error,*999)
3883 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
3886 exits(
"EQUATIONS_MATRICES_DYNAMIC_STORAGE_TYPE_SET")
3888 999 errorsexits(
"EQUATIONS_MATRICES_DYNAMIC_STORAGE_TYPE_SET",err,error)
3901 INTEGER(INTG),
INTENT(IN) :: STORAGE_TYPE(:)
3902 INTEGER(INTG),
INTENT(OUT) :: ERR
3905 INTEGER(INTG) :: matrix_idx
3910 enters(
"EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET",err,error,*999)
3912 IF(
ASSOCIATED(equations_matrices))
THEN 3913 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 3914 CALL flagerror(
"Equations matrices have been finished.",err,error,*999)
3916 linear_matrices=>equations_matrices%LINEAR_MATRICES
3917 IF(
ASSOCIATED(linear_matrices))
THEN 3918 IF(
SIZE(storage_type,1)==linear_matrices%NUMBER_OF_LINEAR_MATRICES)
THEN 3919 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
3920 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
3921 IF(
ASSOCIATED(equations_matrix))
THEN 3922 SELECT CASE(storage_type(matrix_idx))
3938 local_error=
"The specified storage type of "//
trim(
numbertovstring(storage_type(matrix_idx),
"*",err,error))// &
3939 &
" for the linear matrix number "//
trim(
numbertovstring(matrix_idx,
"*",err,error))//
" is invalid." 3940 CALL flagerror(local_error,err,error,*999)
3943 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
3947 local_error=
"The size of the storage type array ("//
trim(
numbertovstring(
SIZE(storage_type,1),
"*",err,error))// &
3948 &
") is not equal to the number of linear matrices ("// &
3950 CALL flagerror(local_error,err,error,*999)
3953 CALL flagerror(
"Equations matrices linear matrices is not associated.",err,error,*999)
3957 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
3960 exits(
"EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET")
3962 999 errorsexits(
"EQUATIONS_MATRICES_LINEAR_STORAGE_TYPE_SET",err,error)
3975 INTEGER(INTG),
INTENT(IN) :: STORAGE_TYPE(:)
3976 INTEGER(INTG),
INTENT(OUT) :: ERR
3979 INTEGER(INTG) :: matrix_idx
3984 enters(
"EquationsMatrices_NonlinearStorageTypeSet0",err,error,*999)
3986 IF(
ASSOCIATED(equations_matrices))
THEN 3987 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 3988 CALL flagerror(
"Equations matrices have been finished.",err,error,*999)
3990 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
3991 IF(
ASSOCIATED(nonlinear_matrices))
THEN 3992 IF(
SIZE(storage_type,1)==nonlinear_matrices%NUMBER_OF_JACOBIANS)
THEN 3993 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
3994 jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
3995 IF(
ASSOCIATED(jacobian_matrix))
THEN 3996 SELECT CASE(storage_type(matrix_idx))
4012 local_error=
"The specified storage type of "//
trim(
numbertovstring(storage_type(matrix_idx),
"*",err,error))// &
4013 &
" for the Jacobian matrix is invalid." 4014 CALL flagerror(local_error,err,error,*999)
4017 CALL flagerror(
"Jacobian matrix is not associated.",err,error,*999)
4021 local_error=
"The size of the storage type array ("//
trim(
numbertovstring(
SIZE(storage_type,1),
"*",err,error))// &
4022 &
") is not equal to the number of Jacobian matrices ("// &
4024 CALL flagerror(local_error,err,error,*999)
4027 CALL flagerror(
"Equations matrices nonlinear matrices is not associated.",err,error,*999)
4031 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
4034 exits(
"EquationsMatrices_NonlinearStorageTypeSet0")
4036 999 errorsexits(
"EquationsMatrices_NonlinearStorageTypeSet0",err,error)
4049 INTEGER(INTG),
INTENT(IN) :: STORAGE_TYPE
4050 INTEGER(INTG),
INTENT(OUT) :: ERR
4053 INTEGER(INTG),
ALLOCATABLE :: STORAGE_TYPES(:)
4056 enters(
"EquationsMatrices_NonlinearStorageTypeSet1",err,error,*999)
4058 IF(
ASSOCIATED(equations_matrices))
THEN 4059 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 4060 CALL flagerror(
"Equations matrices have been finished.",err,error,*999)
4062 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4063 IF(
ASSOCIATED(nonlinear_matrices))
THEN 4064 ALLOCATE(storage_types(nonlinear_matrices%NUMBER_OF_JACOBIANS),stat=err)
4065 IF(err/=0)
CALL flagerror(
"Could not allocate storage types.",err,error,*999)
4066 storage_types=storage_type
4068 DEALLOCATE(storage_types)
4070 CALL flagerror(
"Equations matrices nonlinear matrices is not associated.",err,error,*999)
4074 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
4077 exits(
"EquationsMatrices_NonlinearStorageTypeSet1")
4079 999 errorsexits(
"EquationsMatrices_NonlinearStorageTypeSet1",err,error)
4093 INTEGER(INTG),
INTENT(IN) :: STRUCTURE_TYPE(:)
4094 INTEGER(INTG),
INTENT(OUT) :: ERR
4097 INTEGER(INTG) :: matrix_idx
4102 enters(
"EquationsMatrices_DynamicStructureTypeSet",err,error,*999)
4104 IF(
ASSOCIATED(equations_matrices))
THEN 4105 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 4106 CALL flagerror(
"Equations matrices have been finished.",err,error,*999)
4108 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4109 IF(
ASSOCIATED(dynamic_matrices))
THEN 4110 IF(
SIZE(structure_type,1)==dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES)
THEN 4111 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
4112 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
4113 IF(
ASSOCIATED(equations_matrix))
THEN 4114 SELECT CASE(structure_type(matrix_idx))
4124 local_error=
"The specified strucutre type of "// &
4125 &
trim(
numbertovstring(structure_type(matrix_idx),
"*",err,error))//
" for dynamic matrix number "// &
4127 CALL flagerror(local_error,err,error,*999)
4130 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
4134 local_error=
"The size of the structure type array ("//
trim(
numbertovstring(
SIZE(structure_type,1),
"*",err,error))// &
4135 &
") is not equal to the number of dynamic matrices ("// &
4137 CALL flagerror(local_error,err,error,*999)
4140 CALL flagerror(
"Equations matrices dynamic matrices is not associated.",err,error,*999)
4144 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
4147 exits(
"EquationsMatrices_DynamicStructureTypeSet")
4149 999 errorsexits(
"EquationsMatrices_DynamicStructureTypeSet",err,error)
4163 INTEGER(INTG),
INTENT(IN) :: STRUCTURE_TYPE(:)
4164 INTEGER(INTG),
INTENT(OUT) :: ERR
4167 INTEGER(INTG) :: matrix_idx
4172 enters(
"EquationsMatrices_LinearStructureTypeSet",err,error,*999)
4174 IF(
ASSOCIATED(equations_matrices))
THEN 4175 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 4176 CALL flagerror(
"Equations matrices have been finished.",err,error,*999)
4178 linear_matrices=>equations_matrices%LINEAR_MATRICES
4179 IF(
ASSOCIATED(linear_matrices))
THEN 4180 IF(
SIZE(structure_type,1)==linear_matrices%NUMBER_OF_LINEAR_MATRICES)
THEN 4181 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
4182 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
4183 IF(
ASSOCIATED(equations_matrix))
THEN 4184 SELECT CASE(structure_type(matrix_idx))
4194 local_error=
"The specified strucutre type of "// &
4195 &
trim(
numbertovstring(structure_type(matrix_idx),
"*",err,error))//
" for linear matrix number "// &
4197 CALL flagerror(local_error,err,error,*999)
4200 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
4204 local_error=
"The size of the structure type array ("//
trim(
numbertovstring(
SIZE(structure_type,1),
"*",err,error))// &
4205 &
") is not equal to the number of linear matrices ("// &
4207 CALL flagerror(local_error,err,error,*999)
4210 CALL flagerror(
"Equations matrices linear matrices is not associated.",err,error,*999)
4214 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
4217 exits(
"EquationsMatrices_LinearStructureTypeSet")
4219 999 errorsexits(
"EquationsMatrices_LinearStructureTypeSet",err,error)
4233 INTEGER(INTG),
INTENT(IN) :: STRUCTURE_TYPE(:)
4234 INTEGER(INTG),
INTENT(OUT) :: ERR
4237 INTEGER(INTG) :: matrix_idx
4242 enters(
"EquationsMatrices_NonlinearStructureTypeSet0",err,error,*999)
4244 IF(
ASSOCIATED(equations_matrices))
THEN 4245 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 4246 CALL flagerror(
"Equations matrices have been finished.",err,error,*999)
4248 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4249 IF(
ASSOCIATED(nonlinear_matrices))
THEN 4250 IF(
SIZE(structure_type,1)==nonlinear_matrices%NUMBER_OF_JACOBIANS)
THEN 4251 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
4252 jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
4253 IF(
ASSOCIATED(jacobian_matrix))
THEN 4254 SELECT CASE(structure_type(matrix_idx))
4264 local_error=
"The specified strucutre type of "// &
4265 &
trim(
numbertovstring(structure_type(matrix_idx),
"*",err,error))//
" for the Jacobian matrix is invalid." 4266 CALL flagerror(local_error,err,error,*999)
4269 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
4273 local_error=
"The size of the structure type array ("//
trim(
numbertovstring(
SIZE(structure_type,1),
"*",err,error))// &
4274 &
") is not equal to the number of Jacobian matrices ("// &
4276 CALL flagerror(local_error,err,error,*999)
4279 CALL flagerror(
"Equations matrices nonlinear matrices is not associated.",err,error,*999)
4283 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
4286 exits(
"EquationsMatrices_NonlinearStructureTypeSet0")
4288 999
errors(
"EquationsMatrices_NonlinearStructureTypeSet0",err,error)
4289 exits(
"EquationsMatrices_NonlinearStructureTypeSet0")
4303 INTEGER(INTG),
INTENT(IN) :: STRUCTURE_TYPE
4304 INTEGER(INTG),
INTENT(OUT) :: ERR
4307 INTEGER(INTG),
ALLOCATABLE :: STRUCTURE_TYPES(:)
4310 enters(
"EquationsMatrices_NonlinearStructureTypeSet1",err,error,*999)
4312 IF(
ASSOCIATED(equations_matrices))
THEN 4313 IF(equations_matrices%EQUATIONS_MATRICES_FINISHED)
THEN 4314 CALL flagerror(
"Equations matrices have been finished.",err,error,*999)
4316 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4317 IF(
ASSOCIATED(nonlinear_matrices))
THEN 4318 ALLOCATE(structure_types(nonlinear_matrices%NUMBER_OF_JACOBIANS),stat=err)
4319 IF(err/=0)
CALL flagerror(
"Could not allocate storage types.",err,error,*999)
4320 structure_types=structure_type
4322 DEALLOCATE(structure_types)
4324 CALL flagerror(
"Equations matrices nonlinear matrices is not associated.",err,error,*999)
4328 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
4331 exits(
"EquationsMatrices_NonlinearStructureTypeSet1")
4333 999
errors(
"EquationsMatrices_NonlinearStructureTypeSet1",err,error)
4334 exits(
"EquationsMatrices_NonlinearStructureTypeSet1")
4348 INTEGER(INTG),
INTENT(OUT) :: ERR
4352 enters(
"EQUATIONS_MATRICES_FINALISE",err,error,*999)
4354 IF(
ASSOCIATED(equations_matrices))
THEN 4360 DEALLOCATE(equations_matrices)
4363 exits(
"EQUATIONS_MATRICES_FINALISE")
4365 999 errorsexits(
"EQUATIONS_MATRICES_FINALISE",err,error)
4378 INTEGER(INTG),
INTENT(OUT) :: ERR
4381 INTEGER(INTG) :: DUMMY_ERR
4385 enters(
"EQUATIONS_MATRICES_INITIALISE",err,error,*998)
4387 IF(
ASSOCIATED(equations))
THEN 4388 IF(
ASSOCIATED(equations%EQUATIONS_MATRICES))
THEN 4389 CALL flagerror(
"Equations matrices is already associated for this equations.",err,error,*998)
4391 equations_mapping=>equations%EQUATIONS_MAPPING
4392 IF(
ASSOCIATED(equations_mapping))
THEN 4393 IF(equations_mapping%EQUATIONS_MAPPING_FINISHED)
THEN 4394 ALLOCATE(equations%EQUATIONS_MATRICES,stat=err)
4395 IF(err/=0)
CALL flagerror(
"Could not allocate equations equations matrices.",err,error,*999)
4396 equations%EQUATIONS_MATRICES%EQUATIONS=>equations
4397 equations%EQUATIONS_MATRICES%EQUATIONS_MATRICES_FINISHED=.false.
4398 equations%EQUATIONS_MATRICES%EQUATIONS_MAPPING=>equations_mapping
4399 NULLIFY(equations%EQUATIONS_MATRICES%SOLVER_MAPPING)
4400 equations%EQUATIONS_MATRICES%NUMBER_OF_ROWS=equations_mapping%NUMBER_OF_ROWS
4401 equations%EQUATIONS_MATRICES%TOTAL_NUMBER_OF_ROWS=equations_mapping%TOTAL_NUMBER_OF_ROWS
4402 equations%EQUATIONS_MATRICES%NUMBER_OF_GLOBAL_ROWS=equations_mapping%NUMBER_OF_GLOBAL_ROWS
4403 NULLIFY(equations%EQUATIONS_MATRICES%DYNAMIC_MATRICES)
4404 NULLIFY(equations%EQUATIONS_MATRICES%LINEAR_MATRICES)
4405 NULLIFY(equations%EQUATIONS_MATRICES%NONLINEAR_MATRICES)
4406 NULLIFY(equations%EQUATIONS_MATRICES%RHS_VECTOR)
4407 NULLIFY(equations%EQUATIONS_MATRICES%SOURCE_VECTOR)
4414 CALL flagerror(
"Equations mapping has not been finished.",err,error,*999)
4417 CALL flagerror(
"Equations equations mapping is not associated.",err,error,*998)
4421 CALL flagerror(
"Equations is not associated.",err,error,*998)
4424 exits(
"EQUATIONS_MATRICES_INITIALISE")
4427 998 errorsexits(
"EQUATIONS_MATRICES_INITIALISE",err,error)
4440 INTEGER(INTG),
INTENT(IN) :: SELECTION_TYPE
4441 REAL(DP),
INTENT(IN) ::
VALUE 4442 INTEGER(INTG),
INTENT(OUT) :: ERR
4445 INTEGER(INTG) :: matrix_idx
4454 enters(
"EQUATIONS_MATRICES_VALUES_INITIALISE",err,error,*999)
4456 IF(
ASSOCIATED(equations_matrices))
THEN 4461 dynamic_matrices=>equations_matrices%DYNAMIC_MATRICES
4462 IF(
ASSOCIATED(dynamic_matrices))
THEN 4463 DO matrix_idx=1,dynamic_matrices%NUMBER_OF_DYNAMIC_MATRICES
4464 equations_matrix=>dynamic_matrices%MATRICES(matrix_idx)%PTR
4465 IF(
ASSOCIATED(equations_matrix))
THEN 4466 IF(equations_matrix%UPDATE_MATRIX)
THEN 4470 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
4479 linear_matrices=>equations_matrices%LINEAR_MATRICES
4480 IF(
ASSOCIATED(linear_matrices))
THEN 4481 DO matrix_idx=1,linear_matrices%NUMBER_OF_LINEAR_MATRICES
4482 equations_matrix=>linear_matrices%MATRICES(matrix_idx)%PTR
4483 IF(
ASSOCIATED(equations_matrix))
THEN 4484 IF(equations_matrix%UPDATE_MATRIX)
THEN 4488 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
4496 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4497 IF(
ASSOCIATED(nonlinear_matrices))
THEN 4498 DO matrix_idx=1,nonlinear_matrices%NUMBER_OF_JACOBIANS
4499 jacobian_matrix=>nonlinear_matrices%JACOBIANS(matrix_idx)%PTR
4500 IF(
ASSOCIATED(jacobian_matrix))
THEN 4501 IF(jacobian_matrix%UPDATE_JACOBIAN)
THEN 4505 CALL flagerror(
"Jacobian matrix is not associated.",err,error,*999)
4516 nonlinear_matrices=>equations_matrices%NONLINEAR_MATRICES
4517 IF(
ASSOCIATED(nonlinear_matrices))
THEN 4518 IF(nonlinear_matrices%UPDATE_RESIDUAL)
THEN 4531 rhs_vector=>equations_matrices%RHS_VECTOR
4532 IF(
ASSOCIATED(rhs_vector))
THEN 4533 IF(rhs_vector%UPDATE_VECTOR)
THEN 4546 source_vector=>equations_matrices%SOURCE_VECTOR
4547 IF(
ASSOCIATED(source_vector))
THEN 4548 IF(source_vector%UPDATE_VECTOR)
THEN 4554 CALL flagerror(
"Equations matrices is not associated.",err,error,*999)
4557 exits(
"EQUATIONS_MATRICES_VALUES_INITIALISE")
4559 999 errorsexits(
"EQUATIONS_MATRICES_VALUES_INITIALISE",err,error)
4572 INTEGER(INTG),
INTENT(OUT) :: numberOfNonZeros
4573 INTEGER(INTG),
POINTER :: rowIndices(:)
4574 INTEGER(INTG),
POINTER :: columnIndices(:)
4576 INTEGER(INTG),
INTENT(OUT) :: err
4579 INTEGER(INTG) :: columnIdx,dummyErr,elementIdx,globalColumn,localColumn,local_ny,matrixNumber,mk,mp,ne,nh,nh2,nn,nnk,np
4580 INTEGER(INTG) :: numberOfColumns,nyy,nyyg,npg,nhg,local_cols,local_dof,mv
4581 INTEGER(INTG) :: dofIdx,nodeIdx,componentIdx,localDofIdx
4582 INTEGER(INTG) :: versionIdx,derivativeIdx,numberOfDerivatives,numberOfVersions
4583 INTEGER(INTG),
ALLOCATABLE :: columns(:)
4584 REAL(DP) :: sparsity
4602 enters(
"EquationsMatrix_StructureCalculate",err,error,*998)
4605 IF(
ASSOCIATED(equationsmatrix))
THEN 4606 IF(.NOT.
ASSOCIATED(rowindices))
THEN 4607 IF(.NOT.
ASSOCIATED(columnindices))
THEN 4608 matrixnumber=equationsmatrix%MATRIX_NUMBER
4609 SELECT CASE(equationsmatrix%STRUCTURE_TYPE)
4611 CALL flagerror(
"There is no structure to calculate for a matrix with no structure.",err,error,*998)
4613 SELECT CASE(equationsmatrix%STORAGE_TYPE)
4615 linearmatrices=>equationsmatrix%LINEAR_MATRICES
4616 dynamicmatrices=>equationsmatrix%DYNAMIC_MATRICES
4617 IF(
ASSOCIATED(dynamicmatrices).OR.
ASSOCIATED(linearmatrices))
THEN 4618 IF(
ASSOCIATED(dynamicmatrices))
THEN 4619 equationsmatrices=>dynamicmatrices%EQUATIONS_MATRICES
4621 equationsmatrices=>linearmatrices%EQUATIONS_MATRICES
4623 IF(
ASSOCIATED(equationsmatrices))
THEN 4624 equations=>equationsmatrices%EQUATIONS
4625 IF(
ASSOCIATED(equations))
THEN 4626 equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
4627 IF(
ASSOCIATED(equationsmapping))
THEN 4628 dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
4629 linearmapping=>equationsmapping%LINEAR_MAPPING
4630 IF(
ASSOCIATED(dynamicmapping).OR.
ASSOCIATED(linearmapping))
THEN 4631 equationsset=>equations%EQUATIONS_SET
4632 IF(
ASSOCIATED(equationsset))
THEN 4633 dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
4634 IF(
ASSOCIATED(dependentfield))
THEN 4635 IF(
ASSOCIATED(dynamicmatrices))
THEN 4636 fieldvariable=>dynamicmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixnumber)%VARIABLE
4638 fieldvariable=>linearmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixnumber)%VARIABLE
4640 IF(
ASSOCIATED(fieldvariable))
THEN 4641 dependentdofsdomainmapping=>fieldvariable%DOMAIN_MAPPING
4642 IF(
ASSOCIATED(dependentdofsdomainmapping))
THEN 4643 dependentdofsparammapping=>fieldvariable%DOF_TO_PARAM_MAP
4644 IF(
ASSOCIATED(dependentdofsparammapping))
THEN 4646 ALLOCATE(columnindiceslists(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL),stat=err)
4647 IF(err/=0)
CALL flagerror(
"Could not allocate column indices lists.",err,error,*999)
4649 ALLOCATE(rowindices(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL+1),stat=err)
4650 IF(err/=0)
CALL flagerror(
"Could not allocate row indices.",err,error,*999)
4655 DO local_ny=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
4656 IF(dependentdofsparammapping%DOF_TYPE(1,local_ny)==field_node_dof_type)
THEN 4657 nyy=dependentdofsparammapping%DOF_TYPE(2,local_ny)
4658 np=dependentdofsparammapping%NODE_DOF2PARAM_MAP(3,nyy)
4659 nh=dependentdofsparammapping%NODE_DOF2PARAM_MAP(4,nyy)
4660 domainnodes=>fieldvariable%COMPONENTS(nh)%DOMAIN%TOPOLOGY%NODES
4663 NULLIFY(columnindiceslists(local_ny)%PTR)
4667 & number_of_surrounding_elements*fieldvariable%COMPONENTS(nh)% &
4668 & maxnumberelementinterpolationparameters,err,error,*999)
4671 DO elementidx=1,domainnodes%NODES(np)%NUMBER_OF_SURROUNDING_ELEMENTS
4672 ne=domainnodes%NODES(np)%SURROUNDING_ELEMENTS(elementidx)
4673 DO nh2=1,fieldvariable%NUMBER_OF_COMPONENTS
4674 domainelements=>fieldvariable%COMPONENTS(nh2)%DOMAIN%TOPOLOGY%ELEMENTS
4675 basis=>domainelements%ELEMENTS(ne)%BASIS
4676 DO nn=1,basis%NUMBER_OF_NODES
4677 mp=domainelements%ELEMENTS(ne)%ELEMENT_NODES(nn)
4678 DO nnk=1,basis%NUMBER_OF_DERIVATIVES(nn)
4679 mk=domainelements%ELEMENTS(ne)%ELEMENT_DERIVATIVES(nnk,nn)
4680 mv=domainelements%ELEMENTS(ne)%elementVersions(nnk,nn)
4682 localcolumn=fieldvariable%COMPONENTS(nh2)%PARAM_TO_DOF_MAP%NODE_PARAM2DOF_MAP% &
4683 & nodes(mp)%DERIVATIVES(mk)%VERSIONS(mv)
4684 globalcolumn=fieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
4686 CALL list_item_add(columnindiceslists(local_ny)%PTR,globalcolumn,err,error,*999)
4695 numberofnonzeros=numberofnonzeros+numberofcolumns
4696 rowindices(local_ny+1)=numberofnonzeros+1
4699 &
" is not a node based dof." 4700 CALL flagerror(localerror,err,error,*999)
4706 ALLOCATE(columnindices(numberofnonzeros),stat=err)
4708 ALLOCATE(list(dependentdofsdomainmapping%NUMBER_OF_GLOBAL))
4710 IF(err/=0)
CALL flagerror(
"Could not allocate column indices.",err,error,*999)
4711 DO local_ny=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
4715 DO columnidx=1,numberofcolumns
4717 columnindices(rowindices(local_ny)+columnidx-1)=columns(columnidx)
4720 IF(
ASSOCIATED(linearmapping).OR.
ASSOCIATED(dynamicmapping))
THEN 4721 IF(
ASSOCIATED(dynamicmatrices))
THEN 4722 local_cols=equationsmatrices%equations_mapping%dynamic_mapping &
4723 & %equations_matrix_to_var_maps(1)%column_dofs_mapping%global_to_local_map &
4724 & (columns(columnidx))%LOCAL_NUMBER(1)
4725 local_dof = local_cols
4730 local_cols=equationsmatrices%equations_mapping%linear_mapping &
4731 & %equations_matrix_to_var_maps(1)%column_dofs_mapping%global_to_local_map &
4732 & (columns(columnidx))%LOCAL_NUMBER(1)
4733 local_dof = local_cols
4736 nyyg=dependentdofsparammapping%DOF_TYPE(2,local_dof)
4737 npg=dependentdofsparammapping%NODE_DOF2PARAM_MAP(3,nyyg)
4738 nhg=dependentdofsparammapping%NODE_DOF2PARAM_MAP(4,nyyg)
4739 domainnodes=>fieldvariable%COMPONENTS(nhg)%DOMAIN%TOPOLOGY%NODES
4742 IF(domainnodes%NODES(npg)%BOUNDARY_NODE)
THEN 4743 CALL linkedlist_add(list(columns(columnidx)),local_ny,err,error,*999)
4756 & dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL,err,error,*999)
4758 & dependentdofsdomainmapping%NUMBER_OF_GLOBAL,err,error,*999)
4760 & numberofnonzeros,err,error,*999)
4761 IF(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL* &
4762 & dependentdofsdomainmapping%NUMBER_OF_GLOBAL/=0)
THEN 4763 sparsity=(1.0_dp-
REAL(numberofnonzeros,
dp)/
REAL(dependentdofsdomainmapping% &
4764 & TOTAL_NUMBER_OF_LOCAL*dependentDofsDomainMapping%NUMBER_OF_GLOBAL,DP))*100.0_DP
4766 & sparsity,
"F6.2",err,error,*999)
4769 & total_number_of_local+1,8,8,rowindices,
'(" Row indices :",8(X,I13))', &
4770 &
'(18X,8(X,I13))',err,error,*999)
4772 &
'(" Column indices :",8(X,I13))',
'(18X,8(X,I13))', err,error,*999)
4775 CALL flagerror(
"Dependent dofs parameter mapping is not associated.",err,error,*999)
4778 CALL flagerror(
"Dependent dofs domain mapping is not associated.",err,error,*999)
4781 CALL flagerror(
"Dependent field variable is not associated.",err,error,*999)
4784 CALL flagerror(
"Equations set dependent field is not associated.",err,error,*999)
4787 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4790 CALL flagerror(
"Either equations mapping dynamic mapping or linear mapping is not associated.", &
4794 CALL flagerror(
"Equations mapping is not associated.",err,error,*999)
4797 CALL flagerror(
"Equations is not associated.",err,error,*999)
4800 CALL flagerror(
"Dynamic or linear matrices equations matrices is not associated.",err,error,*999)
4803 CALL flagerror(
"Either equations matrix dynamic or linear matrices is not associated.",err,error,*999)
4806 localerror=
"The matrix storage type of "// &
4808 CALL flagerror(localerror,err,error,*999)
4812 SELECT CASE(equationsmatrix%STORAGE_TYPE)
4814 linearmatrices=>equationsmatrix%LINEAR_MATRICES
4815 dynamicmatrices=>equationsmatrix%DYNAMIC_MATRICES
4816 IF(
ASSOCIATED(dynamicmatrices).OR.
ASSOCIATED(linearmatrices))
THEN 4817 IF(
ASSOCIATED(dynamicmatrices))
THEN 4818 equationsmatrices=>dynamicmatrices%EQUATIONS_MATRICES
4820 equationsmatrices=>linearmatrices%EQUATIONS_MATRICES
4822 IF(
ASSOCIATED(equationsmatrices))
THEN 4823 equations=>equationsmatrices%EQUATIONS
4824 IF(
ASSOCIATED(equations))
THEN 4825 equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
4826 IF(
ASSOCIATED(equationsmapping))
THEN 4827 dynamicmapping=>equationsmapping%DYNAMIC_MAPPING
4828 linearmapping=>equationsmapping%LINEAR_MAPPING
4829 IF(
ASSOCIATED(dynamicmapping).OR.
ASSOCIATED(linearmapping))
THEN 4830 equationsset=>equations%EQUATIONS_SET
4831 IF(
ASSOCIATED(equationsset))
THEN 4832 dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
4833 IF(
ASSOCIATED(dependentfield))
THEN 4834 IF(
ASSOCIATED(dynamicmatrices))
THEN 4835 fieldvariable=>dynamicmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixnumber)%VARIABLE
4837 fieldvariable=>linearmapping%EQUATIONS_MATRIX_TO_VAR_MAPS(matrixnumber)%VARIABLE
4839 IF(
ASSOCIATED(fieldvariable))
THEN 4840 dependentdofsdomainmapping=>fieldvariable%DOMAIN_MAPPING
4841 IF(
ASSOCIATED(dependentdofsdomainmapping))
THEN 4842 dependentdofsparammapping=>fieldvariable%DOF_TO_PARAM_MAP
4843 IF(
ASSOCIATED(dependentdofsparammapping))
THEN 4845 ALLOCATE(columnindiceslists(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL),stat=err)
4846 IF(err/=0)
CALL flagerror(
"Could not allocate column indices lists.",err,error,*999)
4848 ALLOCATE(rowindices(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL+1),stat=err)
4849 IF(err/=0)
CALL flagerror(
"Could not allocate row indices.",err,error,*999)
4854 DO localdofidx=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
4855 IF(dependentdofsparammapping%DOF_TYPE(1,localdofidx)==field_node_dof_type)
THEN 4856 dofidx=dependentdofsparammapping%DOF_TYPE(2,localdofidx)
4857 nodeidx=dependentdofsparammapping%NODE_DOF2PARAM_MAP(3,dofidx)
4858 componentidx=dependentdofsparammapping%NODE_DOF2PARAM_MAP(4,dofidx)
4859 domainnodes=>fieldvariable%COMPONENTS(componentidx)%DOMAIN%TOPOLOGY%NODES
4862 NULLIFY(columnindiceslists(localdofidx)%PTR)
4867 & fieldvariable%NUMBER_OF_COMPONENTS* &
4868 & fieldvariable%maxNumberElementInterpolationParameters,err,error,*999)
4872 DO componentidx=1,fieldvariable%NUMBER_OF_COMPONENTS
4873 numberofderivatives=fieldvariable%components(componentidx)%domain%topology% &
4874 & nodes%nodes(nodeidx)%NUMBER_OF_DERIVATIVES
4875 DO derivativeidx=1,numberofderivatives
4876 numberofversions=fieldvariable%components(componentidx)%domain%topology% &
4877 & nodes%nodes(nodeidx)%derivatives(derivativeidx)%numberOfVersions
4878 DO versionidx=1,numberofversions
4879 localcolumn=fieldvariable%COMPONENTS(componentidx)%PARAM_TO_DOF_MAP% &
4880 & node_param2dof_map%NODES(nodeidx)%DERIVATIVES(derivativeidx)%VERSIONS(versionidx)
4881 globalcolumn=fieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
4883 CALL list_item_add(columnindiceslists(localdofidx)%PTR,globalcolumn,err,error,*999)
4892 numberofnonzeros=numberofnonzeros+numberofcolumns
4893 rowindices(localdofidx+1)=numberofnonzeros+1
4896 &
" is not a node based dof." 4897 CALL flagerror(localerror,err,error,*999)
4902 ALLOCATE(columnindices(numberofnonzeros),stat=err)
4903 ALLOCATE(list(dependentdofsdomainmapping%NUMBER_OF_GLOBAL))
4905 IF(err/=0)
CALL flagerror(
"Could not allocate column indices.",err,error,*999)
4906 DO localdofidx=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
4910 DO columnidx=1,numberofcolumns
4912 columnindices(rowindices(localdofidx)+columnidx-1)=columns(columnidx)
4915 IF(
ASSOCIATED(linearmapping).OR.
ASSOCIATED(dynamicmapping))
THEN 4916 IF(
ASSOCIATED(dynamicmatrices))
THEN 4917 local_cols=equationsmatrices%equations_mapping%dynamic_mapping &
4918 & %equations_matrix_to_var_maps(1)%column_dofs_mapping%global_to_local_map &
4919 & (columns(columnidx))%LOCAL_NUMBER(1)
4920 local_dof = local_cols
4925 local_cols=equationsmatrices%equations_mapping%linear_mapping &
4926 & %equations_matrix_to_var_maps(1)%column_dofs_mapping%global_to_local_map &
4927 & (columns(columnidx))%LOCAL_NUMBER(1)
4928 local_dof = local_cols
4931 nyyg=dependentdofsparammapping%DOF_TYPE(2,local_dof)
4932 npg=dependentdofsparammapping%NODE_DOF2PARAM_MAP(3,nyyg)
4933 nhg=dependentdofsparammapping%NODE_DOF2PARAM_MAP(4,nyyg)
4934 domainnodes=>fieldvariable%COMPONENTS(nhg)%DOMAIN%TOPOLOGY%NODES
4937 IF(domainnodes%NODES(npg)%BOUNDARY_NODE)
THEN 4938 CALL linkedlist_add(list(columns(columnidx)),localdofidx,err,error,*999)
4950 & dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL,err,error,*999)
4952 & dependentdofsdomainmapping%NUMBER_OF_GLOBAL,err,error,*999)
4954 & numberofnonzeros,err,error,*999)
4955 IF(dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL* &
4956 & dependentdofsdomainmapping%NUMBER_OF_GLOBAL/=0)
THEN 4957 sparsity=(1.0_dp-
REAL(numberofnonzeros,
dp)/
REAL(dependentdofsdomainmapping% &
4958 & TOTAL_NUMBER_OF_LOCAL*dependentDofsDomainMapping%NUMBER_OF_GLOBAL,DP))*100.0_DP
4960 & sparsity,
"F6.2",err,error,*999)
4963 & total_number_of_local+1,8,8,rowindices,
'(" Row indices :",8(X,I13))', &
4964 &
'(18X,8(X,I13))',err,error,*999)
4966 &
'(" Column indices :",8(X,I13))',
'(18X,8(X,I13))', err,error,*999)
4969 CALL flagerror(
"Dependent dofs parameter mapping is not associated.",err,error,*999)
4972 CALL flagerror(
"Dependent dofs domain mapping is not associated.",err,error,*999)
4975 CALL flagerror(
"Dependent field variable is not associated.",err,error,*999)
4978 CALL flagerror(
"Equations set dependent field is not associated.",err,error,*999)
4981 CALL flagerror(
"Equations set is not associated.",err,error,*999)
4984 CALL flagerror(
"Either equations mapping dynamic mapping or linear mapping is not associated.", &
4988 CALL flagerror(
"Equations mapping is not associated.",err,error,*999)
4991 CALL flagerror(
"Equations is not associated.",err,error,*999)
4994 CALL flagerror(
"Dynamic or linear matrices equations matrices is not associated.",err,error,*999)
4997 CALL flagerror(
"Either equations matrix dynamic or linear matrices is not associated.",err,error,*999)
5001 localerror=
"The matrix storage type of "// &
5003 CALL flagerror(localerror,err,error,*999)
5007 CALL flagerror(
"There is not structure to calculate for a diagonal matrix.",err,error,*998)
5009 localerror=
"The matrix structure type of "// &
5011 CALL flagerror(localerror,err,error,*998)
5014 CALL flagerror(
"Column indices is already associated.",err,error,*998)
5017 CALL flagerror(
"Row indieces is already associated.",err,error,*998)
5020 CALL flagerror(
"Equations matrix is not associated.",err,error,*999)
5023 exits(
"EquationsMatrix_StructureCalculate")
5025 999
IF(
ASSOCIATED(rowindices))
DEALLOCATE(rowindices)
5026 IF(
ASSOCIATED(columnindices))
DEALLOCATE(columnindices)
5027 IF(
ALLOCATED(columns))
DEALLOCATE(columns)
5028 IF(
ALLOCATED(columnindiceslists))
THEN 5029 DO localdofidx=1,dependentdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
5030 IF(
ASSOCIATED(columnindiceslists(localdofidx)%PTR)) &
5031 &
CALL list_destroy(columnindiceslists(localdofidx)%PTR,dummyerr,dummyerror,*998)
5033 DEALLOCATE(columnindiceslists)
5035 998 errorsexits(
"EquationsMatrix_StructureCalculate",err,error)
5048 INTEGER(INTG),
INTENT(OUT) :: numberOfNonZeros
5049 INTEGER(INTG),
POINTER :: rowIndices(:)
5050 INTEGER(INTG),
POINTER :: columnIndices(:)
5051 INTEGER(INTG),
INTENT(OUT) :: err
5054 INTEGER(INTG) :: columnIdx,dummyErr,elementIdx,globalColumn,localColumn,local_ny,mk,mp,ne,nh,nh2,nn,nnk,np,mv, &
5055 & numberOfColumns,nyy,matrixNumber
5056 INTEGER(INTG) :: dofIdx,nodeIdx,componentIdx,versionIdx,derivativeIdx,numberOfVersions,numberOfDerivatives
5057 INTEGER(INTG) :: localDofIdx
5058 INTEGER(INTG),
ALLOCATABLE :: columns(:)
5059 REAL(DP) :: sparsity
5076 enters(
"JacobianMatrix_StructureCalculate",err,error,*998)
5079 IF(
ASSOCIATED(jacobianmatrix))
THEN 5080 matrixnumber=jacobianmatrix%JACOBIAN_NUMBER
5081 IF(.NOT.
ASSOCIATED(rowindices))
THEN 5082 IF(.NOT.
ASSOCIATED(columnindices))
THEN 5083 SELECT CASE(jacobianmatrix%STRUCTURE_TYPE)
5085 CALL flagerror(
"Not implemented.",err,error,*998)
5087 SELECT CASE(jacobianmatrix%STORAGE_TYPE)
5089 nonlinearmatrices=>jacobianmatrix%NONLINEAR_MATRICES
5090 IF(
ASSOCIATED(nonlinearmatrices))
THEN 5091 equationsmatrices=>nonlinearmatrices%EQUATIONS_MATRICES
5092 IF(
ASSOCIATED(equationsmatrices))
THEN 5093 equations=>equationsmatrices%EQUATIONS
5094 IF(
ASSOCIATED(equations))
THEN 5095 equationsmapping=>equationsmatrices%EQUATIONS_MAPPING
5096 IF(
ASSOCIATED(equationsmapping))
THEN 5097 nonlinearmapping=>equationsmapping%NONLINEAR_MAPPING
5098 IF(
ASSOCIATED(nonlinearmapping))
THEN 5099 equationsset=>equations%EQUATIONS_SET
5100 IF(
ASSOCIATED(equationsset))
THEN 5101 dependentfield=>equationsset%DEPENDENT%DEPENDENT_FIELD
5102 IF(
ASSOCIATED(dependentfield))
THEN 5103 fieldvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(matrixnumber)%VARIABLE
5104 IF(
ASSOCIATED(fieldvariable))
THEN 5105 dependentdofsdomainmapping=>fieldvariable%DOMAIN_MAPPING
5106 IF(
ASSOCIATED(dependentdofsdomainmapping))
THEN 5107 dependentdofsparammapping=>fieldvariable%DOF_TO_PARAM_MAP
5108 IF(
ASSOCIATED(dependentdofsparammapping))
THEN 5110 IF(
ASSOCIATED(equationsmapping%RHS_MAPPING))
THEN 5111 rowvariable=>equationsmapping%RHS_MAPPING%RHS_VARIABLE
5113 rowvariable=>nonlinearmapping%JACOBIAN_TO_VAR_MAP(1)%VARIABLE
5115 IF(
ASSOCIATED(rowvariable))
THEN 5116 rowdofsdomainmapping=>rowvariable%DOMAIN_MAPPING
5117 rowdofsparammapping=>rowvariable%DOF_TO_PARAM_MAP
5119 CALL flagerror(
"RHS or first nonlinear variable is not associated",err,error,*999)
5121 IF(
ASSOCIATED(rowdofsdomainmapping))
THEN 5122 IF(
ASSOCIATED(rowdofsparammapping))
THEN 5124 ALLOCATE(columnindiceslists(rowdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL),stat=err)
5125 IF(err/=0)
CALL flagerror(
"Could not allocate column indices lists.",err,error,*999)
5127 ALLOCATE(rowindices(rowdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL+1),stat=err)
5128 IF(err/=0)
CALL flagerror(
"Could not allocate row indices.",err,error,*999)
5132 DO local_ny=1,rowdofsdomainmapping%TOTAL_NUMBER_OF_LOCAL
5133 SELECT CASE(rowdofsparammapping%DOF_TYPE(1,local_ny))
5134 CASE(field_constant_interpolation)
5135 CALL flagerror(
"Constant interpolation is not implemented yet.",err,error,*999)
5136 CASE(field_node_dof_type)
5137 nyy=rowdofsparammapping%DOF_TYPE(2,local_ny)
5138 np=rowdofsparammapping%NODE_DOF2PARAM_MAP(3,nyy)
5139 nh=rowdofsparammapping%NODE_DOF2PARAM_MAP(4,nyy)
5140 domainnodes=>rowvariable%COMPONENTS(nh)%DOMAIN%TOPOLOGY%NODES
5142 NULLIFY(columnindiceslists(local_ny)%PTR)
5146 & number_of_surrounding_elements*rowvariable%COMPONENTS(nh)% &
5147 & maxnumberelementinterpolationparameters,err,error,*999)
5150 DO elementidx=1,domainnodes%NODES(np)%NUMBER_OF_SURROUNDING_ELEMENTS
5151 ne=domainnodes%NODES(np)%SURROUNDING_ELEMENTS(elementidx)
5152 DO nh2=1,fieldvariable%NUMBER_OF_COMPONENTS
5153 SELECT CASE(fieldvariable%COMPONENTS(nh2)%INTERPOLATION_TYPE)
5154 CASE(field_constant_interpolation)
5156 CASE(field_element_based_interpolation)
5157 localcolumn=fieldvariable%COMPONENTS(nh2)%PARAM_TO_DOF_MAP% &
5158 & element_param2dof_map%ELEMENTS(ne)
5159 globalcolumn=fieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
5160 CALL list_item_add(columnindiceslists(local_ny)%PTR,globalcolumn,err,error,*999)
5161 CASE(field_node_based_interpolation)
5162 domainelements=>fieldvariable%COMPONENTS(nh2)%DOMAIN%TOPOLOGY%ELEMENTS
5163 basis=>domainelements%ELEMENTS(ne)%BASIS
5164 DO nn=1,basis%NUMBER_OF_NODES
5165 mp=domainelements%ELEMENTS(ne)%ELEMENT_NODES(nn)
5166 DO nnk=1,basis%NUMBER_OF_DERIVATIVES(nn)
5167 mk=domainelements%ELEMENTS(ne)%ELEMENT_DERIVATIVES(nnk,nn)
5168 mv=domainelements%ELEMENTS(ne)%elementVersions(nnk,nn)
5170 localcolumn=fieldvariable%COMPONENTS(nh2)%PARAM_TO_DOF_MAP% &
5171 & node_param2dof_map%NODES(mp)%DERIVATIVES(mk)%VERSIONS(mv)
5172 globalcolumn=fieldvariable%DOMAIN_MAPPING%LOCAL_TO_GLOBAL_MAP(localcolumn)
5173 CALL list_item_add(columnindiceslists(local_ny)%PTR,globalcolumn, &
5177 CASE(field_grid_point_based_interpolation)
5178 CALL flagerror(
"Grid point based interpolation is not implemented yet.",&
5180 CASE(field_gauss_point_based_interpolation)
5181 CALL flagerror(
"Gauss point based interpolation is not implemented yet.",&
5185 &
" has invalid interpolation type." 5186 CALL flagerror(localerror,err,error,*999)
5193 numberofnonzeros=numberofnonzeros+numberofcolumns
5194 rowindices(local_ny+1)=numberofnonzeros+1
5195 CASE(field_element_dof_type)
5197 nyy=rowdofsparammapping%DOF_TYPE(2,local_ny)
5198 ne=rowdofsparammapping%ELEMENT_DOF2PARAM_MAP(1,nyy)
5199 nh=rowdofsparammapping%ELEMENT_DOF2PARAM_MAP(2,nyy)
5200 domainelements=>rowvariable%COMPONENTS(nh)%DOMAIN%TOPOLOGY%ELEMENTS
5201 basis=>domainelements%ELEMENTS(ne)%BASIS