251 SUBROUTINE cheevx( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
252 $ abstol, m, w, z, ldz, work, lwork, rwork,
253 $ iwork, ifail, info )
261 CHARACTER JOBZ, RANGE, UPLO
262 INTEGER IL, INFO, IU, LDA, LDZ, LWORK, M, N
266 INTEGER IFAIL( * ), IWORK( * )
267 REAL RWORK( * ), W( * )
268 COMPLEX A( lda, * ), WORK( * ), Z( ldz, * )
275 parameter( zero = 0.0e+0, one = 1.0e+0 )
277 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
280 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, TEST, VALEIG,
283 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
284 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
285 $ itmp1, j, jj, llwork, lwkmin, lwkopt, nb,
287 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
288 $ sigma, smlnum, tmp1, vll, vuu
294 EXTERNAL lsame, ilaenv, slamch, clanhe
302 INTRINSIC REAL, MAX, MIN, SQRT
308 lower = lsame( uplo,
'L' )
309 wantz = lsame( jobz,
'V' )
310 alleig = lsame( range,
'A' )
311 valeig = lsame( range,
'V' )
312 indeig = lsame( range,
'I' )
313 lquery = ( lwork.EQ.-1 )
316 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
318 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
320 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
322 ELSE IF( n.LT.0 )
THEN
324 ELSE IF( lda.LT.max( 1, n ) )
THEN
328 IF( n.GT.0 .AND. vu.LE.vl )
330 ELSE IF( indeig )
THEN
331 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
333 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
339 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
350 nb = ilaenv( 1,
'CHETRD', uplo, n, -1, -1, -1 )
351 nb = max( nb, ilaenv( 1,
'CUNMTR', uplo, n, -1, -1, -1 ) )
352 lwkopt = max( 1, ( nb + 1 )*n )
356 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
361 CALL xerbla(
'CHEEVX', -info )
363 ELSE IF( lquery )
THEN
375 IF( alleig .OR. indeig )
THEN
378 ELSE IF( valeig )
THEN
379 IF( vl.LT.
REAL( A( 1, 1 ) ) .AND. VU.GE.
REAL( A( 1, 1 ) ) )
392 safmin = slamch(
'Safe minimum' )
393 eps = slamch(
'Precision' )
394 smlnum = safmin / eps
395 bignum = one / smlnum
396 rmin = sqrt( smlnum )
397 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
407 anrm = clanhe(
'M', uplo, n, a, lda, rwork )
408 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
411 ELSE IF( anrm.GT.rmax )
THEN
415 IF( iscale.EQ.1 )
THEN
418 CALL csscal( n-j+1, sigma, a( j, j ), 1 )
422 CALL csscal( j, sigma, a( 1, j ), 1 )
426 $ abstll = abstol*sigma
440 llwork = lwork - indwrk + 1
441 CALL chetrd( uplo, n, a, lda, rwork( indd ), rwork( inde ),
442 $ work( indtau ), work( indwrk ), llwork, iinfo )
450 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
454 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
455 CALL scopy( n, rwork( indd ), 1, w, 1 )
457 IF( .NOT.wantz )
THEN
458 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
459 CALL ssterf( n, w, rwork( indee ), info )
461 CALL clacpy(
'A', n, n, a, lda, z, ldz )
462 CALL cungtr( uplo, n, z, ldz, work( indtau ),
463 $ work( indwrk ), llwork, iinfo )
464 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
465 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
466 $ rwork( indrwk ), info )
490 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
491 $ rwork( indd ), rwork( inde ), m, nsplit, w,
492 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
493 $ iwork( indiwk ), info )
496 CALL cstein( n, rwork( indd ), rwork( inde ), m, w,
497 $ iwork( indibl ), iwork( indisp ), z, ldz,
498 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
503 CALL cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
504 $ ldz, work( indwrk ), llwork, iinfo )
510 IF( iscale.EQ.1 )
THEN
516 CALL sscal( imax, one / sigma, w, 1 )
527 IF( w( jj ).LT.tmp1 )
THEN
534 itmp1 = iwork( indibl+i-1 )
536 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
538 iwork( indibl+j-1 ) = itmp1
539 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
542 ifail( i ) = ifail( j )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
subroutine cungtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
CUNGTR
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
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 cheevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
CHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine chetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
CHETRD
subroutine sscal(N, SA, SX, INCX)
SSCAL