001:       SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
005: *     November 2006
006: *
007: *     .. Scalar Arguments ..
008:       CHARACTER          TRANS
009:       INTEGER            INFO, LDA, LDB, N, NRHS
010: *     ..
011: *     .. Array Arguments ..
012:       INTEGER            IPIV( * )
013:       DOUBLE PRECISION   A( LDA, * ), B( LDB, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DGETRS solves a system of linear equations
020: *     A * X = B  or  A' * X = B
021: *  with a general N-by-N matrix A using the LU factorization computed
022: *  by DGETRF.
023: *
024: *  Arguments
025: *  =========
026: *
027: *  TRANS   (input) CHARACTER*1
028: *          Specifies the form of the system of equations:
029: *          = 'N':  A * X = B  (No transpose)
030: *          = 'T':  A'* X = B  (Transpose)
031: *          = 'C':  A'* X = B  (Conjugate transpose = Transpose)
032: *
033: *  N       (input) INTEGER
034: *          The order of the matrix A.  N >= 0.
035: *
036: *  NRHS    (input) INTEGER
037: *          The number of right hand sides, i.e., the number of columns
038: *          of the matrix B.  NRHS >= 0.
039: *
040: *  A       (input) DOUBLE PRECISION array, dimension (LDA,N)
041: *          The factors L and U from the factorization A = P*L*U
042: *          as computed by DGETRF.
043: *
044: *  LDA     (input) INTEGER
045: *          The leading dimension of the array A.  LDA >= max(1,N).
046: *
047: *  IPIV    (input) INTEGER array, dimension (N)
048: *          The pivot indices from DGETRF; for 1<=i<=N, row i of the
049: *          matrix was interchanged with row IPIV(i).
050: *
051: *  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
052: *          On entry, the right hand side matrix B.
053: *          On exit, the solution matrix X.
054: *
055: *  LDB     (input) INTEGER
056: *          The leading dimension of the array B.  LDB >= max(1,N).
057: *
058: *  INFO    (output) INTEGER
059: *          = 0:  successful exit
060: *          < 0:  if INFO = -i, the i-th argument had an illegal value
061: *
062: *  =====================================================================
063: *
064: *     .. Parameters ..
065:       DOUBLE PRECISION   ONE
066:       PARAMETER          ( ONE = 1.0D+0 )
067: *     ..
068: *     .. Local Scalars ..
069:       LOGICAL            NOTRAN
070: *     ..
071: *     .. External Functions ..
072:       LOGICAL            LSAME
073:       EXTERNAL           LSAME
074: *     ..
075: *     .. External Subroutines ..
076:       EXTERNAL           DLASWP, DTRSM, XERBLA
077: *     ..
078: *     .. Intrinsic Functions ..
079:       INTRINSIC          MAX
080: *     ..
081: *     .. Executable Statements ..
082: *
083: *     Test the input parameters.
084: *
085:       INFO = 0
086:       NOTRAN = LSAME( TRANS, 'N' )
087:       IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
088:      $    LSAME( TRANS, 'C' ) ) THEN
089:          INFO = -1
090:       ELSE IF( N.LT.0 ) THEN
091:          INFO = -2
092:       ELSE IF( NRHS.LT.0 ) THEN
093:          INFO = -3
094:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
095:          INFO = -5
096:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
097:          INFO = -8
098:       END IF
099:       IF( INFO.NE.0 ) THEN
100:          CALL XERBLA( 'DGETRS', -INFO )
101:          RETURN
102:       END IF
103: *
104: *     Quick return if possible
105: *
106:       IF( N.EQ.0 .OR. NRHS.EQ.0 )
107:      $   RETURN
108: *
109:       IF( NOTRAN ) THEN
110: *
111: *        Solve A * X = B.
112: *
113: *        Apply row interchanges to the right hand sides.
114: *
115:          CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
116: *
117: *        Solve L*X = B, overwriting B with X.
118: *
119:          CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
120:      $               ONE, A, LDA, B, LDB )
121: *
122: *        Solve U*X = B, overwriting B with X.
123: *
124:          CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
125:      $               NRHS, ONE, A, LDA, B, LDB )
126:       ELSE
127: *
128: *        Solve A' * X = B.
129: *
130: *        Solve U'*X = B, overwriting B with X.
131: *
132:          CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
133:      $               ONE, A, LDA, B, LDB )
134: *
135: *        Solve L'*X = B, overwriting B with X.
136: *
137:          CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
138:      $               A, LDA, B, LDB )
139: *
140: *        Apply row interchanges to the solution vectors.
141: *
142:          CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
143:       END IF
144: *
145:       RETURN
146: *
147: *     End of DGETRS
148: *
149:       END
150: