Solve linear system of dimension dims and multiple RHS
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=wp), | intent(in) | :: | A(:,:) |
matrix |
||
| real(kind=wp), | intent(in) | :: | RHS(:) |
RHS, sorting: (dimA,nRHS), two dimensions can be used in input |
FUNCTION SOLVE(A,RHS) RESULT(X) ! MODULES IMPLICIT NONE !----------------------------------------------------------------------------------------------------------------------------------- ! INPUT VARIABLES REAL(wp),INTENT(IN) :: A(:,:) !! matrix REAL(wp),INTENT(IN) :: RHS(:) !! RHS, sorting: (dimA,nRHS), two dimensions can be used in input !----------------------------------------------------------------------------------------------------------------------------------- ! OUTPUT VARIABLES REAL(wp) :: X(SIZE(RHS,1)) !! result: solution of A X=RHS !----------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES ! External procedures defined in LAPACK EXTERNAL DGETRF EXTERNAL DGETRS ! LOCAL VARIABLES REAL(wp) :: Atmp(SIZE(A,1), SIZE(A,1)) INTEGER :: ipiv(SIZE(A,1)) ! pivot indices INTEGER :: nRHS,n,info !=================================================================================================================================== Atmp=A X = RHS n = SIZE(A,1) nRHS=SIZE(RHS,1)/SIZE(A,1) CALL DGETRF(n, n, Atmp, n, ipiv, info) IF(info.NE.0)THEN CALL abort(__STAMP__,& 'Matrix is numerically singular!') END IF CALL DGETRS('N',n, nRHS,Atmp, n, ipiv,X,n, info) IF(info.NE.0)THEN CALL abort(__STAMP__,& 'Matrix solve does not work!') END IF END FUNCTION SOLVE