185 SUBROUTINE dsyevd( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK,
195 INTEGER INFO, LDA, LIWORK, LWORK, N
199 DOUBLE PRECISION A( lda, * ), W( * ), WORK( * )
205 DOUBLE PRECISION ZERO, ONE
206 parameter ( zero = 0.0d+0, one = 1.0d+0 )
210 LOGICAL LOWER, LQUERY, WANTZ
211 INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
212 $ liopt, liwmin, llwork, llwrk2, lopt, lwmin
213 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
219 DOUBLE PRECISION DLAMCH, DLANSY
220 EXTERNAL lsame, dlamch, dlansy, ilaenv
233 wantz = lsame( jobz,
'V' )
234 lower = lsame( uplo,
'L' )
235 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
238 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
240 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
242 ELSE IF( n.LT.0 )
THEN
244 ELSE IF( lda.LT.max( 1, n ) )
THEN
257 lwmin = 1 + 6*n + 2*n**2
262 lopt = max( lwmin, 2*n +
263 $ ilaenv( 1,
'DSYTRD', uplo, n, -1, -1, -1 ) )
269 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
271 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
277 CALL xerbla(
'DSYEVD', -info )
279 ELSE IF( lquery )
THEN
297 safmin = dlamch(
'Safe minimum' )
298 eps = dlamch(
'Precision' )
299 smlnum = safmin / eps
300 bignum = one / smlnum
301 rmin = sqrt( smlnum )
302 rmax = sqrt( bignum )
306 anrm = dlansy(
'M', uplo, n, a, lda, work )
308 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
311 ELSE IF( anrm.GT.rmax )
THEN
316 $
CALL dlascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
323 llwork = lwork - indwrk + 1
324 indwk2 = indwrk + n*n
325 llwrk2 = lwork - indwk2 + 1
327 CALL dsytrd( uplo, n, a, lda, w, work( inde ), work( indtau ),
328 $ work( indwrk ), llwork, iinfo )
335 IF( .NOT.wantz )
THEN
336 CALL dsterf( n, w, work( inde ), info )
338 CALL dstedc(
'I', n, w, work( inde ), work( indwrk ), n,
339 $ work( indwk2 ), llwrk2, iwork, liwork, info )
340 CALL dormtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
341 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
342 CALL dlacpy(
'A', n, n, work( indwrk ), n, a, lda )
348 $
CALL dscal( n, one / sigma, w, 1 )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
DSYTRD
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dsyevd(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, INFO)
DSYEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEDC
subroutine dormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMTR