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
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
REAL function slansp(NORM, UPLO, N, AP, WORK)
SLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
LOGICAL function lsame(CA, CB)
LSAME
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
REAL function slamch(CMACH)
SLAMCH
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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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