153 SUBROUTINE dstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
162 INTEGER INFO, LDZ, LIWORK, LWORK, N
166 DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * )
172 DOUBLE PRECISION ZERO, ONE
173 parameter( zero = 0.0d0, one = 1.0d0 )
176 LOGICAL LQUERY, WANTZ
177 INTEGER ISCALE, LIWMIN, LWMIN
178 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
183 DOUBLE PRECISION DLAMCH, DLANST
184 EXTERNAL lsame, dlamch, dlanst
196 wantz = lsame( jobz,
'V' )
197 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
202 IF( n.GT.1 .AND. wantz )
THEN
203 lwmin = 1 + 4*n + n**2
207 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
209 ELSE IF( n.LT.0 )
THEN
211 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
219 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
221 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
227 CALL xerbla(
'DSTEVD', -info )
229 ELSE IF( lquery )
THEN
246 safmin = dlamch(
'Safe minimum' )
247 eps = dlamch(
'Precision' )
248 smlnum = safmin / eps
249 bignum = one / smlnum
250 rmin = sqrt( smlnum )
251 rmax = sqrt( bignum )
256 tnrm = dlanst(
'M', n, d, e )
257 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
260 ELSE IF( tnrm.GT.rmax )
THEN
264 IF( iscale.EQ.1 )
THEN
265 CALL dscal( n, sigma, d, 1 )
266 CALL dscal( n-1, sigma, e( 1 ), 1 )
272 IF( .NOT.wantz )
THEN
273 CALL dsterf( n, d, e, info )
275 CALL dstedc(
'I', n, d, e, z, ldz, work, lwork, iwork,
283 $
CALL dscal( n, one / sigma, d, 1 )
subroutine dstedc(compz, n, d, e, z, ldz, work, lwork, iwork, liwork, info)
DSTEDC
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...