181 SUBROUTINE ssyevd( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
190 INTEGER INFO, LDA, LIWORK, LWORK, N
194 REAL A( LDA, * ), W( * ), WORK( * )
201 parameter( zero = 0.0e+0, one = 1.0e+0 )
205 LOGICAL LOWER, LQUERY, WANTZ
206 INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
207 $ liopt, liwmin, llwork, llwrk2, lopt, lwmin
208 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
215 EXTERNAL ilaenv, lsame, slamch, slansy
228 wantz = lsame( jobz,
'V' )
229 lower = lsame( uplo,
'L' )
230 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
233 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
235 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
237 ELSE IF( n.LT.0 )
THEN
239 ELSE IF( lda.LT.max( 1, n ) )
THEN
252 lwmin = 1 + 6*n + 2*n**2
257 lopt = max( lwmin, 2*n +
258 $ ilaenv( 1,
'SSYTRD', uplo, n, -1, -1, -1 ) )
264 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
266 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
272 CALL xerbla(
'SSYEVD', -info )
274 ELSE IF( lquery )
THEN
292 safmin = slamch(
'Safe minimum' )
293 eps = slamch(
'Precision' )
294 smlnum = safmin / eps
295 bignum = one / smlnum
296 rmin = sqrt( smlnum )
297 rmax = sqrt( bignum )
301 anrm = slansy(
'M', uplo, n, a, lda, work )
303 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
306 ELSE IF( anrm.GT.rmax )
THEN
311 $
CALL slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
318 llwork = lwork - indwrk + 1
319 indwk2 = indwrk + n*n
320 llwrk2 = lwork - indwk2 + 1
322 CALL ssytrd( uplo, n, a, lda, w, work( inde ), work( indtau ),
323 $ work( indwrk ), llwork, iinfo )
330 IF( .NOT.wantz )
THEN
331 CALL ssterf( n, w, work( inde ), info )
333 CALL sstedc(
'I', n, w, work( inde ), work( indwrk ), n,
334 $ work( indwk2 ), llwrk2, iwork, liwork, info )
335 CALL sormtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
336 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
337 CALL slacpy(
'A', n, n, work( indwrk ), n, a, lda )
343 $
CALL sscal( n, 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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEDC
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
subroutine ssytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
SSYTRD
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