324 $ Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W,
325 $ Z, LDZ, WORK, LWORK, RWORK, IWORK,
335 CHARACTER JOBZ, RANGE, UPLO
336 INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
340 INTEGER IFAIL( * ), IWORK( * )
341 REAL RWORK( * ), W( * )
342 COMPLEX AB( LDAB, * ), Q( LDQ, * ), WORK( * ),
350 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
352 parameter( czero = ( 0.0e0, 0.0e0 ),
353 $ cone = ( 1.0e0, 0.0e0 ) )
356 LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ
359 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
360 $ INDISP, INDIWK, INDRWK, INDWRK, ISCALE, ITMP1,
361 $ llwork, lwmin, lhtrd, lwtrd, ib, indhous,
363 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
364 $ SIGMA, SMLNUM, TMP1, VLL, VUU
371 EXTERNAL lsame, slamch, clanhb, ilaenv2stage
379 INTRINSIC real,
max,
min, sqrt
385 wantz = lsame( jobz,
'V' )
386 alleig = lsame( range,
'A' )
387 valeig = lsame( range,
'V' )
388 indeig = lsame( range,
'I' )
389 lower = lsame( uplo,
'L' )
390 lquery = ( lwork.EQ.-1 )
393 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
395 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
397 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
399 ELSE IF( n.LT.0 )
THEN
401 ELSE IF( kd.LT.0 )
THEN
403 ELSE IF( ldab.LT.kd+1 )
THEN
405 ELSE IF( wantz .AND. ldq.LT.
max( 1, n ) )
THEN
409 IF( n.GT.0 .AND. vu.LE.vl )
411 ELSE IF( indeig )
THEN
412 IF( il.LT.1 .OR. il.GT.
max( 1, n ) )
THEN
414 ELSE IF( iu.LT.
min( n, il ) .OR. iu.GT.n )
THEN
420 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
429 ib = ilaenv2stage( 2,
'CHETRD_HB2ST', jobz,
431 lhtrd = ilaenv2stage( 3,
'CHETRD_HB2ST', jobz,
435 LWMIN = LHTRD + LWTRD
439.LT..AND..NOT.
IF( LWORKLWMIN LQUERY )
446 ELSE IF( LQUERY ) THEN
461 CTMP1 = AB( KD+1, 1 )
465.NOT..LT..AND..GE.
IF( ( VLTMP1 VUTMP1 ) )
469 W( 1 ) = REAL( CTMP1 )
478 SAFMIN = SLAMCH( 'safe minimum
' )
479 EPS = SLAMCH( 'precision
' )
480 SMLNUM = SAFMIN / EPS
481 BIGNUM = ONE / SMLNUM
482 RMIN = SQRT( SMLNUM )
483 RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
496 ANRM = CLANHB( 'm
', UPLO, N, KD, AB, LDAB, RWORK )
497.GT..AND..LT.
IF( ANRMZERO ANRMRMIN ) THEN
500.GT.
ELSE IF( ANRMRMAX ) THEN
504.EQ.
IF( ISCALE1 ) THEN
506 CALL CLASCL( 'b
', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
508 CALL CLASCL( 'q
', KD, KD, ONE, SIGMA, N, N, AB, LDAB, INFO )
511 $ ABSTLL = ABSTOL*SIGMA
525 INDWRK = INDHOUS + LHTRD
526 LLWORK = LWORK - INDWRK + 1
528 CALL CHETRD_HB2ST( 'n
', JOBZ, UPLO, N, KD, AB, LDAB,
529 $ RWORK( INDD ), RWORK( INDE ), WORK( INDHOUS ),
530 $ LHTRD, WORK( INDWRK ), LLWORK, IINFO )
538.EQ..AND..EQ.
IF (IL1 IUN) THEN
542.OR..AND..LE.
IF ((ALLEIG TEST) (ABSTOLZERO)) THEN
543 CALL SCOPY( N, RWORK( INDD ), 1, W, 1 )
545.NOT.
IF( WANTZ ) THEN
546 CALL SCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
547 CALL SSTERF( N, W, RWORK( INDEE ), INFO )
549 CALL CLACPY( 'a
', N, N, Q, LDQ, Z, LDZ )
550 CALL SCOPY( N-1, RWORK( INDE ), 1, RWORK( INDEE ), 1 )
551 CALL CSTEQR( JOBZ, N, W, RWORK( INDEE ), Z, LDZ,
552 $ RWORK( INDRWK ), INFO )
576 CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
577 $ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
578 $ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ),
579 $ IWORK( INDIWK ), INFO )
582 CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
583 $ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ,
584 $ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
590 CALL CCOPY( N, Z( 1, J ), 1, WORK( 1 ), 1 )
591 CALL CGEMV( 'n
', N, N, CONE, Q, LDQ, WORK, 1, CZERO,
599.EQ.
IF( ISCALE1 ) THEN
605 CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
616.LT.
IF( W( JJ )TMP1 ) THEN
623 ITMP1 = IWORK( INDIBL+I-1 )
625 IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 )
627 IWORK( INDIBL+J-1 ) = ITMP1
628 CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
631 IFAIL( I ) = IFAIL( J )
subroutine sstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
SSTEBZ
subroutine ssterf(n, d, e, info)
SSTERF
subroutine xerbla(srname, info)
XERBLA
subroutine clascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
CSTEIN
subroutine chetrd_hb2st(stage1, vect, uplo, n, kd, ab, ldab, d, e, hous, lhous, work, lwork, info)
CHETRD_HB2ST reduces a complex Hermitian band matrix A to real symmetric tridiagonal form T
subroutine csteqr(compz, n, d, e, z, ldz, work, info)
CSTEQR
subroutine chbevx_2stage(jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail, info)
CHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER ...
subroutine cswap(n, cx, incx, cy, incy)
CSWAP
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine cgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
CGEMV
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine scopy(n, sx, incx, sy, incy)
SCOPY