290 SUBROUTINE zhbgvx( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
291 $ ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z,
292 $ ldz, work, rwork, iwork, ifail, info )
300 CHARACTER JOBZ, RANGE, UPLO
301 INTEGER IL, INFO, IU, KA, KB, LDAB, LDBB, LDQ, LDZ, M,
303 DOUBLE PRECISION ABSTOL, VL, VU
306 INTEGER IFAIL( * ), IWORK( * )
307 DOUBLE PRECISION RWORK( * ), W( * )
308 COMPLEX*16 AB( ldab, * ), BB( ldbb, * ), Q( ldq, * ),
309 $ work( * ), z( ldz, * )
315 DOUBLE PRECISION ZERO
316 parameter( zero = 0.0d+0 )
317 COMPLEX*16 CZERO, CONE
318 parameter( czero = ( 0.0d+0, 0.0d+0 ),
319 $ cone = ( 1.0d+0, 0.0d+0 ) )
322 LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
323 CHARACTER ORDER, VECT
324 INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP,
325 $ indiwk, indrwk, indwrk, itmp1, j, jj, nsplit
326 DOUBLE PRECISION TMP1
344 wantz = lsame( jobz,
'V' )
345 upper = lsame( uplo,
'U' )
346 alleig = lsame( range,
'A' )
347 valeig = lsame( range,
'V' )
348 indeig = lsame( range,
'I' )
351 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
353 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
355 ELSE IF( .NOT.( upper .OR. lsame( uplo,
'L' ) ) )
THEN
357 ELSE IF( n.LT.0 )
THEN
359 ELSE IF( ka.LT.0 )
THEN
361 ELSE IF( kb.LT.0 .OR. kb.GT.ka )
THEN
363 ELSE IF( ldab.LT.ka+1 )
THEN
365 ELSE IF( ldbb.LT.kb+1 )
THEN
367 ELSE IF( ldq.LT.1 .OR. ( wantz .AND. ldq.LT.n ) )
THEN
371 IF( n.GT.0 .AND. vu.LE.vl )
373 ELSE IF( indeig )
THEN
374 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
376 ELSE IF ( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
382 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
388 CALL
xerbla(
'ZHBGVX', -info )
400 CALL
zpbstf( uplo, n, kb, bb, ldbb, info )
408 CALL
zhbgst( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq,
409 $ work, rwork, iinfo )
423 CALL
zhbtrd( vect, uplo, n, ka, ab, ldab, rwork( indd ),
424 $ rwork( inde ), q, ldq, work( indwrk ), iinfo )
432 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
436 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
437 CALL
dcopy( n, rwork( indd ), 1, w, 1 )
439 CALL
dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
440 IF( .NOT.wantz )
THEN
441 CALL
dsterf( n, w, rwork( indee ), info )
443 CALL
zlacpy(
'A', n, n, q, ldq, z, ldz )
444 CALL
zsteqr( jobz, n, w, rwork( indee ), z, ldz,
445 $ rwork( indrwk ), info )
470 CALL
dstebz( range, order, n, vl, vu, il, iu, abstol,
471 $ rwork( indd ), rwork( inde ), m, nsplit, w,
472 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
473 $ iwork( indiwk ), info )
476 CALL
zstein( n, rwork( indd ), rwork( inde ), m, w,
477 $ iwork( indibl ), iwork( indisp ), z, ldz,
478 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
484 CALL
zcopy( n, z( 1, j ), 1, work( 1 ), 1 )
485 CALL
zgemv(
'N', n, n, cone, q, ldq, work, 1, czero,
500 IF( w( jj ).LT.tmp1 )
THEN
507 itmp1 = iwork( indibl+i-1 )
509 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
511 iwork( indibl+j-1 ) = itmp1
512 CALL zswap( n, z( 1, i ), 1, z( 1, j ), 1 )
515 ifail( i ) = ifail( j )
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
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)
ZHBGST
subroutine zstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
ZSTEIN
subroutine zhbgst(VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, LDX, WORK, RWORK, INFO)
ZHBGST
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
ZHBTRD
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
subroutine zpbstf(UPLO, N, KD, AB, LDAB, INFO)
ZPBSTF
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ