226 SUBROUTINE sspevx( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
227 $ abstol, m, w, z, ldz, work, iwork, ifail,
236 CHARACTER JOBZ, RANGE, UPLO
237 INTEGER IL, INFO, IU, LDZ, M, N
241 INTEGER IFAIL( * ), IWORK( * )
242 REAL AP( * ), W( * ), WORK( * ), Z( ldz, * )
249 parameter( zero = 0.0e0, one = 1.0e0 )
252 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
254 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
255 $ indisp, indiwo, indtau, indwrk, iscale, itmp1,
257 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
258 $ sigma, smlnum, tmp1, vll, vuu
263 EXTERNAL lsame, slamch, slansp
270 INTRINSIC max, min, sqrt
276 wantz = lsame( jobz,
'V' )
277 alleig = lsame( range,
'A' )
278 valeig = lsame( range,
'V' )
279 indeig = lsame( range,
'I' )
282 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
284 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
286 ELSE IF( .NOT.( lsame( uplo,
'L' ) .OR. lsame( uplo,
'U' ) ) )
289 ELSE IF( n.LT.0 )
THEN
293 IF( n.GT.0 .AND. vu.LE.vl )
295 ELSE IF( indeig )
THEN
296 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
298 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
304 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
309 CALL xerbla(
'SSPEVX', -info )
320 IF( alleig .OR. indeig )
THEN
324 IF( vl.LT.ap( 1 ) .AND. vu.GE.ap( 1 ) )
THEN
336 safmin = slamch(
'Safe minimum' )
337 eps = slamch(
'Precision' )
338 smlnum = safmin / eps
339 bignum = one / smlnum
340 rmin = sqrt( smlnum )
341 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
354 anrm = slansp(
'M', uplo, n, ap, work )
355 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
358 ELSE IF( anrm.GT.rmax )
THEN
362 IF( iscale.EQ.1 )
THEN
363 CALL sscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
365 $ abstll = abstol*sigma
378 CALL ssptrd( uplo, n, ap, work( indd ), work( inde ),
379 $ work( indtau ), iinfo )
387 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
391 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
392 CALL scopy( n, work( indd ), 1, w, 1 )
394 IF( .NOT.wantz )
THEN
395 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
396 CALL ssterf( n, w, work( indee ), info )
398 CALL sopgtr( uplo, n, ap, work( indtau ), z, ldz,
399 $ work( indwrk ), iinfo )
400 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
401 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
402 $ work( indwrk ), info )
426 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
427 $ work( indd ), work( inde ), m, nsplit, w,
428 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
429 $ iwork( indiwo ), info )
432 CALL sstein( n, work( indd ), work( inde ), m, w,
433 $ iwork( indibl ), iwork( indisp ), z, ldz,
434 $ work( indwrk ), iwork( indiwo ), ifail, info )
439 CALL sopmtr(
'L', uplo,
'N', n, m, ap, work( indtau ), z, ldz,
440 $ work( indwrk ), iinfo )
446 IF( iscale.EQ.1 )
THEN
452 CALL sscal( imax, one / sigma, w, 1 )
463 IF( w( jj ).LT.tmp1 )
THEN
470 itmp1 = iwork( indibl+i-1 )
472 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
474 iwork( indibl+j-1 ) = itmp1
475 CALL sswap( n, z( 1, i ), 1, z( 1, j ), 1 )
478 ifail( i ) = ifail( j )
subroutine sopmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
SOPMTR
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine ssptrd(UPLO, N, AP, D, E, TAU, INFO)
SSPTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sopgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
SOPGTR
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
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 sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
subroutine sscal(N, SA, SX, INCX)
SSCAL