171 SUBROUTINE ssyevd( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
181 INTEGER INFO, LDA, LIWORK, LWORK, N
185 REAL A( LDA, * ), W( * ), WORK( * )
192 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
196 LOGICAL LOWER, LQUERY, WANTZ
197 INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
198 $ liopt, liwmin, llwork, llwrk2, lopt, lwmin
199 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
205 REAL SLAMCH, SLANSY, SROUNDUP_LWORK
206 EXTERNAL ilaenv, lsame, slamch,
207 $ slansy, sroundup_lwork
221 wantz = lsame( jobz,
'V' )
222 lower = lsame( uplo,
'L' )
223 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
226 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
228 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
230 ELSE IF( n.LT.0 )
THEN
232 ELSE IF( lda.LT.max( 1, n ) )
THEN
245 lwmin = 1 + 6*n + 2*n**2
250 lopt = max( lwmin, 2*n +
251 $ n*ilaenv( 1,
'SSYTRD', uplo, n, -1, -1,
255 work( 1 ) = sroundup_lwork( lopt )
258 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
260 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
266 CALL xerbla(
'SSYEVD', -info )
268 ELSE IF( lquery )
THEN
286 safmin = slamch(
'Safe minimum' )
287 eps = slamch(
'Precision' )
288 smlnum = safmin / eps
289 bignum = one / smlnum
290 rmin = sqrt( smlnum )
291 rmax = sqrt( bignum )
295 anrm = slansy(
'M', uplo, n, a, lda, work )
297 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
300 ELSE IF( anrm.GT.rmax )
THEN
305 $
CALL slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
312 llwork = lwork - indwrk + 1
313 indwk2 = indwrk + n*n
314 llwrk2 = lwork - indwk2 + 1
316 CALL ssytrd( uplo, n, a, lda, w, work( inde ), work( indtau ),
317 $ work( indwrk ), llwork, iinfo )
324 IF( .NOT.wantz )
THEN
325 CALL ssterf( n, w, work( inde ), info )
327 CALL sstedc(
'I', n, w, work( inde ), work( indwrk ), n,
328 $ work( indwk2 ), llwrk2, iwork, liwork, info )
329 CALL sormtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
330 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
331 CALL slacpy(
'A', n, n, work( indwrk ), n, a, lda )
337 $
CALL sscal( n, one / sigma, w, 1 )
339 work( 1 ) = sroundup_lwork( lopt )
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 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 sormtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
SORMTR