325 SUBROUTINE zhbevx_2stage( JOBZ, RANGE, UPLO, N, KD, AB, LDAB,
326 $ q, ldq, vl, vu, il, iu, abstol, m, w,
327 $ z, ldz, work, lwork, rwork, iwork,
338 CHARACTER JOBZ, RANGE, UPLO
339 INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
340 DOUBLE PRECISION ABSTOL, VL, VU
343 INTEGER IFAIL( * ), IWORK( * )
344 DOUBLE PRECISION RWORK( * ), W( * )
345 COMPLEX*16 AB( ldab, * ), Q( ldq, * ), WORK( * ),
352 DOUBLE PRECISION ZERO, ONE
353 parameter ( zero = 0.0d0, one = 1.0d0 )
354 COMPLEX*16 CZERO, CONE
355 parameter ( czero = ( 0.0d0, 0.0d0 ),
356 $ cone = ( 1.0d0, 0.0d0 ) )
359 LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ,
362 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
363 $ indisp, indiwk, indrwk, indwrk, iscale, itmp1,
364 $ llwork, lwmin, lhtrd, lwtrd, ib, indhous,
366 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
367 $ sigma, smlnum, tmp1, vll, vuu
373 DOUBLE PRECISION DLAMCH, ZLANHB
374 EXTERNAL lsame, dlamch, zlanhb, ilaenv
379 $
zswap, zhetrd_hb2st
382 INTRINSIC dble, max, min, sqrt
388 wantz = lsame( jobz,
'V' )
389 alleig = lsame( range,
'A' )
390 valeig = lsame( range,
'V' )
391 indeig = lsame( range,
'I' )
392 lower = lsame( uplo,
'L' )
393 lquery = ( lwork.EQ.-1 )
396 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
398 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
400 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
402 ELSE IF( n.LT.0 )
THEN
404 ELSE IF( kd.LT.0 )
THEN
406 ELSE IF( ldab.LT.kd+1 )
THEN
408 ELSE IF( wantz .AND. ldq.LT.max( 1, n ) )
THEN
412 IF( n.GT.0 .AND. vu.LE.vl )
414 ELSE IF( indeig )
THEN
415 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
417 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
423 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
432 ib = ilaenv( 18,
'ZHETRD_HB2ST', jobz, n, kd, -1, -1 )
433 lhtrd = ilaenv( 19,
'ZHETRD_HB2ST', jobz, n, kd, ib, -1 )
434 lwtrd = ilaenv( 20,
'ZHETRD_HB2ST', jobz, n, kd, ib, -1 )
435 lwmin = lhtrd + lwtrd
439 IF( lwork.LT.lwmin .AND. .NOT.lquery )
444 CALL xerbla(
'ZHBEVX_2STAGE', -info )
446 ELSE IF( lquery )
THEN
461 ctmp1 = ab( kd+1, 1 )
465 IF( .NOT.( vl.LT.tmp1 .AND. vu.GE.tmp1 ) )
469 w( 1 ) = dble( ctmp1 )
478 safmin = dlamch(
'Safe minimum' )
479 eps = dlamch(
'Precision' )
480 smlnum = safmin / eps
481 bignum = one / smlnum
482 rmin = sqrt( smlnum )
483 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
496 anrm = zlanhb(
'M', uplo, n, kd, ab, ldab, rwork )
497 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
500 ELSE IF( anrm.GT.rmax )
THEN
504 IF( iscale.EQ.1 )
THEN
506 CALL zlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
508 CALL zlascl(
'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 zhetrd_hb2st(
'N', jobz, uplo, n, kd, ab, ldab,
529 $ rwork( indd ), rwork( inde ), work( indhous ),
530 $ lhtrd, work( indwrk ), llwork, iinfo )
538 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
542 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
543 CALL dcopy( n, rwork( indd ), 1, w, 1 )
545 IF( .NOT.wantz )
THEN
546 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
547 CALL dsterf( n, w, rwork( indee ), info )
549 CALL zlacpy(
'A', n, n, q, ldq, z, ldz )
550 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
551 CALL zsteqr( jobz, n, w, rwork( indee ), z, ldz,
552 $ rwork( indrwk ), info )
576 CALL dstebz( 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 zstein( n, rwork( indd ), rwork( inde ), m, w,
583 $ iwork( indibl ), iwork( indisp ), z, ldz,
584 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
590 CALL zcopy( n, z( 1, j ), 1, work( 1 ), 1 )
591 CALL zgemv(
'N', n, n, cone, q, ldq, work, 1, czero,
599 IF( iscale.EQ.1 )
THEN
605 CALL dscal( imax, one / sigma, w, 1 )
616 IF( w( jj ).LT.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 zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
631 ifail( i ) = ifail( j )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
subroutine zstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
ZSTEIN
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhbevx_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)
ZHBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER...
subroutine dscal(N, DA, DX, INCX)
DSCAL