290 SUBROUTINE chbgvx( 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,
306 INTEGER IFAIL( * ), IWORK( * )
307 REAL RWORK( * ), W( * )
308 COMPLEX AB( ldab, * ), BB( ldbb, * ), Q( ldq, * ),
309 $ work( * ), z( ldz, * )
316 parameter( zero = 0.0e+0 )
318 parameter( czero = ( 0.0e+0, 0.0e+0 ),
319 $ cone = ( 1.0e+0, 0.0e+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
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(
'CHBGVX', -info )
400 CALL cpbstf( uplo, n, kb, bb, ldbb, info )
408 CALL chbgst( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq,
409 $ work, rwork, iinfo )
423 CALL chbtrd( 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 scopy( n, rwork( indd ), 1, w, 1 )
439 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
440 IF( .NOT.wantz )
THEN
441 CALL ssterf( n, w, rwork( indee ), info )
443 CALL clacpy(
'A', n, n, q, ldq, z, ldz )
444 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
445 $ rwork( indrwk ), info )
470 CALL sstebz( 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 cstein( n, rwork( indd ), rwork( inde ), m, w,
477 $ iwork( indibl ), iwork( indisp ), z, ldz,
478 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
484 CALL ccopy( n, z( 1, j ), 1, work( 1 ), 1 )
485 CALL cgemv(
'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 cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
515 ifail( i ) = ifail( j )
subroutine cpbstf(UPLO, N, KD, AB, LDAB, INFO)
CPBSTF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
CHBTRD
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
subroutine cstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
CSTEIN
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine chbgst(VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, LDX, WORK, RWORK, INFO)
CHBGST
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine chbgvx(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)
CHBGST