1 SUBROUTINE ZTPTRS( 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 COMPLEX*16 AP( * ), B( LDB, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * ZTPTRS solves a triangular system of the form
20 *
21 * A * X = B, A**T * X = B, or A**H * 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)
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) COMPLEX*16 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) COMPLEX*16 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 COMPLEX*16 ZERO
76 PARAMETER ( ZERO = ( 0.0D+0, 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 XERBLA, ZTPSV
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( 'ZTPTRS', -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, A**T * x = b, or A**H * x = b.
145 *
146 DO 30 J = 1, NRHS
147 CALL ZTPSV( UPLO, TRANS, DIAG, N, AP, B( 1, J ), 1 )
148 30 CONTINUE
149 *
150 RETURN
151 *
152 * End of ZTPTRS
153 *
154 END
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 COMPLEX*16 AP( * ), B( LDB, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * ZTPTRS solves a triangular system of the form
20 *
21 * A * X = B, A**T * X = B, or A**H * 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)
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) COMPLEX*16 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) COMPLEX*16 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 COMPLEX*16 ZERO
76 PARAMETER ( ZERO = ( 0.0D+0, 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 XERBLA, ZTPSV
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( 'ZTPTRS', -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, A**T * x = b, or A**H * x = b.
145 *
146 DO 30 J = 1, NRHS
147 CALL ZTPSV( UPLO, TRANS, DIAG, N, AP, B( 1, J ), 1 )
148 30 CONTINUE
149 *
150 RETURN
151 *
152 * End of ZTPTRS
153 *
154 END