301 SUBROUTINE dstevr( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
302 $ M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK,
310 CHARACTER JOBZ, RANGE
311 INTEGER IL, INFO, IU, LDZ, LIWORK, LWORK, M, N
312 DOUBLE PRECISION ABSTOL, VL, VU
315 INTEGER ISUPPZ( * ), IWORK( * )
316 DOUBLE PRECISION D( * ), E( * ), W( * ), ( * ), Z( LDZ, * )
322 DOUBLE PRECISION ZERO, ONE, TWO
323 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0, two = 2.0d+0 )
326 LOGICAL ALLEIG, INDEIG, TEST, LQUERY, VALEIG, WANTZ,
329 INTEGER I, IEEEOK, IMAX, INDIBL, INDIFL, INDISP,
330 $ indiwo, iscale, itmp1, j, jj, liwmin, lwmin,
332 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
333 $ TMP1, TNRM, VLL, VUU
338 DOUBLE PRECISION DLAMCH, DLANST
339 EXTERNAL lsame, ilaenv, dlamch, dlanst
353 ieeeok = ilaenv( 10,
'DSTEVR',
'N', 1, 2, 3, 4 )
355 wantz = lsame( jobz, 'v
' )
356 ALLEIG = LSAME( RANGE, 'a
' )
357 VALEIG = LSAME( RANGE, 'v
' )
358 INDEIG = LSAME( RANGE, 'i
' )
360.EQ..OR..EQ.
LQUERY = ( ( LWORK-1 ) ( LIWORK-1 ) )
361 LWMIN = MAX( 1, 20*N )
362 LIWMIN = MAX( 1, 10*N )
366.NOT..OR.
IF( ( WANTZ LSAME( JOBZ, 'n
' ) ) ) THEN
368.NOT..OR..OR.
ELSE IF( ( ALLEIG VALEIG INDEIG ) ) THEN
370.LT.
ELSE IF( N0 ) THEN
374.GT..AND..LE.
IF( N0 VUVL )
376 ELSE IF( INDEIG ) THEN
377.LT..OR..GT.
IF( IL1 ILMAX( 1, N ) ) THEN
379.LT..OR..GT.
ELSE IF( IUMIN( N, IL ) IUN ) THEN
385.LT..OR..AND..LT.
IF( LDZ1 ( WANTZ LDZN ) ) THEN
394.LT..AND..NOT.
IF( LWORKLWMIN LQUERY ) THEN
396.LT..AND..NOT.
ELSE IF( LIWORKLIWMIN LQUERY ) THEN
402 CALL XERBLA( 'dstevr', -INFO )
404 ELSE IF( LQUERY ) THEN
415.OR.
IF( ALLEIG INDEIG ) THEN
419.LT..AND..GE.
IF( VLD( 1 ) VUD( 1 ) ) THEN
431 SAFMIN = DLAMCH( 'safe minimum
' )
432 EPS = DLAMCH( 'precision
' )
433 SMLNUM = SAFMIN / EPS
434 BIGNUM = ONE / SMLNUM
435 RMIN = SQRT( SMLNUM )
436 RMAX = MIN( SQRT( BIGNUM ), ONE / SQRT( SQRT( SAFMIN ) ) )
447 TNRM = DLANST( 'm
', N, D, E )
448.GT..AND..LT.
IF( TNRMZERO TNRMRMIN ) THEN
451.GT.
ELSE IF( TNRMRMAX ) THEN
455.EQ.
IF( ISCALE1 ) THEN
456 CALL DSCAL( N, SIGMA, D, 1 )
457 CALL DSCAL( N-1, SIGMA, E( 1 ), 1 )
488.EQ..AND..EQ.
IF( IL1 IUN ) THEN
492.OR..AND..EQ.
IF( ( ALLEIG TEST ) IEEEOK1 ) THEN
493 CALL DCOPY( N-1, E( 1 ), 1, WORK( 1 ), 1 )
494.NOT.
IF( WANTZ ) THEN
495 CALL DCOPY( N, D, 1, W, 1 )
496 CALL DSTERF( N, W, WORK, INFO )
498 CALL DCOPY( N, D, 1, WORK( N+1 ), 1 )
499.LE.
IF (ABSTOL TWO*N*EPS) THEN
504 CALL DSTEMR( JOBZ, 'a
', N, WORK( N+1 ), WORK, VL, VU, IL,
505 $ IU, M, W, Z, LDZ, N, ISUPPZ, TRYRAC,
506 $ WORK( 2*N+1 ), LWORK-2*N, IWORK, LIWORK, INFO )
524 CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M,
525 $ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ), WORK,
526 $ IWORK( INDIWO ), INFO )
529 CALL DSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ),
530 $ Z, LDZ, WORK, IWORK( INDIWO ), IWORK( INDIFL ),
537.EQ.
IF( ISCALE1 ) THEN
543 CALL DSCAL( IMAX, ONE / SIGMA, W, 1 )
554.LT.
IF( W( JJ )TMP1 ) THEN
563 IWORK( I ) = IWORK( J )
566 CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
subroutine dstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
DSTEBZ
subroutine dsterf(n, d, e, info)
DSTERF
subroutine xerbla(srname, info)
XERBLA
subroutine dstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
DSTEIN
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 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 matrice...
subroutine dscal(n, da, dx, incx)
DSCAL
subroutine dswap(n, dx, incx, dy, incy)
DSWAP
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY