258 SUBROUTINE cheevx( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
259 $ ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK,
260 $ IWORK, IFAIL, INFO )
268 CHARACTER JOBZ, RANGE, UPLO
269 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
273 INTEGER IFAIL( * ), IWORK( * )
274 REAL RWORK( * ), W( * )
275 COMPLEX A( LDA, * ), WORK( * ), Z( LDZ, * )
282 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
284 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
287 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
290 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
291 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
292 $ itmp1, j, jj, llwork, lwkmin, lwkopt, nb,
294 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
295 $ SIGMA, SMLNUM, TMP1, VLL, VUU
301 EXTERNAL lsame, ilaenv, slamch, clanhe
309 INTRINSIC real, max, min, sqrt
315 lower = lsame( uplo,
'L' )
316 wantz = lsame( jobz,
'V' )
317 alleig = lsame( range,
'A' )
318 valeig = lsame( range,
'V' )
319 indeig = lsame( range,
'I' )
320 lquery = ( lwork.EQ.-1 )
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( lda.LT.max( 1, n ) )
THEN
335 IF( n.GT.0 .AND. vu.LE.vl )
337 ELSE IF( indeig )
THEN
338 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
340 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
346 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
357 nb = ilaenv( 1,
'CHETRD', uplo, n, -1, -1, -1 )
358 nb = max( nb, ilaenv( 1,
'CUNMTR', uplo, n, -1, -1, -1 ) )
359 lwkopt = max( 1, ( nb + 1 )*n )
363 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
368 CALL xerbla(
'CHEEVX', -info )
370 ELSE IF( lquery )
THEN
382 IF( alleig .OR. indeig )
THEN
385 ELSE IF( valeig )
THEN
386 IF( vl.LT.real( a( 1, 1 ) ) .AND. vu.GE.real( a( 1, 1 ) ) )
399 safmin = slamch(
'Safe minimum' )
400 eps = slamch(
'Precision' )
401 smlnum = safmin / eps
402 bignum = one / smlnum
403 rmin = sqrt( smlnum )
404 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
414 anrm = clanhe(
'M', uplo, n, a, lda, rwork )
415 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
418 ELSE IF( anrm.GT.rmax )
THEN
422 IF( iscale.EQ.1 )
THEN
425 CALL csscal( n-j+1, sigma, a( j, j ), 1 )
429 CALL csscal( j, sigma, a( 1, j ), 1 )
433 $ abstll = abstol*sigma
447 llwork = lwork - indwrk + 1
448 CALL chetrd( uplo, n, a, lda, rwork( indd ), rwork( inde ),
449 $ work( indtau ), work( indwrk ), llwork, iinfo )
457 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
461 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
462 CALL scopy( n, rwork( indd ), 1, w, 1 )
464 IF( .NOT.wantz )
THEN
465 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
466 CALL ssterf( n, w, rwork( indee ), info )
468 CALL clacpy(
'A', n, n, a, lda, z, ldz )
469 CALL cungtr( uplo, n, z, ldz, work( indtau ),
470 $ work( indwrk ), llwork, iinfo )
471 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
472 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
473 $ rwork( indrwk ), info )
497 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
498 $ rwork( indd ), rwork( inde ), m, nsplit, w,
499 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
500 $ iwork( indiwk ), info )
503 CALL cstein( n, rwork( indd ), rwork( inde ), m, w,
504 $ iwork( indibl ), iwork( indisp ), z, ldz,
505 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
510 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
511 $ ldz, work( indwrk ), llwork, iinfo )
517 IF( iscale.EQ.1 )
THEN
523 CALL sscal( imax, one / sigma, w, 1 )
534 IF( w( jj ).LT.tmp1 )
THEN
541 itmp1 = iwork( indibl+i-1 )
543 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
545 iwork( indibl+j-1 ) = itmp1
546 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
549 ifail( i ) = ifail( j )