305 SUBROUTINE sstevr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
306 $ m, w, z, ldz, isuppz, work, lwork, iwork,
315 CHARACTER JOBZ, RANGE
316 INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
320 INTEGER ISUPPZ( * ), IWORK( * )
321 REAL D( * ), E( * ), W( * ), WORK( * ), Z( ldz, * )
328 parameter ( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
331 LOGICAL ALLEIG, INDEIG, TEST, LQUERY, VALEIG, WANTZ,
334 INTEGER I, IEEEOK, IMAX, INDIBL, INDIFL, INDISP,
335 $ indiwo, iscale, j, jj, liwmin, lwmin, nsplit
336 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
337 $ tmp1, tnrm, vll, vuu
343 EXTERNAL lsame, ilaenv, slamch, slanst
350 INTRINSIC max, min, sqrt
357 ieeeok = ilaenv( 10,
'SSTEVR',
'N', 1, 2, 3, 4 )
359 wantz = lsame( jobz,
'V' )
360 alleig = lsame( range,
'A' )
361 valeig = lsame( range,
'V' )
362 indeig = lsame( range,
'I' )
364 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
365 lwmin = max( 1, 20*n )
366 liwmin = max(1, 10*n )
370 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
372 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
374 ELSE IF( n.LT.0 )
THEN
378 IF( n.GT.0 .AND. vu.LE.vl )
380 ELSE IF( indeig )
THEN
381 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
383 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
389 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
398 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
400 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
406 CALL xerbla(
'SSTEVR', -info )
408 ELSE IF( lquery )
THEN
419 IF( alleig .OR. indeig )
THEN
423 IF( vl.LT.d( 1 ) .AND. vu.GE.d( 1 ) )
THEN
435 safmin = slamch(
'Safe minimum' )
436 eps = slamch(
'Precision' )
437 smlnum = safmin / eps
438 bignum = one / smlnum
439 rmin = sqrt( smlnum )
440 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
451 tnrm = slanst(
'M', n, d, e )
452 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
455 ELSE IF( tnrm.GT.rmax )
THEN
459 IF( iscale.EQ.1 )
THEN
460 CALL sscal( n, sigma, d, 1 )
461 CALL sscal( n-1, sigma, e( 1 ), 1 )
492 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
496 IF( ( alleig .OR. test ) .AND. ieeeok.EQ.1 )
THEN
497 CALL scopy( n-1, e( 1 ), 1, work( 1 ), 1 )
498 IF( .NOT.wantz )
THEN
499 CALL scopy( n, d, 1, w, 1 )
500 CALL ssterf( n, w, work, info )
502 CALL scopy( n, d, 1, work( n+1 ), 1 )
503 IF (abstol .LE. two*n*eps)
THEN
508 CALL sstemr( jobz,
'A', n, work( n+1 ), work, vl, vu, il,
509 $ iu, m, w, z, ldz, n, isuppz, tryrac,
510 $ work( 2*n+1 ), lwork-2*n, iwork, liwork, info )
528 CALL sstebz( range, order, n, vll, vuu, il, iu, abstol, d, e, m,
529 $ nsplit, w, iwork( indibl ), iwork( indisp ), work,
530 $ iwork( indiwo ), info )
533 CALL sstein( n, d, e, m, w, iwork( indibl ), iwork( indisp ),
534 $ z, ldz, work, iwork( indiwo ), iwork( indifl ),
541 IF( iscale.EQ.1 )
THEN
547 CALL sscal( imax, one / sigma, w, 1 )
558 IF( w( jj ).LT.tmp1 )
THEN
567 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine sstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEMR
subroutine sstevr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY