1: SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
2: *
3: * -- LAPACK routine (version 3.2) --
4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6: * November 2006
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
CVSweb interface <joel.bertrand@systella.fr>