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