296 SUBROUTINE dstevr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
297 $ m, w, z, ldz, isuppz, work, lwork, iwork,
306 CHARACTER JOBZ, RANGE
307 INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
308 DOUBLE PRECISION ABSTOL, VL, VU
311 INTEGER ISUPPZ( * ), IWORK( * )
312 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( ldz, * )
318 DOUBLE PRECISION ZERO, ONE, TWO
319 parameter( zero = 0.0d+0, one = 1.0d+0, two = 2.0d+0 )
322 LOGICAL ALLEIG, INDEIG, TEST, LQUERY, VALEIG, WANTZ,
325 INTEGER I, IEEEOK, IMAX, INDIBL, INDIFL, INDISP,
326 $ indiwo, iscale, itmp1, j, jj, liwmin, lwmin,
328 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
329 $ tmp1, tnrm, vll, vuu
334 DOUBLE PRECISION DLAMCH, DLANST
335 EXTERNAL lsame, ilaenv, dlamch, dlanst
342 INTRINSIC max, min, sqrt
349 ieeeok = ilaenv( 10,
'DSTEVR',
'N', 1, 2, 3, 4 )
351 wantz = lsame( jobz,
'V' )
352 alleig = lsame( range,
'A' )
353 valeig = lsame( range,
'V' )
354 indeig = lsame( range,
'I' )
356 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
357 lwmin = max( 1, 20*n )
358 liwmin = max( 1, 10*n )
362 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
364 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
366 ELSE IF( n.LT.0 )
THEN
370 IF( n.GT.0 .AND. vu.LE.vl )
372 ELSE IF( indeig )
THEN
373 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
375 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
381 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
390 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
392 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
398 CALL
xerbla(
'DSTEVR', -info )
400 ELSE IF( lquery )
THEN
411 IF( alleig .OR. indeig )
THEN
415 IF( vl.LT.d( 1 ) .AND. vu.GE.d( 1 ) )
THEN
427 safmin = dlamch(
'Safe minimum' )
428 eps = dlamch(
'Precision' )
429 smlnum = safmin / eps
430 bignum = one / smlnum
431 rmin = sqrt( smlnum )
432 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
441 tnrm = dlanst(
'M', n, d, e )
442 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
445 ELSE IF( tnrm.GT.rmax )
THEN
449 IF( iscale.EQ.1 )
THEN
450 CALL
dscal( n, sigma, d, 1 )
451 CALL
dscal( n-1, sigma, e( 1 ), 1 )
482 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
486 IF( ( alleig .OR. test ) .AND. ieeeok.EQ.1 )
THEN
487 CALL
dcopy( n-1, e( 1 ), 1, work( 1 ), 1 )
488 IF( .NOT.wantz )
THEN
489 CALL
dcopy( n, d, 1, w, 1 )
490 CALL
dsterf( n, w, work, info )
492 CALL
dcopy( n, d, 1, work( n+1 ), 1 )
493 IF (abstol .LE. two*n*eps)
THEN
498 CALL
dstemr( jobz,
'A', n, work( n+1 ), work, vl, vu, il,
499 $ iu, m, w, z, ldz, n, isuppz, tryrac,
500 $ work( 2*n+1 ), lwork-2*n, iwork, liwork, info )
518 CALL
dstebz( range, order, n, vll, vuu, il, iu, abstol, d, e, m,
519 $ nsplit, w, iwork( indibl ), iwork( indisp ), work,
520 $ iwork( indiwo ), info )
523 CALL
dstein( n, d, e, m, w, iwork( indibl ), iwork( indisp ),
524 $ z, ldz, work, iwork( indiwo ), iwork( indifl ),
531 IF( iscale.EQ.1 )
THEN
537 CALL
dscal( imax, one / sigma, w, 1 )
548 IF( w( jj ).LT.tmp1 )
THEN
557 iwork( i ) = iwork( j )
560 CALL
dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dstevr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEMR
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ