131 SUBROUTINE ssyev( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
142 REAL A( LDA, * ), W( * ), WORK( * )
149 parameter( zero = 0.0e0, one = 1.0e0 )
152 LOGICAL LOWER, LQUERY, WANTZ
153 INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
155 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, ,
175 wantz =
lsame( jobz,
'V' )
176 lower =
lsame( uplo,
'L' )
177 lquery = ( lwork.EQ.-1 )
180 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
182 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
184 ELSE IF( n.LT.0 )
THEN
186 ELSE IF( lda.LT.
max( 1, n ) )
THEN
191 nb =
ilaenv( 1,
'SSYTRD', uplo, n, -1, -1, -1 )
192 lwkopt =
max( 1, ( nb+2 )*n )
195 IF( lwork.LT.
max( 1, 3*n-1 ) .AND. .NOT.lquery )
200 CALL xerbla(
'SSYEV ', -info )
202 ELSE IF( lquery )
THEN
222 safmin = slamch(
'Safe minimum' )
223 eps = slamch(
'Precision' )
224 smlnum = safmin / eps
225 bignum = one / smlnum
226 rmin = sqrt( smlnum )
227 rmax = sqrt( bignum )
231 anrm = slansy(
'M', uplo, n, a, lda, work )
233 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
236 ELSE IF( anrm.GT.rmax )
THEN
241 $
CALL slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
248 llwork = lwork - indwrk + 1
249 CALL ssytrd( uplo, n, a, lda, w, work( inde ), work( indtau ),
250 $ work( indwrk ), llwork, iinfo )
255 IF( .NOT.wantz )
THEN
256 CALL ssterf( n, w, work( inde ), info )
258 CALL sorgtr( uplo, n, a, lda, work( indtau ), work( indwrk ),
260 CALL ssteqr( jobz, n, w, work( inde ), a, lda, work( indtau ),
266 IF( iscale.EQ.1 )
THEN
272 CALL sscal( imax, one / sigma, w, 1 )
subroutine slascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine ssteqr(compz, n, d, e, z, ldz, work, info)
SSTEQR
subroutine sorgtr(uplo, n, a, lda, tau, work, lwork, info)
SORGTR
subroutine ssytrd(uplo, n, a, lda, d, e, tau, work, lwork, info)
SSYTRD
subroutine ssyev(jobz, uplo, n, a, lda, w, work, lwork, info)
SSYEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices