131 SUBROUTINE sspev( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO )
143 REAL ap( * ), w( * ), work( * ), z( ldz, * )
150 parameter( zero = 0.0e0, one = 1.0e0 )
154 INTEGER iinfo, imax, inde, indtau, indwrk, iscale
155 REAL anrm, bignum, eps, rmax, rmin, safmin, sigma,
173 wantz =
lsame( jobz,
'V' )
176 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
178 ELSE IF( .NOT.(
lsame( uplo,
'U' ) .OR.
lsame( uplo,
'L' ) ) )
181 ELSE IF( n.LT.0 )
THEN
183 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
188 CALL
xerbla(
'SSPEV ', -info )
206 safmin =
slamch(
'Safe minimum' )
207 eps =
slamch(
'Precision' )
208 smlnum = safmin / eps
209 bignum = one / smlnum
210 rmin = sqrt( smlnum )
211 rmax = sqrt( bignum )
215 anrm =
slansp(
'M', uplo, n, ap, work )
217 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
220 ELSE IF( anrm.GT.rmax )
THEN
224 IF( iscale.EQ.1 )
THEN
225 CALL
sscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
232 CALL
ssptrd( uplo, n, ap, w, work( inde ), work( indtau ), iinfo )
237 IF( .NOT.wantz )
THEN
238 CALL
ssterf( n, w, work( inde ), info )
241 CALL
sopgtr( uplo, n, ap, work( indtau ), z, ldz,
242 $ work( indwrk ), iinfo )
243 CALL
ssteqr( jobz, n, w, work( inde ), z, ldz, work( indtau ),
249 IF( iscale.EQ.1 )
THEN
255 CALL
sscal( imax, one / sigma, w, 1 )
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.
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
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine sspev(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, INFO)
SSPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
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