227 SUBROUTINE dstevx( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
228 $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
236 CHARACTER JOBZ, RANGE
237 INTEGER IL, INFO, IU, LDZ, M, N
238 DOUBLE PRECISION ABSTOL, VL, VU
241 INTEGER IFAIL( * ), IWORK( * )
242 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( ldz, * )
248 DOUBLE PRECISION ZERO, ONE
249 parameter( zero = 0.0d0, one = 1.0d0 )
252 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
254 INTEGER I, IMAX, INDIBL, INDISP, INDIWO, INDWRK,
255 $ iscale, itmp1, j, jj, nsplit
256 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
257 $ tmp1, tnrm, vll, vuu
261 DOUBLE PRECISION DLAMCH, DLANST
262 EXTERNAL lsame, dlamch, dlanst
269 INTRINSIC max, min, sqrt
275 wantz = lsame( jobz,
'V' )
276 alleig = lsame( range,
'A' )
277 valeig = lsame( range,
'V' )
278 indeig = lsame( range,
'I' )
281 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN 283 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN 285 ELSE IF( n.LT.0 )
THEN 289 IF( n.GT.0 .AND. vu.LE.vl )
291 ELSE IF( indeig )
THEN 292 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN 294 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN 300 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
305 CALL xerbla(
'DSTEVX', -info )
316 IF( alleig .OR. indeig )
THEN 320 IF( vl.LT.d( 1 ) .AND. vu.GE.d( 1 ) )
THEN 332 safmin = dlamch(
'Safe minimum' )
333 eps = dlamch(
'Precision' )
334 smlnum = safmin / eps
335 bignum = one / smlnum
336 rmin = sqrt( smlnum )
337 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
349 tnrm = dlanst(
'M', n, d, e )
350 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN 353 ELSE IF( tnrm.GT.rmax )
THEN 357 IF( iscale.EQ.1 )
THEN 358 CALL dscal( n, sigma, d, 1 )
359 CALL dscal( n-1, sigma, e( 1 ), 1 )
372 IF( il.EQ.1 .AND. iu.EQ.n )
THEN 376 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN 377 CALL dcopy( n, d, 1, w, 1 )
378 CALL dcopy( n-1, e( 1 ), 1, work( 1 ), 1 )
380 IF( .NOT.wantz )
THEN 381 CALL dsterf( n, w, work, info )
383 CALL dsteqr(
'I', n, w, work, z, ldz, work( indwrk ), info )
408 CALL dstebz( range, order, n, vll, vuu, il, iu, abstol, d, e, m,
409 $ nsplit, w, iwork( indibl ), iwork( indisp ),
410 $ work( indwrk ), iwork( indiwo ), info )
413 CALL dstein( n, d, e, m, w, iwork( indibl ), iwork( indisp ),
414 $ z, ldz, work( indwrk ), iwork( indiwo ), ifail,
421 IF( iscale.EQ.1 )
THEN 427 CALL dscal( imax, one / sigma, w, 1 )
438 IF( w( jj ).LT.tmp1 )
THEN 445 itmp1 = iwork( indibl+i-1 )
447 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
449 iwork( indibl+j-1 ) = itmp1
450 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
453 ifail( i ) = ifail( j )
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dstevx(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ