1: SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, 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 DIAG, TRANS, UPLO
10: INTEGER INFO, LDB, N, NRHS
11: * ..
12: * .. Array Arguments ..
13: DOUBLE PRECISION AP( * ), B( LDB, * )
14: * ..
15: *
16: * Purpose
17: * =======
18: *
19: * DTPTRS solves a triangular system of the form
20: *
21: * A * X = B or A**T * X = B,
22: *
23: * where A is a triangular matrix of order N stored in packed format,
24: * and B is an N-by-NRHS matrix. A check is made to verify that A is
25: * 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: * AP (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
52: * The upper or lower triangular matrix A, packed columnwise in
53: * a linear array. The j-th column of A is stored in the array
54: * AP as follows:
55: * if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
56: * if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
57: *
58: * B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
59: * On entry, the right hand side matrix B.
60: * On exit, if INFO = 0, the solution matrix X.
61: *
62: * LDB (input) INTEGER
63: * The leading dimension of the array B. LDB >= max(1,N).
64: *
65: * INFO (output) INTEGER
66: * = 0: successful exit
67: * < 0: if INFO = -i, the i-th argument had an illegal value
68: * > 0: if INFO = i, the i-th diagonal element of A is zero,
69: * indicating that the matrix is singular and the
70: * solutions X have not been computed.
71: *
72: * =====================================================================
73: *
74: * .. Parameters ..
75: DOUBLE PRECISION ZERO
76: PARAMETER ( ZERO = 0.0D+0 )
77: * ..
78: * .. Local Scalars ..
79: LOGICAL NOUNIT, UPPER
80: INTEGER J, JC
81: * ..
82: * .. External Functions ..
83: LOGICAL LSAME
84: EXTERNAL LSAME
85: * ..
86: * .. External Subroutines ..
87: EXTERNAL DTPSV, XERBLA
88: * ..
89: * .. Intrinsic Functions ..
90: INTRINSIC MAX
91: * ..
92: * .. Executable Statements ..
93: *
94: * Test the input parameters.
95: *
96: INFO = 0
97: UPPER = LSAME( UPLO, 'U' )
98: NOUNIT = LSAME( DIAG, 'N' )
99: IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
100: INFO = -1
101: ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
102: $ LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
103: INFO = -2
104: ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
105: INFO = -3
106: ELSE IF( N.LT.0 ) THEN
107: INFO = -4
108: ELSE IF( NRHS.LT.0 ) THEN
109: INFO = -5
110: ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
111: INFO = -8
112: END IF
113: IF( INFO.NE.0 ) THEN
114: CALL XERBLA( 'DTPTRS', -INFO )
115: RETURN
116: END IF
117: *
118: * Quick return if possible
119: *
120: IF( N.EQ.0 )
121: $ RETURN
122: *
123: * Check for singularity.
124: *
125: IF( NOUNIT ) THEN
126: IF( UPPER ) THEN
127: JC = 1
128: DO 10 INFO = 1, N
129: IF( AP( JC+INFO-1 ).EQ.ZERO )
130: $ RETURN
131: JC = JC + INFO
132: 10 CONTINUE
133: ELSE
134: JC = 1
135: DO 20 INFO = 1, N
136: IF( AP( JC ).EQ.ZERO )
137: $ RETURN
138: JC = JC + N - INFO + 1
139: 20 CONTINUE
140: END IF
141: END IF
142: INFO = 0
143: *
144: * Solve A * x = b or A' * x = b.
145: *
146: DO 30 J = 1, NRHS
147: CALL DTPSV( UPLO, TRANS, DIAG, N, AP, B( 1, J ), 1 )
148: 30 CONTINUE
149: *
150: RETURN
151: *
152: * End of DTPTRS
153: *
154: END
CVSweb interface <joel.bertrand@systella.fr>