155 SUBROUTINE dstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
164 INTEGER INFO, LDZ, LIWORK, LWORK, N
168 DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
174 DOUBLE PRECISION ZERO, ONE
175 parameter( zero = 0.0d0, one = 1.0d0 )
178 LOGICAL LQUERY, WANTZ
179 INTEGER ISCALE, LIWMIN, LWMIN
180 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
185 DOUBLE PRECISION DLAMCH, DLANST
186 EXTERNAL lsame, dlamch, dlanst
198 wantz = lsame( jobz,
'V' )
199 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
204 IF( n.GT.1 .AND. wantz )
THEN
205 lwmin = 1 + 4*n + n**2
209 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
211 ELSE IF( n.LT.0 )
THEN
213 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
221 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
223 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
229 CALL xerbla(
'DSTEVD', -info )
231 ELSE IF( lquery )
THEN
248 safmin = dlamch(
'Safe minimum' )
249 eps = dlamch(
'Precision' )
250 smlnum = safmin / eps
251 bignum = one / smlnum
252 rmin = sqrt( smlnum )
253 rmax = sqrt( bignum )
258 tnrm = dlanst(
'M', n, d, e )
259 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
262 ELSE IF( tnrm.GT.rmax )
THEN
266 IF( iscale.EQ.1 )
THEN
267 CALL dscal( n, sigma, d, 1 )
268 CALL dscal( n-1, sigma, e( 1 ), 1 )
274 IF( .NOT.wantz )
THEN
275 CALL dsterf( n, d, e, info )
277 CALL dstedc(
'I', n, d, e, z, ldz, work, lwork, iwork, liwork,
284 $
CALL dscal( n, one / sigma, d, 1 )
subroutine xerbla(srname, info)
subroutine dscal(n, da, dx, incx)
DSCAL
subroutine dstedc(compz, n, d, e, z, ldz, work, lwork, iwork, liwork, info)
DSTEDC
subroutine dsterf(n, d, e, info)
DSTERF
subroutine dstevd(jobz, n, d, e, z, ldz, work, lwork, iwork, liwork, info)
DSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...