223 SUBROUTINE sstevx( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
225 $ M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO )
232 CHARACTER JOBZ, RANGE
233 INTEGER IL, INFO, IU, LDZ, M, N
237 INTEGER IFAIL( * ), IWORK( * )
238 REAL D( * ), E( * ), W( * ), WORK( * ), Z( LDZ, * )
245 PARAMETER ( ZERO = 0.0e0, one = 1.0e0 )
248 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
250 INTEGER I, IMAX, INDISP, INDIWO, INDWRK,
251 $ iscale, itmp1, j, jj, nsplit
252 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
253 $ TMP1, TNRM, VLL, VUU
258 EXTERNAL lsame, slamch, slanst
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(
'SSTEVX', -info )
313 IF( alleig .OR. indeig )
THEN
317 IF( vl.LT.d( 1 ) .AND. vu.GE.d( 1 ) )
THEN
329 safmin = slamch(
'Safe minimum' )
330 eps = slamch(
'Precision' )
331 smlnum = safmin / eps
332 bignum = one / smlnum
333 rmin = sqrt( smlnum )
334 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
346 tnrm = slanst(
'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 sscal( n, sigma, d, 1 )
356 CALL sscal( 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 scopy( n, d, 1, w, 1 )
375 CALL scopy( n-1, e( 1 ), 1, work( 1 ), 1 )
377 IF( .NOT.wantz )
THEN
378 CALL ssterf( n, w, work, info )
380 CALL ssteqr(
'I', n, w, work, z, ldz, work( indwrk ),
405 CALL sstebz( range, order, n, vll, vuu, il, iu, abstol, d, e,
407 $ nsplit, w, iwork( 1 ), iwork( indisp ),
408 $ work( indwrk ), iwork( indiwo ), info )
411 CALL sstein( n, d, e, m, w, iwork( 1 ), iwork( indisp ),
412 $ z, ldz, work( indwrk ), iwork( indiwo ), ifail,
419 IF( iscale.EQ.1 )
THEN
425 CALL sscal( imax, one / sigma, w, 1 )
436 IF( w( jj ).LT.tmp1 )
THEN
443 itmp1 = iwork( 1 + i-1 )
445 iwork( 1 + i-1 ) = iwork( 1 + j-1 )
447 iwork( 1 + j-1 ) = itmp1
448 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
451 ifail( i ) = ifail( j )
subroutine sstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
SSTEBZ
subroutine sstevx(jobz, range, n, d, e, vl, vu, il, iu, abstol, m, w, z, ldz, work, iwork, ifail, info)
SSTEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...