1 SUBROUTINE dsyev( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
10 INTEGER INFO, LDA, LWORK, N
13 DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
77 DOUBLE PRECISION ZERO, ONE
78 parameter( zero = 0.0d0, one = 1.0d0 )
81 LOGICAL LOWER, LQUERY, WANTZ
82 INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
83 $ LLWORK, LOPT, LWKOPT, NB
84 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
90 DOUBLE PRECISION DLAMCH, DLANSY
91 EXTERNAL lsame, ilaenv, dlamch, dlansy
104 wantz = lsame( jobz,
'V' )
105 lower = lsame( uplo,
'L' )
106 lquery = ( lwork.EQ.-1 )
109 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
111 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
113 ELSE IF( n.LT.0 )
THEN
115 ELSE IF( lda.LT.max( 1, n ) )
THEN
117 ELSE IF( lwork.LT.max( 1, 3*n-1 ) .AND. .NOT.lquery )
THEN
122 nb = ilaenv( 1,
'DSYTRD', uplo, n, -1, -1, -1 )
123 lwkopt = max( 1, ( nb+2 )*n )
128 CALL xerbla(
'DSYEV ', -info )
130 ELSE IF( lquery )
THEN
151 safmin = dlamch(
'Safe minimum' )
152 eps = dlamch(
'Precision' )
153 smlnum = safmin / eps
154 bignum = one / smlnum
155 rmin = sqrt( smlnum )
156 rmax = sqrt( bignum )
160 anrm = dlansy(
'M', uplo, n, a, lda, work )
162 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
165 ELSE IF( anrm.GT.rmax )
THEN
170 $
CALL dlascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
177 llwork = lwork - indwrk + 1
178 CALL dsytrd( uplo, n, a, lda, w, work( inde ), work( indtau ),
179 $ work( indwrk ), llwork, iinfo )
180 lopt = 2*n + work( indwrk )
185 IF( .NOT.wantz )
THEN
186 CALL dsterf( n, w, work( inde ), info )
188 CALL dorgtr( uplo, n, a, lda, work( indtau ), work( indwrk ),
190 CALL dsteqr( jobz, n, w, work( inde ), a, lda, work( indtau ),
196 IF( iscale.EQ.1 )
THEN
202 CALL dscal( imax, one / sigma, w, 1 )
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
subroutine dorgtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
subroutine dscal(n, da, dx, incx)
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
subroutine dsterf(N, D, E, INFO)
subroutine dsyev(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO)
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
subroutine xerbla(SRNAME, INFO)