3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download CGBTRS + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbtrs.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgbtrs.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbtrs.f">
21 * SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
24 * .. Scalar Arguments ..
26 * INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
28 * .. Array Arguments ..
30 * COMPLEX AB( LDAB, * ), B( LDB, * )
39 *> CGBTRS solves a system of linear equations
40 *> A * X = B, A**T * X = B, or A**H * X = B
41 *> with a general band matrix A using the LU factorization computed
50 *> TRANS is CHARACTER*1
51 *> Specifies the form of the system of equations.
52 *> = 'N': A * X = B (No transpose)
53 *> = 'T': A**T * X = B (Transpose)
54 *> = 'C': A**H * X = B (Conjugate transpose)
60 *> The order of the matrix A. N >= 0.
66 *> The number of subdiagonals within the band of A. KL >= 0.
72 *> The number of superdiagonals within the band of A. KU >= 0.
78 *> The number of right hand sides, i.e., the number of columns
79 *> of the matrix B. NRHS >= 0.
84 *> AB is COMPLEX array, dimension (LDAB,N)
85 *> Details of the LU factorization of the band matrix A, as
86 *> computed by CGBTRF. U is stored as an upper triangular band
87 *> matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
88 *> the multipliers used during the factorization are stored in
89 *> rows KL+KU+2 to 2*KL+KU+1.
95 *> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
100 *> IPIV is INTEGER array, dimension (N)
101 *> The pivot indices; for 1 <= i <= N, row i of the matrix was
102 *> interchanged with row IPIV(i).
107 *> B is COMPLEX array, dimension (LDB,NRHS)
108 *> On entry, the right hand side matrix B.
109 *> On exit, the solution matrix X.
115 *> The leading dimension of the array B. LDB >= max(1,N).
121 *> = 0: successful exit
122 *> < 0: if INFO = -i, the i-th argument had an illegal value
128 *> \author Univ. of Tennessee
129 *> \author Univ. of California Berkeley
130 *> \author Univ. of Colorado Denver
133 *> \date November 2011
135 *> \ingroup complexGBcomputational
137 * =====================================================================
138 SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
141 * -- LAPACK computational routine (version 3.4.0) --
142 * -- LAPACK is a software package provided by Univ. of Tennessee, --
143 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
146 * .. Scalar Arguments ..
148 INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
150 * .. Array Arguments ..
152 COMPLEX AB( LDAB, * ), B( LDB, * )
155 * =====================================================================
159 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ) )
161 * .. Local Scalars ..
162 LOGICAL LNOTI, NOTRAN
163 INTEGER I, J, KD, L, LM
165 * .. External Functions ..
169 * .. External Subroutines ..
170 EXTERNAL CGEMV, CGERU, CLACGV, CSWAP, CTBSV, XERBLA
172 * .. Intrinsic Functions ..
175 * .. Executable Statements ..
177 * Test the input parameters.
180 NOTRAN = LSAME( TRANS, 'N' )
181 IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
182 $ LSAME( TRANS, 'C' ) ) THEN
184 ELSE IF( N.LT.0 ) THEN
186 ELSE IF( KL.LT.0 ) THEN
188 ELSE IF( KU.LT.0 ) THEN
190 ELSE IF( NRHS.LT.0 ) THEN
192 ELSE IF( LDAB.LT.( 2*KL+KU+1 ) ) THEN
194 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
198 CALL XERBLA( 'CGBTRS', -INFO )
202 * Quick return if possible
204 IF( N.EQ.0 .OR. NRHS.EQ.0 )
214 * Solve L*X = B, overwriting B with X.
216 * L is represented as a product of permutations and unit lower
217 * triangular matrices L = P(1) * L(1) * ... * P(n-1) * L(n-1),
218 * where each transformation L(i) is a rank-one modification of
219 * the identity matrix.
226 $ CALL CSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
227 CALL CGERU( LM, NRHS, -ONE, AB( KD+1, J ), 1, B( J, 1 ),
228 $ LDB, B( J+1, 1 ), LDB )
234 * Solve U*X = B, overwriting B with X.
236 CALL CTBSV( 'Upper', 'No transpose', 'Non-unit', N, KL+KU,
237 $ AB, LDAB, B( 1, I ), 1 )
240 ELSE IF( LSAME( TRANS, 'T' ) ) THEN
242 * Solve A**T * X = B.
246 * Solve U**T * X = B, overwriting B with X.
248 CALL CTBSV( 'Upper', 'Transpose', 'Non-unit', N, KL+KU, AB,
249 $ LDAB, B( 1, I ), 1 )
252 * Solve L**T * X = B, overwriting B with X.
255 DO 40 J = N - 1, 1, -1
257 CALL CGEMV( 'Transpose', LM, NRHS, -ONE, B( J+1, 1 ),
258 $ LDB, AB( KD+1, J ), 1, ONE, B( J, 1 ), LDB )
261 $ CALL CSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )
267 * Solve A**H * X = B.
271 * Solve U**H * X = B, overwriting B with X.
273 CALL CTBSV( 'Upper', 'Conjugate transpose', 'Non-unit', N,
274 $ KL+KU, AB, LDAB, B( 1, I ), 1 )
277 * Solve L**H * X = B, overwriting B with X.
280 DO 60 J = N - 1, 1, -1
282 CALL CLACGV( NRHS, B( J, 1 ), LDB )
283 CALL CGEMV( 'Conjugate transpose', LM, NRHS, -ONE,
284 $ B( J+1, 1 ), LDB, AB( KD+1, J ), 1, ONE,
286 CALL CLACGV( NRHS, B( J, 1 ), LDB )
289 $ CALL CSWAP( NRHS, B( L, 1 ), LDB, B( J, 1 ), LDB )