298 SUBROUTINE sstevr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
299 $ m, w, z, ldz, isuppz, work, lwork, iwork,
308 CHARACTER JOBZ, RANGE
309 INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
313 INTEGER ISUPPZ( * ), IWORK( * )
314 REAL D( * ), E( * ), W( * ), WORK( * ), Z( ldz, * )
321 parameter( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
324 LOGICAL ALLEIG, INDEIG, TEST, LQUERY, VALEIG, WANTZ,
327 INTEGER I, IEEEOK, IMAX, INDIBL, INDIFL, INDISP,
328 $ indiwo, iscale, j, jj, liwmin, lwmin, nsplit
329 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
330 $ tmp1, tnrm, vll, vuu
336 EXTERNAL lsame, ilaenv, slamch, slanst
343 INTRINSIC max, min, sqrt
350 ieeeok = ilaenv( 10,
'SSTEVR',
'N', 1, 2, 3, 4 )
352 wantz = lsame( jobz,
'V' )
353 alleig = lsame( range,
'A' )
354 valeig = lsame( range,
'V' )
355 indeig = lsame( range,
'I' )
357 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
358 lwmin = max( 1, 20*n )
359 liwmin = max(1, 10*n )
363 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
365 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
367 ELSE IF( n.LT.0 )
THEN
371 IF( n.GT.0 .AND. vu.LE.vl )
373 ELSE IF( indeig )
THEN
374 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
376 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
382 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
391 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
393 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
399 CALL
xerbla(
'SSTEVR', -info )
401 ELSE IF( lquery )
THEN
412 IF( alleig .OR. indeig )
THEN
416 IF( vl.LT.d( 1 ) .AND. vu.GE.d( 1 ) )
THEN
428 safmin = slamch(
'Safe minimum' )
429 eps = slamch(
'Precision' )
430 smlnum = safmin / eps
431 bignum = one / smlnum
432 rmin = sqrt( smlnum )
433 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
442 tnrm = slanst(
'M', n, d, e )
443 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
446 ELSE IF( tnrm.GT.rmax )
THEN
450 IF( iscale.EQ.1 )
THEN
451 CALL
sscal( n, sigma, d, 1 )
452 CALL
sscal( n-1, sigma, e( 1 ), 1 )
483 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
487 IF( ( alleig .OR. test ) .AND. ieeeok.EQ.1 )
THEN
488 CALL
scopy( n-1, e( 1 ), 1, work( 1 ), 1 )
489 IF( .NOT.wantz )
THEN
490 CALL
scopy( n, d, 1, w, 1 )
491 CALL
ssterf( n, w, work, info )
493 CALL
scopy( n, d, 1, work( n+1 ), 1 )
494 IF (abstol .LE. two*n*eps)
THEN
499 CALL
sstemr( jobz,
'A', n, work( n+1 ), work, vl, vu, il,
500 $ iu, m, w, z, ldz, n, isuppz, tryrac,
501 $ work( 2*n+1 ), lwork-2*n, iwork, liwork, info )
519 CALL
sstebz( range, order, n, vll, vuu, il, iu, abstol, d, e, m,
520 $ nsplit, w, iwork( indibl ), iwork( indisp ), work,
521 $ iwork( indiwo ), info )
524 CALL
sstein( n, d, e, m, w, iwork( indibl ), iwork( indisp ),
525 $ z, ldz, work, iwork( indiwo ), iwork( indifl ),
532 IF( iscale.EQ.1 )
THEN
538 CALL
sscal( imax, one / sigma, w, 1 )
549 IF( w( jj ).LT.tmp1 )
THEN
558 CALL
sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
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 xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
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 ssterf(N, D, E, INFO)
SSTERF
subroutine sscal(N, SA, SX, INCX)
SSCAL