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