1 SUBROUTINE sstegr2a( JOBZ, RANGE, N, D, E, VL, VU, IL, IU,
2 $ M, W, Z, LDZ, NZC, WORK, LWORK, IWORK,
3 $ LIWORK, DOL, DOU, NEEDIL, NEEDIU,
4 $ INDERR, NSPLIT, PIVMIN, SCALE, WL, WU,
15 INTEGER DOL, DOU, IL, INDERR, INFO, IU, LDZ, LIWORK,
16 $ LWORK, M, N, NEEDIL, NEEDIU, NSPLIT, NZC
17 REAL PIVMIN, SCALE, VL, VU, WL, WU
22 REAL D( * ), E( * ), W( * ), WORK( * )
216 REAL ZERO, ONE, FOUR, MINRGP
217 PARAMETER ( ZERO = 0.0e0, one = 1.0e0,
222 LOGICAL ALLEIG, INDEIG, LQUERY, VALEIG, WANTZ, ZQUERY
223 INTEGER IIL, IINDBL, IINDW, IINDWK, IINFO, IINSPL, IIU,
224 $ INDE2, INDGP, INDGRS, INDSDM, INDWRK, ITMP,
225 $ ITMP2, J, LIWMIN, LWMIN, NZCMIN
226 REAL BIGNUM, EPS, RMAX, RMIN, RTOL1, RTOL2, SAFMIN,
227 $ smlnum, thresh, tnrm
232 EXTERNAL LSAME, SLAMCH, SLANST
238 INTRINSIC max,
min, real, sqrt
244 wantz = lsame( jobz,
'V' )
245 alleig = lsame( range,
'A' )
246 valeig = lsame( range,
'V' )
247 indeig = lsame( range,
'I' )
249 lquery = ( ( lwork.EQ.-1 ).OR.( liwork.EQ.-1 ) )
250 zquery = ( nzc.EQ.-1 )
277 ELSEIF( indeig )
THEN
284 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
286 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
288 ELSE IF( n.LT.0 )
THEN
290 ELSE IF( valeig .AND. n.GT.0 .AND. wu.LE.wl )
THEN
292 ELSE IF( indeig .AND. ( iil.LT.1 .OR. iil.GT.n ) )
THEN
294 ELSE IF( indeig .AND. ( iiu.LT.iil .OR. iiu.GT.n ) )
THEN
296 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
298 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
300 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
306 safmin = slamch(
'Safe minimum' )
307 eps = slamch(
'Precision' )
308 smlnum = safmin / eps
309 bignum = one / smlnum
310 rmin = sqrt( smlnum )
311 rmax =
min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
317 IF( wantz .AND. alleig )
THEN
321 ELSE IF( wantz .AND. valeig )
THEN
322 CALL slarrc(
'T', n, vl, vu, d, e, safmin,
323 $ nzcmin, itmp, itmp2, info )
326 ELSE IF( wantz .AND. indeig )
THEN
332 IF( zquery .AND. info.EQ.0 )
THEN
334 ELSE IF( nzc.LT.nzcmin .AND. .NOT.zquery )
THEN
340 IF ( dol.LT.1 .OR. dol.GT.nzcmin )
THEN
343 IF ( dou.LT.1 .OR. dou.GT.nzcmin .OR. dou.LT.dol)
THEN
355 ELSE IF( lquery .OR. zquery )
THEN
370 IF( alleig .OR. indeig )
THEN
374 IF( wl.LT.d( 1 ) .AND. wu.GE.d( 1 ) )
THEN
399 tnrm = slanst(
'M', n, d, e )
400 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
402 ELSE IF( tnrm.GT.rmax )
THEN
405 IF( scale.NE.one )
THEN
406 CALL sscal( n, scale, d, 1 )
407 CALL sscal( n-1, scale, e, 1 )
428 work( inde2+j-1 ) = e(j)**2
432 IF( .NOT.wantz )
THEN
440 rtol1 = four*sqrt(eps)
441 rtol2 =
max( sqrt(eps)*5.0e-3, four * eps )
443 CALL slarre2a( range, n, wl, wu, iil, iiu, d, e,
444 $ work(inde2), rtol1, rtol2, thresh, nsplit,
445 $ iwork( iinspl ), m, dol, dou, needil, neediu,
447 $ work( indgp ), iwork( iindbl ),
448 $ iwork( iindw ), work( indgrs ),
449 $ work( indsdm ), pivmin,
450 $ work( indwrk ), iwork( iindwk ),
452 IF( iinfo.NE.0 )
THEN
453 info = 100 + abs( iinfo )