1 SUBROUTINE DGETRSF( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) 2* 3* -- LAPACK routine (version 3.0) -- 4* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 5* Courant Institute, Argonne National Lab, and Rice University 6* March 31, 1993 7* 8* .. Scalar Arguments .. 9 CHARACTER TRANS 10 INTEGER INFO, LDA, LDB, N, NRHS 11* .. 12* .. Array Arguments .. 13 INTEGER IPIV( * ) 14 DOUBLE PRECISION A( LDA, * ), B( LDB, * ) 15* .. 16* 17* Purpose 18* ======= 19* 20* DGETRS solves a system of linear equations 21* A * X = B or A' * X = B 22* with a general N-by-N matrix A using the LU factorization computed 23* by DGETRF. 24* 25* Arguments 26* ========= 27* 28* TRANS (input) CHARACTER*1 29* Specifies the form of the system of equations: 30* = 'N': A * X = B (No transpose) 31* = 'T': A'* X = B (Transpose) 32* = 'C': A'* X = B (Conjugate transpose = Transpose) 33* 34* N (input) INTEGER 35* The order of the matrix A. N >= 0. 36* 37* NRHS (input) INTEGER 38* The number of right hand sides, i.e., the number of columns 39* of the matrix B. NRHS >= 0. 40* 41* A (input) DOUBLE PRECISION array, dimension (LDA,N) 42* The factors L and U from the factorization A = P*L*U 43* as computed by DGETRF. 44* 45* LDA (input) INTEGER 46* The leading dimension of the array A. LDA >= max(1,N). 47* 48* IPIV (input) INTEGER array, dimension (N) 49* The pivot indices from DGETRF; for 1<=i<=N, row i of the 50* matrix was interchanged with row IPIV(i). 51* 52* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) 53* On entry, the right hand side matrix B. 54* On exit, the solution matrix X. 55* 56* LDB (input) INTEGER 57* The leading dimension of the array B. LDB >= max(1,N). 58* 59* INFO (output) INTEGER 60* = 0: successful exit 61* < 0: if INFO = -i, the i-th argument had an illegal value 62* 63* ===================================================================== 64* 65* .. Parameters .. 66 DOUBLE PRECISION ONE 67 PARAMETER ( ONE = 1.0D+0 ) 68* .. 69* .. Local Scalars .. 70 LOGICAL NOTRAN 71* .. 72* .. External Functions .. 73 LOGICAL LSAME 74 EXTERNAL LSAME 75* .. 76* .. External Subroutines .. 77 EXTERNAL DLASWP, DTRSM, XERBLA 78* .. 79* .. Intrinsic Functions .. 80 INTRINSIC MAX 81* .. 82* .. Executable Statements .. 83* 84* Test the input parameters. 85* 86 INFO = 0 87 NOTRAN = LSAME( TRANS, 'N' ) 88 IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. 89 $ LSAME( TRANS, 'C' ) ) THEN 90 INFO = -1 91 ELSE IF( N.LT.0 ) THEN 92 INFO = -2 93 ELSE IF( NRHS.LT.0 ) THEN 94 INFO = -3 95 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 96 INFO = -5 97 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 98 INFO = -8 99 END IF 100 IF( INFO.NE.0 ) THEN 101 CALL XERBLA( 'DGETRS', -INFO ) 102 RETURN 103 END IF 104* 105* Quick return if possible 106* 107 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 108 $ RETURN 109* 110 IF( NOTRAN ) THEN 111* 112* Solve A * X = B. 113* 114* Apply row interchanges to the right hand sides. 115* 116 CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 ) 117* 118* Solve L*X = B, overwriting B with X. 119* 120 CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS, 121 $ ONE, A, LDA, B, LDB ) 122* 123* Solve U*X = B, overwriting B with X. 124* 125 CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, 126 $ NRHS, ONE, A, LDA, B, LDB ) 127 ELSE 128* 129* Solve A' * X = B. 130* 131* Solve U'*X = B, overwriting B with X. 132* 133 CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, 134 $ ONE, A, LDA, B, LDB ) 135* 136* Solve L'*X = B, overwriting B with X. 137* 138 CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE, 139 $ A, LDA, B, LDB ) 140* 141* Apply row interchanges to the solution vectors. 142* 143 CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 ) 144 END IF 145* 146 RETURN 147* 148* End of DGETRS 149* 150 END 151