LAPACK  3.10.1 LAPACK: Linear Algebra PACKage
cgbtrs.f
Go to the documentation of this file.
1 *> \brief \b CGBTRS
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgbtrs.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgbtrs.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgbtrs.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
22 * INFO )
23 *
24 * .. Scalar Arguments ..
25 * CHARACTER TRANS
26 * INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
27 * ..
28 * .. Array Arguments ..
29 * INTEGER IPIV( * )
30 * COMPLEX AB( LDAB, * ), B( LDB, * )
31 * ..
32 *
33 *
34 *> \par Purpose:
35 * =============
36 *>
37 *> \verbatim
38 *>
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
42 *> by CGBTRF.
43 *> \endverbatim
44 *
45 * Arguments:
46 * ==========
47 *
48 *> \param[in] TRANS
49 *> \verbatim
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)
55 *> \endverbatim
56 *>
57 *> \param[in] N
58 *> \verbatim
59 *> N is INTEGER
60 *> The order of the matrix A. N >= 0.
61 *> \endverbatim
62 *>
63 *> \param[in] KL
64 *> \verbatim
65 *> KL is INTEGER
66 *> The number of subdiagonals within the band of A. KL >= 0.
67 *> \endverbatim
68 *>
69 *> \param[in] KU
70 *> \verbatim
71 *> KU is INTEGER
72 *> The number of superdiagonals within the band of A. KU >= 0.
73 *> \endverbatim
74 *>
75 *> \param[in] NRHS
76 *> \verbatim
77 *> NRHS is INTEGER
78 *> The number of right hand sides, i.e., the number of columns
79 *> of the matrix B. NRHS >= 0.
80 *> \endverbatim
81 *>
82 *> \param[in] AB
83 *> \verbatim
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.
90 *> \endverbatim
91 *>
92 *> \param[in] LDAB
93 *> \verbatim
94 *> LDAB is INTEGER
95 *> The leading dimension of the array AB. LDAB >= 2*KL+KU+1.
96 *> \endverbatim
97 *>
98 *> \param[in] IPIV
99 *> \verbatim
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).
103 *> \endverbatim
104 *>
105 *> \param[in,out] B
106 *> \verbatim
107 *> B is COMPLEX array, dimension (LDB,NRHS)
108 *> On entry, the right hand side matrix B.
109 *> On exit, the solution matrix X.
110 *> \endverbatim
111 *>
112 *> \param[in] LDB
113 *> \verbatim
114 *> LDB is INTEGER
115 *> The leading dimension of the array B. LDB >= max(1,N).
116 *> \endverbatim
117 *>
118 *> \param[out] INFO
119 *> \verbatim
120 *> INFO is INTEGER
121 *> = 0: successful exit
122 *> < 0: if INFO = -i, the i-th argument had an illegal value
123 *> \endverbatim
124 *
125 * Authors:
126 * ========
127 *
128 *> \author Univ. of Tennessee
129 *> \author Univ. of California Berkeley
130 *> \author Univ. of Colorado Denver
131 *> \author NAG Ltd.
132 *
133 *> \ingroup complexGBcomputational
134 *
135 * =====================================================================
136  SUBROUTINE cgbtrs( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB,
137  \$ INFO )
138 *
139 * -- LAPACK computational routine --
140 * -- LAPACK is a software package provided by Univ. of Tennessee, --
141 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
142 *
143 * .. Scalar Arguments ..
144  CHARACTER TRANS
145  INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
146 * ..
147 * .. Array Arguments ..
148  INTEGER IPIV( * )
149  COMPLEX AB( LDAB, * ), B( LDB, * )
150 * ..
151 *
152 * =====================================================================
153 *
154 * .. Parameters ..
155  COMPLEX ONE
156  parameter( one = ( 1.0e+0, 0.0e+0 ) )
157 * ..
158 * .. Local Scalars ..
159  LOGICAL LNOTI, NOTRAN
160  INTEGER I, J, KD, L, LM
161 * ..
162 * .. External Functions ..
163  LOGICAL LSAME
164  EXTERNAL lsame
165 * ..
166 * .. External Subroutines ..
167  EXTERNAL cgemv, cgeru, clacgv, cswap, ctbsv, xerbla
168 * ..
169 * .. Intrinsic Functions ..
170  INTRINSIC max, min
171 * ..
172 * .. Executable Statements ..
173 *
174 * Test the input parameters.
175 *
176  info = 0
177  notran = lsame( trans, 'N' )
178  IF( .NOT.notran .AND. .NOT.lsame( trans, 'T' ) .AND. .NOT.
179  \$ lsame( trans, 'C' ) ) THEN
180  info = -1
181  ELSE IF( n.LT.0 ) THEN
182  info = -2
183  ELSE IF( kl.LT.0 ) THEN
184  info = -3
185  ELSE IF( ku.LT.0 ) THEN
186  info = -4
187  ELSE IF( nrhs.LT.0 ) THEN
188  info = -5
189  ELSE IF( ldab.LT.( 2*kl+ku+1 ) ) THEN
190  info = -7
191  ELSE IF( ldb.LT.max( 1, n ) ) THEN
192  info = -10
193  END IF
194  IF( info.NE.0 ) THEN
195  CALL xerbla( 'CGBTRS', -info )
196  RETURN
197  END IF
198 *
199 * Quick return if possible
200 *
201  IF( n.EQ.0 .OR. nrhs.EQ.0 )
202  \$ RETURN
203 *
204  kd = ku + kl + 1
205  lnoti = kl.GT.0
206 *
207  IF( notran ) THEN
208 *
209 * Solve A*X = B.
210 *
211 * Solve L*X = B, overwriting B with X.
212 *
213 * L is represented as a product of permutations and unit lower
214 * triangular matrices L = P(1) * L(1) * ... * P(n-1) * L(n-1),
215 * where each transformation L(i) is a rank-one modification of
216 * the identity matrix.
217 *
218  IF( lnoti ) THEN
219  DO 10 j = 1, n - 1
220  lm = min( kl, n-j )
221  l = ipiv( j )
222  IF( l.NE.j )
223  \$ CALL cswap( nrhs, b( l, 1 ), ldb, b( j, 1 ), ldb )
224  CALL cgeru( lm, nrhs, -one, ab( kd+1, j ), 1, b( j, 1 ),
225  \$ ldb, b( j+1, 1 ), ldb )
226  10 CONTINUE
227  END IF
228 *
229  DO 20 i = 1, nrhs
230 *
231 * Solve U*X = B, overwriting B with X.
232 *
233  CALL ctbsv( 'Upper', 'No transpose', 'Non-unit', n, kl+ku,
234  \$ ab, ldab, b( 1, i ), 1 )
235  20 CONTINUE
236 *
237  ELSE IF( lsame( trans, 'T' ) ) THEN
238 *
239 * Solve A**T * X = B.
240 *
241  DO 30 i = 1, nrhs
242 *
243 * Solve U**T * X = B, overwriting B with X.
244 *
245  CALL ctbsv( 'Upper', 'Transpose', 'Non-unit', n, kl+ku, ab,
246  \$ ldab, b( 1, i ), 1 )
247  30 CONTINUE
248 *
249 * Solve L**T * X = B, overwriting B with X.
250 *
251  IF( lnoti ) THEN
252  DO 40 j = n - 1, 1, -1
253  lm = min( kl, n-j )
254  CALL cgemv( 'Transpose', lm, nrhs, -one, b( j+1, 1 ),
255  \$ ldb, ab( kd+1, j ), 1, one, b( j, 1 ), ldb )
256  l = ipiv( j )
257  IF( l.NE.j )
258  \$ CALL cswap( nrhs, b( l, 1 ), ldb, b( j, 1 ), ldb )
259  40 CONTINUE
260  END IF
261 *
262  ELSE
263 *
264 * Solve A**H * X = B.
265 *
266  DO 50 i = 1, nrhs
267 *
268 * Solve U**H * X = B, overwriting B with X.
269 *
270  CALL ctbsv( 'Upper', 'Conjugate transpose', 'Non-unit', n,
271  \$ kl+ku, ab, ldab, b( 1, i ), 1 )
272  50 CONTINUE
273 *
274 * Solve L**H * X = B, overwriting B with X.
275 *
276  IF( lnoti ) THEN
277  DO 60 j = n - 1, 1, -1
278  lm = min( kl, n-j )
279  CALL clacgv( nrhs, b( j, 1 ), ldb )
280  CALL cgemv( 'Conjugate transpose', lm, nrhs, -one,
281  \$ b( j+1, 1 ), ldb, ab( kd+1, j ), 1, one,
282  \$ b( j, 1 ), ldb )
283  CALL clacgv( nrhs, b( j, 1 ), ldb )
284  l = ipiv( j )
285  IF( l.NE.j )
286  \$ CALL cswap( nrhs, b( l, 1 ), ldb, b( j, 1 ), ldb )
287  60 CONTINUE
288  END IF
289  END IF
290  RETURN
291 *
292 * End of CGBTRS
293 *
294  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
Definition: cswap.f:81
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:158
subroutine ctbsv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
CTBSV
Definition: ctbsv.f:189
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERU
Definition: cgeru.f:130
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
Definition: cgbtrs.f:138
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
Definition: clacgv.f:74