347 SUBROUTINE cheevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
348 $ abstol, m, w, z, ldz, isuppz, work, lwork,
349 $ rwork, lrwork, iwork, liwork, info )
357 CHARACTER jobz, range, uplo
358 INTEGER il, info, iu, lda, ldz, liwork, lrwork, lwork,
363 INTEGER isuppz( * ), iwork( * )
364 REAL rwork( * ), w( * )
365 COMPLEX a( lda, * ), work( * ), z( ldz, * )
372 parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
375 LOGICAL alleig, indeig, lower, lquery, test, valeig,
378 INTEGER i, ieeeok, iinfo, imax, indibl, indifl, indisp,
379 $ indiwo, indrd, indrdd, indre, indree, indrwk,
380 $ indtau, indwk, indwkn, iscale, itmp1, j, jj,
381 $ liwmin, llwork, llrwork, llwrkn, lrwmin,
382 $ lwkopt, lwmin, nb, nsplit
383 REAL abstll, anrm, bignum, eps, rmax, rmin, safmin,
384 $ sigma, smlnum, tmp1, vll, vuu
397 INTRINSIC max, min,
REAL, sqrt
403 ieeeok =
ilaenv( 10,
'CHEEVR',
'N', 1, 2, 3, 4 )
405 lower =
lsame( uplo,
'L' )
406 wantz =
lsame( jobz,
'V' )
407 alleig =
lsame( range,
'A' )
408 valeig =
lsame( range,
'V' )
409 indeig =
lsame( range,
'I' )
411 lquery = ( ( lwork.EQ.-1 ) .OR. ( lrwork.EQ.-1 ) .OR.
414 lrwmin = max( 1, 24*n )
415 liwmin = max( 1, 10*n )
416 lwmin = max( 1, 2*n )
419 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
421 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
423 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
425 ELSE IF( n.LT.0 )
THEN
427 ELSE IF( lda.LT.max( 1, n ) )
THEN
431 IF( n.GT.0 .AND. vu.LE.vl )
433 ELSE IF( indeig )
THEN
434 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
436 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
442 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
448 nb =
ilaenv( 1,
'CHETRD', uplo, n, -1, -1, -1 )
449 nb = max( nb,
ilaenv( 1,
'CUNMTR', uplo, n, -1, -1, -1 ) )
450 lwkopt = max( ( nb+1 )*n, lwmin )
455 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
457 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
459 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
465 CALL
xerbla(
'CHEEVR', -info )
467 ELSE IF( lquery )
THEN
481 IF( alleig .OR. indeig )
THEN
483 w( 1 ) =
REAL( A( 1, 1 ) )
485 IF( vl.LT.
REAL( A( 1, 1 ) ) .AND. vu.GE.
REAL( A( 1, 1 ) ) )
488 w( 1 ) =
REAL( A( 1, 1 ) )
501 safmin =
slamch(
'Safe minimum' )
502 eps =
slamch(
'Precision' )
503 smlnum = safmin / eps
504 bignum = one / smlnum
505 rmin = sqrt( smlnum )
506 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
516 anrm =
clansy(
'M', uplo, n, a, lda, rwork )
517 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
520 ELSE IF( anrm.GT.rmax )
THEN
524 IF( iscale.EQ.1 )
THEN
527 CALL
csscal( n-j+1, sigma, a( j, j ), 1 )
531 CALL
csscal( j, sigma, a( 1, j ), 1 )
535 $ abstll = abstol*sigma
551 llwork = lwork - indwk + 1
568 llrwork = lrwork - indrwk + 1
587 CALL
chetrd( uplo, n, a, lda, rwork( indrd ), rwork( indre ),
588 $ work( indtau ), work( indwk ), llwork, iinfo )
595 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
599 IF( ( alleig.OR.test ) .AND. ( ieeeok.EQ.1 ) )
THEN
600 IF( .NOT.wantz )
THEN
601 CALL
scopy( n, rwork( indrd ), 1, w, 1 )
602 CALL
scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
603 CALL
ssterf( n, w, rwork( indree ), info )
605 CALL
scopy( n-1, rwork( indre ), 1, rwork( indree ), 1 )
606 CALL
scopy( n, rwork( indrd ), 1, rwork( indrdd ), 1 )
608 IF (abstol .LE. two*n*eps)
THEN
613 CALL
cstemr( jobz,
'A', n, rwork( indrdd ),
614 $ rwork( indree ), vl, vu, il, iu, m, w,
615 $ z, ldz, n, isuppz, tryrac,
616 $ rwork( indrwk ), llrwork,
617 $ iwork, liwork, info )
622 IF( wantz .AND. info.EQ.0 )
THEN
624 llwrkn = lwork - indwkn + 1
625 CALL
cunmtr(
'L', uplo,
'N', n, m, a, lda,
626 $ work( indtau ), z, ldz, work( indwkn ),
648 CALL
sstebz( range, order, n, vll, vuu, il, iu, abstll,
649 $ rwork( indrd ), rwork( indre ), m, nsplit, w,
650 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
651 $ iwork( indiwo ), info )
654 CALL
cstein( n, rwork( indrd ), rwork( indre ), m, w,
655 $ iwork( indibl ), iwork( indisp ), z, ldz,
656 $ rwork( indrwk ), iwork( indiwo ), iwork( indifl ),
663 llwrkn = lwork - indwkn + 1
664 CALL
cunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
665 $ ldz, work( indwkn ), llwrkn, iinfo )
671 IF( iscale.EQ.1 )
THEN
677 CALL
sscal( imax, one / sigma, w, 1 )
688 IF( w( jj ).LT.tmp1 )
THEN
695 itmp1 = iwork( indibl+i-1 )
697 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
699 iwork( indibl+j-1 ) = itmp1
700 CALL
cswap( n, z( 1, i ), 1, z( 1, j ), 1 )