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 dormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMTR
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEBZ
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 dscal(N, DA, DX, INCX)
DSCAL
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 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