LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cgbtrs()

subroutine cgbtrs ( character trans,
integer n,
integer kl,
integer ku,
integer nrhs,
complex, dimension( ldab, * ) ab,
integer ldab,
integer, dimension( * ) ipiv,
complex, dimension( ldb, * ) b,
integer ldb,
integer info )

CGBTRS

Download CGBTRS + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!> CGBTRS solves a system of linear equations
!>    A * X = B,  A**T * X = B,  or  A**H * X = B
!> with a general band matrix A using the LU factorization computed
!> by CGBTRF.
!>
Parameters
[in]TRANS
!>          TRANS is CHARACTER*1
!>          Specifies the form of the system of equations.
!>          = 'N':  A * X = B     (No transpose)
!>          = 'T':  A**T * X = B  (Transpose)
!>          = 'C':  A**H * X = B  (Conjugate transpose)
!>
[in]N
!>          N is INTEGER
!>          The order of the matrix A.  N >= 0.
!>
[in]KL
!>          KL is INTEGER
!>          The number of subdiagonals within the band of A.  KL >= 0.
!>
[in]KU
!>          KU is INTEGER
!>          The number of superdiagonals within the band of A.  KU >= 0.
!>
[in]NRHS
!>          NRHS is INTEGER
!>          The number of right hand sides, i.e., the number of columns
!>          of the matrix B.  NRHS >= 0.
!>
[in]AB
!>          AB is COMPLEX array, dimension (LDAB,N)
!>          Details of the LU factorization of the band matrix A, as
!>          computed by CGBTRF.  U is stored as an upper triangular band
!>          matrix with KL+KU superdiagonals in rows 1 to KL+KU+1, and
!>          the multipliers used during the factorization are stored in
!>          rows KL+KU+2 to 2*KL+KU+1.
!>
[in]LDAB
!>          LDAB is INTEGER
!>          The leading dimension of the array AB.  LDAB >= 2*KL+KU+1.
!>
[in]IPIV
!>          IPIV is INTEGER array, dimension (N)
!>          The pivot indices; for 1 <= i <= N, row i of the matrix was
!>          interchanged with row IPIV(i).
!>
[in,out]B
!>          B is COMPLEX array, dimension (LDB,NRHS)
!>          On entry, the right hand side matrix B.
!>          On exit, the solution matrix X.
!>
[in]LDB
!>          LDB is INTEGER
!>          The leading dimension of the array B.  LDB >= max(1,N).
!>
[out]INFO
!>          INFO is INTEGER
!>          = 0:  successful exit
!>          < 0:  if INFO = -i, the i-th argument had an illegal value
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 134 of file cgbtrs.f.

137*
138* -- LAPACK computational routine --
139* -- LAPACK is a software package provided by Univ. of Tennessee, --
140* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
141*
142* .. Scalar Arguments ..
143 CHARACTER TRANS
144 INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
145* ..
146* .. Array Arguments ..
147 INTEGER IPIV( * )
148 COMPLEX AB( LDAB, * ), B( LDB, * )
149* ..
150*
151* =====================================================================
152*
153* .. Parameters ..
154 COMPLEX ONE
155 parameter( one = ( 1.0e+0, 0.0e+0 ) )
156* ..
157* .. Local Scalars ..
158 LOGICAL LNOTI, NOTRAN
159 INTEGER I, J, KD, L, LM
160* ..
161* .. External Functions ..
162 LOGICAL LSAME
163 EXTERNAL lsame
164* ..
165* .. External Subroutines ..
166 EXTERNAL cgemv, cgeru, clacgv, cswap, ctbsv,
167 $ 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,
225 $ 1 ),
226 $ ldb, b( j+1, 1 ), ldb )
227 10 CONTINUE
228 END IF
229*
230 DO 20 i = 1, nrhs
231*
232* Solve U*X = B, overwriting B with X.
233*
234 CALL ctbsv( 'Upper', 'No transpose', 'Non-unit', n,
235 $ kl+ku,
236 $ ab, ldab, b( 1, i ), 1 )
237 20 CONTINUE
238*
239 ELSE IF( lsame( trans, 'T' ) ) THEN
240*
241* Solve A**T * X = B.
242*
243 DO 30 i = 1, nrhs
244*
245* Solve U**T * X = B, overwriting B with X.
246*
247 CALL ctbsv( 'Upper', 'Transpose', 'Non-unit', n, kl+ku,
248 $ ab,
249 $ ldab, b( 1, i ), 1 )
250 30 CONTINUE
251*
252* Solve L**T * X = B, overwriting B with X.
253*
254 IF( lnoti ) THEN
255 DO 40 j = n - 1, 1, -1
256 lm = min( kl, n-j )
257 CALL cgemv( 'Transpose', lm, nrhs, -one, b( j+1, 1 ),
258 $ ldb, ab( kd+1, j ), 1, one, b( j, 1 ), ldb )
259 l = ipiv( j )
260 IF( l.NE.j )
261 $ CALL cswap( nrhs, b( l, 1 ), ldb, b( j, 1 ), ldb )
262 40 CONTINUE
263 END IF
264*
265 ELSE
266*
267* Solve A**H * X = B.
268*
269 DO 50 i = 1, nrhs
270*
271* Solve U**H * X = B, overwriting B with X.
272*
273 CALL ctbsv( 'Upper', 'Conjugate transpose', 'Non-unit',
274 $ n,
275 $ kl+ku, ab, ldab, b( 1, i ), 1 )
276 50 CONTINUE
277*
278* Solve L**H * X = B, overwriting B with X.
279*
280 IF( lnoti ) THEN
281 DO 60 j = n - 1, 1, -1
282 lm = min( kl, n-j )
283 CALL clacgv( nrhs, b( j, 1 ), ldb )
284 CALL cgemv( 'Conjugate transpose', lm, nrhs, -one,
285 $ b( j+1, 1 ), ldb, ab( kd+1, j ), 1, one,
286 $ b( j, 1 ), ldb )
287 CALL clacgv( nrhs, b( j, 1 ), ldb )
288 l = ipiv( j )
289 IF( l.NE.j )
290 $ CALL cswap( nrhs, b( l, 1 ), ldb, b( j, 1 ), ldb )
291 60 CONTINUE
292 END IF
293 END IF
294 RETURN
295*
296* End of CGBTRS
297*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
cgemv
subroutine cgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
CGEMV
Definition cgemv.f:160
cgeru
subroutine cgeru(m, n, alpha, x, incx, y, incy, a, lda)
CGERU
Definition cgeru.f:130
clacgv
subroutine clacgv(n, x, incx)
CLACGV conjugates a complex vector.
Definition clacgv.f:72
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
cswap
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
Definition cswap.f:81
ctbsv
subroutine ctbsv(uplo, trans, diag, n, k, a, lda, x, incx)
CTBSV
Definition ctbsv.f:189
Here is the call graph for this function:
Here is the caller graph for this function: