233 SUBROUTINE sspevx( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
234 $ abstol, m, w, z, ldz, work, iwork, ifail,
243 CHARACTER JOBZ, RANGE, UPLO
244 INTEGER IL, INFO, IU, LDZ, M, N
248 INTEGER IFAIL( * ), IWORK( * )
249 REAL AP( * ), W( * ), WORK( * ), Z( ldz, * )
256 parameter ( zero = 0.0e0, one = 1.0e0 )
259 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
261 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
262 $ indisp, indiwo, indtau, indwrk, iscale, itmp1,
264 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
265 $ sigma, smlnum, tmp1, vll, vuu
270 EXTERNAL lsame, slamch, slansp
277 INTRINSIC max, min, sqrt
283 wantz = lsame( jobz,
'V' )
284 alleig = lsame( range,
'A' )
285 valeig = lsame( range,
'V' )
286 indeig = lsame( range,
'I' )
289 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
291 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
293 ELSE IF( .NOT.( lsame( uplo,
'L' ) .OR. lsame( uplo,
'U' ) ) )
296 ELSE IF( n.LT.0 )
THEN
300 IF( n.GT.0 .AND. vu.LE.vl )
302 ELSE IF( indeig )
THEN
303 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
305 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
311 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
316 CALL xerbla(
'SSPEVX', -info )
327 IF( alleig .OR. indeig )
THEN
331 IF( vl.LT.ap( 1 ) .AND. vu.GE.ap( 1 ) )
THEN
343 safmin = slamch(
'Safe minimum' )
344 eps = slamch(
'Precision' )
345 smlnum = safmin / eps
346 bignum = one / smlnum
347 rmin = sqrt( smlnum )
348 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
361 anrm = slansp(
'M', uplo, n, ap, work )
362 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
365 ELSE IF( anrm.GT.rmax )
THEN
369 IF( iscale.EQ.1 )
THEN
370 CALL sscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
372 $ abstll = abstol*sigma
385 CALL ssptrd( uplo, n, ap, work( indd ), work( inde ),
386 $ work( indtau ), iinfo )
394 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
398 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
399 CALL scopy( n, work( indd ), 1, w, 1 )
401 IF( .NOT.wantz )
THEN
402 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
403 CALL ssterf( n, w, work( indee ), info )
405 CALL sopgtr( uplo, n, ap, work( indtau ), z, ldz,
406 $ work( indwrk ), iinfo )
407 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
408 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
409 $ work( indwrk ), info )
433 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
434 $ work( indd ), work( inde ), m, nsplit, w,
435 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
436 $ iwork( indiwo ), info )
439 CALL sstein( n, work( indd ), work( inde ), m, w,
440 $ iwork( indibl ), iwork( indisp ), z, ldz,
441 $ work( indwrk ), iwork( indiwo ), ifail, info )
446 CALL sopmtr(
'L', uplo,
'N', n, m, ap, work( indtau ), z, ldz,
447 $ work( indwrk ), iinfo )
453 IF( iscale.EQ.1 )
THEN
459 CALL sscal( imax, one / sigma, w, 1 )
470 IF( w( jj ).LT.tmp1 )
THEN
477 itmp1 = iwork( indibl+i-1 )
479 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
481 iwork( indibl+j-1 ) = itmp1
482 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
485 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 sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sopgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
SOPGTR
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
subroutine sopmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
SOPMTR
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssptrd(UPLO, N, AP, D, E, TAU, INFO)
SSPTRD
subroutine sspevx(JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY