191 SUBROUTINE cgbbrd( VECT, M, N, NCC, KL, KU, AB, LDAB, D, E, Q,
192 $ LDQ, PT, LDPT, C, LDC, WORK, RWORK, INFO )
200 INTEGER INFO, KL, KU, LDAB, LDC, LDPT, LDQ, M, N, NCC
203 REAL D( * ), E( * ), RWORK( * )
204 COMPLEX AB( LDAB, * ), C( LDC, * ), PT( LDPT, * ),
205 $ q( ldq, * ), work( * )
212 parameter( zero = 0.0e+0 )
214 parameter( czero = ( 0.0e+0, 0.0e+0 ),
215 $ cone = ( 1.0e+0, 0.0e+0 ) )
218 LOGICAL WANTB, WANTC, WANTPT, WANTQ
219 INTEGER I, INCA, J, J1, J2, KB, KB1, KK, KLM, KLU1,
220 $ kun, l, minmn, ml, ml0, mu, mu0, nr, nrt
222 COMPLEX RA, RB, RS, T
229 INTRINSIC abs, conjg, max, min
239 wantb = lsame( vect,
'B' )
240 wantq = lsame( vect,
'Q' ) .OR. wantb
241 wantpt = lsame( vect,
'P' ) .OR. wantb
245 IF( .NOT.wantq .AND. .NOT.wantpt .AND. .NOT.lsame( vect,
'N' ) )
248 ELSE IF( m.LT.0 )
THEN
250 ELSE IF( n.LT.0 )
THEN
252 ELSE IF( ncc.LT.0 )
THEN
254 ELSE IF( kl.LT.0 )
THEN
256 ELSE IF( ku.LT.0 )
THEN
258 ELSE IF( ldab.LT.klu1 )
THEN
260 ELSE IF( ldq.LT.1 .OR. wantq .AND. ldq.LT.max( 1, m ) )
THEN
262 ELSE IF( ldpt.LT.1 .OR. wantpt .AND. ldpt.LT.max( 1, n ) )
THEN
264 ELSE IF( ldc.LT.1 .OR. wantc .AND. ldc.LT.max( 1, m ) )
THEN
268 CALL xerbla(
'CGBBRD', -info )
275 $
CALL claset(
'Full', m, m, czero, cone, q, ldq )
277 $
CALL claset(
'Full', n, n, czero, cone, pt, ldpt )
281 IF( m.EQ.0 .OR. n.EQ.0 )
286 IF( kl+ku.GT.1 )
THEN
329 $
CALL clargv( nr, ab( klu1, j1-klm-1 ), inca,
330 $ work( j1 ), kb1, rwork( j1 ), kb1 )
335 IF( j2-klm+l-1.GT.n )
THEN
341 $
CALL clartv( nrt, ab( klu1-l, j1-klm+l-1 ), inca,
342 $ ab( klu1-l+1, j1-klm+l-1 ), inca,
343 $ rwork( j1 ), work( j1 ), kb1 )
347 IF( ml.LE.m-i+1 )
THEN
352 CALL clartg( ab( ku+ml-1, i ), ab( ku+ml, i ),
353 $ rwork( i+ml-1 ), work( i+ml-1 ), ra )
354 ab( ku+ml-1, i ) = ra
356 $
CALL crot( min( ku+ml-2, n-i ),
357 $ ab( ku+ml-2, i+1 ), ldab-1,
358 $ ab( ku+ml-1, i+1 ), ldab-1,
359 $ rwork( i+ml-1 ), work( i+ml-1 ) )
369 DO 20 j = j1, j2, kb1
370 CALL crot( m, q( 1, j-1 ), 1, q( 1, j ), 1,
371 $ rwork( j ), conjg( work( j ) ) )
379 DO 30 j = j1, j2, kb1
380 CALL crot( ncc, c( j-1, 1 ), ldc, c( j, 1 ), ldc,
381 $ rwork( j ), work( j ) )
385 IF( j2+kun.GT.n )
THEN
393 DO 40 j = j1, j2, kb1
398 work( j+kun ) = work( j )*ab( 1, j+kun )
399 ab( 1, j+kun ) = rwork( j )*ab( 1, j+kun )
406 $
CALL clargv( nr, ab( 1, j1+kun-1 ), inca,
407 $ work( j1+kun ), kb1, rwork( j1+kun ),
413 IF( j2+l-1.GT.m )
THEN
419 $
CALL clartv( nrt, ab( l+1, j1+kun-1 ), inca,
420 $ ab( l, j1+kun ), inca,
421 $ rwork( j1+kun ), work( j1+kun ), kb1 )
424 IF( ml.EQ.ml0 .AND. mu.GT.mu0 )
THEN
425 IF( mu.LE.n-i+1 )
THEN
430 CALL clartg( ab( ku-mu+3, i+mu-2 ),
431 $ ab( ku-mu+2, i+mu-1 ),
432 $ rwork( i+mu-1 ), work( i+mu-1 ), ra )
433 ab( ku-mu+3, i+mu-2 ) = ra
434 CALL crot( min( kl+mu-2, m-i ),
435 $ ab( ku-mu+4, i+mu-2 ), 1,
436 $ ab( ku-mu+3, i+mu-1 ), 1,
437 $ rwork( i+mu-1 ), work( i+mu-1 ) )
447 DO 60 j = j1, j2, kb1
448 CALL crot( n, pt( j+kun-1, 1 ), ldpt,
449 $ pt( j+kun, 1 ), ldpt, rwork( j+kun ),
450 $ conjg( work( j+kun ) ) )
454 IF( j2+kb.GT.m )
THEN
462 DO 70 j = j1, j2, kb1
467 work( j+kb ) = work( j+kun )*ab( klu1, j+kun )
468 ab( klu1, j+kun ) = rwork( j+kun )*ab( klu1, j+kun )
480 IF( ku.EQ.0 .AND. kl.GT.0 )
THEN
488 DO 100 i = 1, min( m-1, n )
489 CALL clartg( ab( 1, i ), ab( 2, i ), rc, rs, ra )
492 ab( 2, i ) = rs*ab( 1, i+1 )
493 ab( 1, i+1 ) = rc*ab( 1, i+1 )
496 $
CALL crot( m, q( 1, i ), 1, q( 1, i+1 ), 1, rc,
499 $
CALL crot( ncc, c( i, 1 ), ldc, c( i+1, 1 ), ldc, rc,
507 IF( ku.GT.0 .AND. m.LT.n )
THEN
514 CALL clartg( ab( ku+1, i ), rb, rc, rs, ra )
517 rb = -conjg( rs )*ab( ku, i )
518 ab( ku, i ) = rc*ab( ku, i )
521 $
CALL crot( n, pt( i, 1 ), ldpt, pt( m+1, 1 ), ldpt,
534 IF( abst.NE.zero )
THEN
540 $
CALL cscal( m, t, q( 1, i ), 1 )
542 $
CALL cscal( ncc, conjg( t ), c( i, 1 ), ldc )
543 IF( i.LT.minmn )
THEN
544 IF( ku.EQ.0 .AND. kl.EQ.0 )
THEN
549 t = ab( 2, i )*conjg( t )
551 t = ab( ku, i+1 )*conjg( t )
555 IF( abst.NE.zero )
THEN
561 $
CALL cscal( n, t, pt( i+1, 1 ), ldpt )
562 t = ab( ku+1, i+1 )*conjg( t )
subroutine xerbla(srname, info)
subroutine cgbbrd(vect, m, n, ncc, kl, ku, ab, ldab, d, e, q, ldq, pt, ldpt, c, ldc, work, rwork, info)
CGBBRD
subroutine clargv(n, x, incx, y, incy, c, incc)
CLARGV generates a vector of plane rotations with real cosines and complex sines.
subroutine clartg(f, g, c, s, r)
CLARTG generates a plane rotation with real cosine and complex sine.
subroutine clartv(n, x, incx, y, incy, c, s, incc)
CLARTV applies a vector of plane rotations with real cosines and complex sines to the elements of a p...
subroutine claset(uplo, m, n, alpha, beta, a, lda)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine crot(n, cx, incx, cy, incy, c, s)
CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
subroutine cscal(n, ca, cx, incx)
CSCAL