299 SUBROUTINE zhbgvx( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
300 $ ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z,
301 $ ldz, work, rwork, iwork, ifail, info )
309 CHARACTER JOBZ, RANGE, UPLO
310 INTEGER IL, INFO, IU, KA, KB, LDAB, LDBB, LDQ, LDZ, M,
312 DOUBLE PRECISION ABSTOL, VL, VU
315 INTEGER IFAIL( * ), IWORK( * )
316 DOUBLE PRECISION RWORK( * ), W( * )
317 COMPLEX*16 AB( ldab, * ), BB( ldbb, * ), Q( ldq, * ),
318 $ work( * ), z( ldz, * )
324 DOUBLE PRECISION ZERO
325 parameter ( zero = 0.0d+0 )
326 COMPLEX*16 CZERO, CONE
327 parameter ( czero = ( 0.0d+0, 0.0d+0 ),
328 $ cone = ( 1.0d+0, 0.0d+0 ) )
331 LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
332 CHARACTER ORDER, VECT
333 INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP,
334 $ indiwk, indrwk, indwrk, itmp1, j, jj, nsplit
335 DOUBLE PRECISION TMP1
353 wantz = lsame( jobz,
'V' )
354 upper = lsame( uplo,
'U' )
355 alleig = lsame( range,
'A' )
356 valeig = lsame( range,
'V' )
357 indeig = lsame( range,
'I' )
360 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
362 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
364 ELSE IF( .NOT.( upper .OR. lsame( uplo,
'L' ) ) )
THEN
366 ELSE IF( n.LT.0 )
THEN
368 ELSE IF( ka.LT.0 )
THEN
370 ELSE IF( kb.LT.0 .OR. kb.GT.ka )
THEN
372 ELSE IF( ldab.LT.ka+1 )
THEN
374 ELSE IF( ldbb.LT.kb+1 )
THEN
376 ELSE IF( ldq.LT.1 .OR. ( wantz .AND. ldq.LT.n ) )
THEN
380 IF( n.GT.0 .AND. vu.LE.vl )
382 ELSE IF( indeig )
THEN
383 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
385 ELSE IF ( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
391 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
397 CALL xerbla(
'ZHBGVX', -info )
409 CALL zpbstf( uplo, n, kb, bb, ldbb, info )
417 CALL zhbgst( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq,
418 $ work, rwork, iinfo )
432 CALL zhbtrd( vect, uplo, n, ka, ab, ldab, rwork( indd ),
433 $ rwork( inde ), q, ldq, work( indwrk ), iinfo )
441 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
445 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
446 CALL dcopy( n, rwork( indd ), 1, w, 1 )
448 CALL dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
449 IF( .NOT.wantz )
THEN
450 CALL dsterf( n, w, rwork( indee ), info )
452 CALL zlacpy(
'A', n, n, q, ldq, z, ldz )
453 CALL zsteqr( jobz, n, w, rwork( indee ), z, ldz,
454 $ rwork( indrwk ), info )
479 CALL dstebz( range, order, n, vl, vu, il, iu, abstol,
480 $ rwork( indd ), rwork( inde ), m, nsplit, w,
481 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
482 $ iwork( indiwk ), info )
485 CALL zstein( n, rwork( indd ), rwork( inde ), m, w,
486 $ iwork( indibl ), iwork( indisp ), z, ldz,
487 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
493 CALL zcopy( n, z( 1, j ), 1, work( 1 ), 1 )
494 CALL zgemv(
'N', n, n, cone, q, ldq, work, 1, czero,
509 IF( w( jj ).LT.tmp1 )
THEN
516 itmp1 = iwork( indibl+i-1 )
518 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
520 iwork( indibl+j-1 ) = itmp1
521 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
524 ifail( i ) = ifail( j )
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
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 zhbgst(VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, LDX, WORK, RWORK, INFO)
ZHBGST
subroutine xerbla(SRNAME, INFO)
XERBLA
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 zpbstf(UPLO, N, KD, AB, LDAB, INFO)
ZPBSTF
subroutine zhbgvx(JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
ZHBGVX
subroutine zhbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
ZHBTRD