220 SUBROUTINE dstevx( JOBZ, RANGE, N, D, E, VL, VU, IL, IU, ABSTOL,
221 $ m, w, z, ldz, work, iwork, ifail, info )
229 CHARACTER JOBZ, RANGE
230 INTEGER IL, INFO, IU, LDZ, M, N
231 DOUBLE PRECISION ABSTOL, VL, VU
234 INTEGER IFAIL( * ), IWORK( * )
235 DOUBLE PRECISION D( * ), E( * ), W( * ), WORK( * ), Z( ldz, * )
241 DOUBLE PRECISION ZERO, ONE
242 parameter( zero = 0.0d0, one = 1.0d0 )
245 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
247 INTEGER I, IMAX, INDIBL, INDISP, INDIWO, INDWRK,
248 $ iscale, itmp1, j, jj, nsplit
249 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
250 $ tmp1, tnrm, vll, vuu
254 DOUBLE PRECISION DLAMCH, DLANST
255 EXTERNAL lsame, dlamch, dlanst
262 INTRINSIC max, min, sqrt
268 wantz = lsame( jobz,
'V' )
269 alleig = lsame( range,
'A' )
270 valeig = lsame( range,
'V' )
271 indeig = lsame( range,
'I' )
274 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
276 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
278 ELSE IF( n.LT.0 )
THEN
282 IF( n.GT.0 .AND. vu.LE.vl )
284 ELSE IF( indeig )
THEN
285 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
287 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
293 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
298 CALL xerbla(
'DSTEVX', -info )
309 IF( alleig .OR. indeig )
THEN
313 IF( vl.LT.d( 1 ) .AND. vu.GE.d( 1 ) )
THEN
325 safmin = dlamch(
'Safe minimum' )
326 eps = dlamch(
'Precision' )
327 smlnum = safmin / eps
328 bignum = one / smlnum
329 rmin = sqrt( smlnum )
330 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
342 tnrm = dlanst(
'M', n, d, e )
343 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
346 ELSE IF( tnrm.GT.rmax )
THEN
350 IF( iscale.EQ.1 )
THEN
351 CALL dscal( n, sigma, d, 1 )
352 CALL dscal( n-1, sigma, e( 1 ), 1 )
365 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
369 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
370 CALL dcopy( n, d, 1, w, 1 )
371 CALL dcopy( n-1, e( 1 ), 1, work( 1 ), 1 )
373 IF( .NOT.wantz )
THEN
374 CALL dsterf( n, w, work, info )
376 CALL dsteqr(
'I', n, w, work, z, ldz, work( indwrk ), info )
401 CALL dstebz( range, order, n, vll, vuu, il, iu, abstol, d, e, m,
402 $ nsplit, w, iwork( indibl ), iwork( indisp ),
403 $ work( indwrk ), iwork( indiwo ), info )
406 CALL dstein( n, d, e, m, w, iwork( indibl ), iwork( indisp ),
407 $ z, ldz, work( indwrk ), iwork( indiwo ), ifail,
414 IF( iscale.EQ.1 )
THEN
420 CALL dscal( imax, one / sigma, w, 1 )
431 IF( w( jj ).LT.tmp1 )
THEN
438 itmp1 = iwork( indibl+i-1 )
440 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
442 iwork( indibl+j-1 ) = itmp1
443 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
446 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 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 dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
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