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
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 )