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
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 )