1: SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
2: $ INFO )
3: *
4: * -- LAPACK routine (version 3.2) --
5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7: * November 2006
8: *
9: * .. Scalar Arguments ..
10: CHARACTER DIAG, TRANS, UPLO
11: INTEGER INFO, LDA, LDB, N, NRHS
12: * ..
13: * .. Array Arguments ..
14: DOUBLE PRECISION A( LDA, * ), B( LDB, * )
15: * ..
16: *
17: * Purpose
18: * =======
19: *
20: * DTRTRS solves a triangular system of the form
21: *
22: * A * X = B or A**T * X = B,
23: *
24: * where A is a triangular matrix of order N, and B is an N-by-NRHS
25: * matrix. A check is made to verify that A is nonsingular.
26: *
27: * Arguments
28: * =========
29: *
30: * UPLO (input) CHARACTER*1
31: * = 'U': A is upper triangular;
32: * = 'L': A is lower triangular.
33: *
34: * TRANS (input) CHARACTER*1
35: * Specifies the form of the system of equations:
36: * = 'N': A * X = B (No transpose)
37: * = 'T': A**T * X = B (Transpose)
38: * = 'C': A**H * X = B (Conjugate transpose = Transpose)
39: *
40: * DIAG (input) CHARACTER*1
41: * = 'N': A is non-unit triangular;
42: * = 'U': A is unit triangular.
43: *
44: * N (input) INTEGER
45: * The order of the matrix A. N >= 0.
46: *
47: * NRHS (input) INTEGER
48: * The number of right hand sides, i.e., the number of columns
49: * of the matrix B. NRHS >= 0.
50: *
51: * A (input) DOUBLE PRECISION array, dimension (LDA,N)
52: * The triangular matrix A. If UPLO = 'U', the leading N-by-N
53: * upper triangular part of the array A contains the upper
54: * triangular matrix, and the strictly lower triangular part of
55: * A is not referenced. If UPLO = 'L', the leading N-by-N lower
56: * triangular part of the array A contains the lower triangular
57: * matrix, and the strictly upper triangular part of A is not
58: * referenced. If DIAG = 'U', the diagonal elements of A are
59: * also not referenced and are assumed to be 1.
60: *
61: * LDA (input) INTEGER
62: * The leading dimension of the array A. LDA >= max(1,N).
63: *
64: * B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
65: * On entry, the right hand side matrix B.
66: * On exit, if INFO = 0, the solution matrix X.
67: *
68: * LDB (input) INTEGER
69: * The leading dimension of the array B. LDB >= max(1,N).
70: *
71: * INFO (output) INTEGER
72: * = 0: successful exit
73: * < 0: if INFO = -i, the i-th argument had an illegal value
74: * > 0: if INFO = i, the i-th diagonal element of A is zero,
75: * indicating that the matrix is singular and the solutions
76: * X have not been computed.
77: *
78: * =====================================================================
79: *
80: * .. Parameters ..
81: DOUBLE PRECISION ZERO, ONE
82: PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
83: * ..
84: * .. Local Scalars ..
85: LOGICAL NOUNIT
86: * ..
87: * .. External Functions ..
88: LOGICAL LSAME
89: EXTERNAL LSAME
90: * ..
91: * .. External Subroutines ..
92: EXTERNAL DTRSM, XERBLA
93: * ..
94: * .. Intrinsic Functions ..
95: INTRINSIC MAX
96: * ..
97: * .. Executable Statements ..
98: *
99: * Test the input parameters.
100: *
101: INFO = 0
102: NOUNIT = LSAME( DIAG, 'N' )
103: IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
104: INFO = -1
105: ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
106: $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
107: INFO = -2
108: ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
109: INFO = -3
110: ELSE IF( N.LT.0 ) THEN
111: INFO = -4
112: ELSE IF( NRHS.LT.0 ) THEN
113: INFO = -5
114: ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
115: INFO = -7
116: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
117: INFO = -9
118: END IF
119: IF( INFO.NE.0 ) THEN
120: CALL XERBLA( 'DTRTRS', -INFO )
121: RETURN
122: END IF
123: *
124: * Quick return if possible
125: *
126: IF( N.EQ.0 )
127: $ RETURN
128: *
129: * Check for singularity.
130: *
131: IF( NOUNIT ) THEN
132: DO 10 INFO = 1, N
133: IF( A( INFO, INFO ).EQ.ZERO )
134: $ RETURN
135: 10 CONTINUE
136: END IF
137: INFO = 0
138: *
139: * Solve A * x = b or A' * x = b.
140: *
141: CALL DTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
142: $ LDB )
143: *
144: RETURN
145: *
146: * End of DTRTRS
147: *
148: END
CVSweb interface <joel.bertrand@systella.fr>