259 SUBROUTINE chbevx( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
260 $ vu, il, iu, abstol, m, w, z, ldz, work, rwork,
261 $ iwork, ifail, info )
269 CHARACTER JOBZ, RANGE, UPLO
270 INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N
274 INTEGER IFAIL( * ), IWORK( * )
275 REAL RWORK( * ), W( * )
276 COMPLEX AB( ldab, * ), Q( ldq, * ), WORK( * ),
284 parameter( zero = 0.0e0, one = 1.0e0 )
286 parameter( czero = ( 0.0e0, 0.0e0 ),
287 $ cone = ( 1.0e0, 0.0e0 ) )
290 LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ
292 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
293 $ indisp, indiwk, indrwk, indwrk, iscale, itmp1,
295 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
296 $ sigma, smlnum, tmp1, vll, vuu
302 EXTERNAL lsame, clanhb, slamch
310 INTRINSIC max, min,
REAL, SQRT
316 wantz = lsame( jobz,
'V' )
317 alleig = lsame( range,
'A' )
318 valeig = lsame( range,
'V' )
319 indeig = lsame( range,
'I' )
320 lower = lsame( uplo,
'L' )
323 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
325 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
327 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
329 ELSE IF( n.LT.0 )
THEN
331 ELSE IF( kd.LT.0 )
THEN
333 ELSE IF( ldab.LT.kd+1 )
THEN
335 ELSE IF( wantz .AND. ldq.LT.max( 1, n ) )
THEN
339 IF( n.GT.0 .AND. vu.LE.vl )
341 ELSE IF( indeig )
THEN
342 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
344 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
350 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
355 CALL xerbla(
'CHBEVX', -info )
370 ctmp1 = ab( kd+1, 1 )
374 IF( .NOT.( vl.LT.tmp1 .AND. vu.GE.tmp1 ) )
387 safmin = slamch(
'Safe minimum' )
388 eps = slamch(
'Precision' )
389 smlnum = safmin / eps
390 bignum = one / smlnum
391 rmin = sqrt( smlnum )
392 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
405 anrm = clanhb(
'M', uplo, n, kd, ab, ldab, rwork )
406 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
409 ELSE IF( anrm.GT.rmax )
THEN
413 IF( iscale.EQ.1 )
THEN
415 CALL clascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
417 CALL clascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
420 $ abstll = abstol*sigma
433 CALL chbtrd( jobz, uplo, n, kd, ab, ldab, rwork( indd ),
434 $ rwork( inde ), q, ldq, work( indwrk ), iinfo )
442 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
446 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
447 CALL scopy( n, rwork( indd ), 1, w, 1 )
449 IF( .NOT.wantz )
THEN
450 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
451 CALL ssterf( n, w, rwork( indee ), info )
453 CALL clacpy(
'A', n, n, q, ldq, z, ldz )
454 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
455 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
456 $ rwork( indrwk ), info )
480 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
481 $ rwork( indd ), rwork( inde ), m, nsplit, w,
482 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
483 $ iwork( indiwk ), info )
486 CALL cstein( n, rwork( indd ), rwork( inde ), m, w,
487 $ iwork( indibl ), iwork( indisp ), z, ldz,
488 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
494 CALL ccopy( n, z( 1, j ), 1, work( 1 ), 1 )
495 CALL cgemv(
'N', n, n, cone, q, ldq, work, 1, czero,
503 IF( iscale.EQ.1 )
THEN
509 CALL sscal( imax, one / sigma, w, 1 )
520 IF( w( jj ).LT.tmp1 )
THEN
527 itmp1 = iwork( indibl+i-1 )
529 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
531 iwork( indibl+j-1 ) = itmp1
532 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
535 ifail( i ) = ifail( j )
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 clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine chbevx(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
CHBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine sscal(N, SA, SX, INCX)
SSCAL