183 SUBROUTINE ssyevd( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
193 INTEGER INFO, LDA, LIWORK, LWORK, N
197 REAL A( lda, * ), W( * ), WORK( * )
204 parameter( zero = 0.0e+0, one = 1.0e+0 )
208 LOGICAL LOWER, LQUERY, WANTZ
209 INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
210 $ liopt, liwmin, llwork, llwrk2, lopt, lwmin
211 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
218 EXTERNAL ilaenv, lsame, slamch, slansy
231 wantz = lsame( jobz,
'V' )
232 lower = lsame( uplo,
'L' )
233 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
236 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
238 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
240 ELSE IF( n.LT.0 )
THEN
242 ELSE IF( lda.LT.max( 1, n ) )
THEN
255 lwmin = 1 + 6*n + 2*n**2
260 lopt = max( lwmin, 2*n +
261 $ ilaenv( 1,
'SSYTRD', uplo, n, -1, -1, -1 ) )
267 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
269 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
275 CALL
xerbla(
'SSYEVD', -info )
277 ELSE IF( lquery )
THEN
295 safmin = slamch(
'Safe minimum' )
296 eps = slamch(
'Precision' )
297 smlnum = safmin / eps
298 bignum = one / smlnum
299 rmin = sqrt( smlnum )
300 rmax = sqrt( bignum )
304 anrm = slansy(
'M', uplo, n, a, lda, work )
306 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
309 ELSE IF( anrm.GT.rmax )
THEN
314 $ CALL
slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
321 llwork = lwork - indwrk + 1
322 indwk2 = indwrk + n*n
323 llwrk2 = lwork - indwk2 + 1
325 CALL
ssytrd( uplo, n, a, lda, w, work( inde ), work( indtau ),
326 $ work( indwrk ), llwork, iinfo )
333 IF( .NOT.wantz )
THEN
334 CALL
ssterf( n, w, work( inde ), info )
336 CALL
sstedc(
'I', n, w, work( inde ), work( indwrk ), n,
337 $ work( indwk2 ), llwrk2, iwork, liwork, info )
338 CALL
sormtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
339 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
340 CALL
slacpy(
'A', n, n, work( indwrk ), n, a, lda )
346 $ CALL
sscal( n, one / sigma, w, 1 )
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ssytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
SSYTRD
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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEBZ
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssyevd(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, INFO)
SSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine sscal(N, SA, SX, INCX)
SSCAL