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
337 DOUBLE PRECISION ABSTOL, VL, VU
340 INTEGER IFAIL( * ), IWORK( * )
341 DOUBLE PRECISION RWORK( * ), W( * )
342 COMPLEX*16 AB( LDAB, * ), Q( LDQ, * ), WORK( * ),
349 DOUBLE PRECISION ZERO, ONE
350 PARAMETER ( ZERO = 0.0d0, one = 1.0d0 )
351 COMPLEX*16 CZERO, CONE
352 parameter( czero = ( 0.0d0, 0.0d0 ),
353 $ cone = ( 1.0d0, 0.0d0 ) )
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 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
364 $ SIGMA, SMLNUM, TMP1, VLL, VUU
370 DOUBLE PRECISION DLAMCH, ZLANHB
371 EXTERNAL lsame, dlamch, zlanhb, ilaenv2stage
379 INTRINSIC dble,
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,
'ZHETRD_HB2ST', jobz,
431 lhtrd = ilaenv2stage( 3,
'ZHETRD_HB2ST', jobz,
433 lwtrd = ilaenv2stage( 4,
'ZHETRD_HB2ST', jobz,
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
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.EQ.
IF( ISCALE1 ) THEN
605 CALL DSCAL( 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 ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
631 IFAIL( I ) = IFAIL( J )
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 ...