225 SUBROUTINE dstevx( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
226 $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
233 CHARACTER JOBZ, RANGE
234 INTEGER IL, INFO, IU, LDZ, M, N
235 DOUBLE PRECISION ABSTOL, VL, VU
238 INTEGER IFAIL( * ), IWORK( * )
239 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( ldz, * )
245 DOUBLE PRECISION ZERO, ONE
246 parameter( zero = 0.0d0, one = 1.0d0 )
249 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
251 INTEGER I, IMAX, INDIBL, INDISP, INDIWO, INDWRK,
252 $ iscale, itmp1, j, jj, nsplit
253 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
254 $ tmp1, tnrm, vll, vuu
258 DOUBLE PRECISION DLAMCH, DLANST
259 EXTERNAL lsame, dlamch, dlanst
266 INTRINSIC max, min, sqrt
272 wantz = lsame( jobz,
'V' )
273 alleig = lsame( range,
'A' )
274 valeig = lsame( range,
'V' )
275 indeig = lsame( range,
'I' )
278 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN 280 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN 282 ELSE IF( n.LT.0 )
THEN 286 IF( n.GT.0 .AND. vu.LE.vl )
288 ELSE IF( indeig )
THEN 289 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN 291 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN 297 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
302 CALL xerbla(
'DSTEVX', -info )
313 IF( alleig .OR. indeig )
THEN 317 IF( vl.LT.d( 1 ) .AND. vu.GE.d( 1 ) )
THEN 329 safmin = dlamch(
'Safe minimum' )
330 eps = dlamch(
'Precision' )
331 smlnum = safmin / eps
332 bignum = one / smlnum
333 rmin = sqrt( smlnum )
334 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
346 tnrm = dlanst(
'M', n, d, e )
347 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN 350 ELSE IF( tnrm.GT.rmax )
THEN 354 IF( iscale.EQ.1 )
THEN 355 CALL dscal( n, sigma, d, 1 )
356 CALL dscal( n-1, sigma, e( 1 ), 1 )
369 IF( il.EQ.1 .AND. iu.EQ.n )
THEN 373 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN 374 CALL dcopy( n, d, 1, w, 1 )
375 CALL dcopy( n-1, e( 1 ), 1, work( 1 ), 1 )
377 IF( .NOT.wantz )
THEN 378 CALL dsterf( n, w, work, info )
380 CALL dsteqr(
'I', n, w, work, z, ldz, work( indwrk ), info )
405 CALL dstebz( range, order, n, vll, vuu, il, iu, abstol, d, e, m,
406 $ nsplit, w, iwork( indibl ), iwork( indisp ),
407 $ work( indwrk ), iwork( indiwo ), info )
410 CALL dstein( n, d, e, m, w, iwork( indibl ), iwork( indisp ),
411 $ z, ldz, work( indwrk ), iwork( indiwo ), ifail,
418 IF( iscale.EQ.1 )
THEN 424 CALL dscal( imax, one / sigma, w, 1 )
435 IF( w( jj ).LT.tmp1 )
THEN 442 itmp1 = iwork( indibl+i-1 )
444 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
446 iwork( indibl+j-1 ) = itmp1
447 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
450 ifail( i ) = ifail( j )
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
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 dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR