161 SUBROUTINE dstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
170 INTEGER INFO, LDZ, LIWORK, LWORK, N
174 DOUBLE PRECISION D( * ), E( * ), WORK( * ), ( LDZ, * )
180 DOUBLE PRECISION ZERO, ONE
181 parameter( zero = 0.0d0, one = 1.0d0 )
184 LOGICAL LQUERY, WANTZ
185 INTEGER ISCALE, LIWMIN, LWMIN
186 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
191 DOUBLE PRECISION DLAMCH, DLANST
192 EXTERNAL lsame, dlamch, dlanst
204 wantz = lsame( jobz,
'V' )
205 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
210 IF( n.GT.1 .AND. wantz )
THEN
211 lwmin = 1 + 4*n + n**2
215 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
217 ELSE IF( n.LT.0 )
THEN
219 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
227 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
229 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
235 CALL xerbla(
'DSTEVD', -info )
237 ELSE IF( lquery )
THEN
254 safmin = dlamch(
'Safe minimum' )
255 eps = dlamch(
'Precision' )
256 smlnum = safmin / eps
257 bignum = one / smlnum
258 rmin = sqrt( smlnum )
259 rmax = sqrt( bignum )
264 tnrm = dlanst(
'M', n, d, e )
265 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
268 ELSE IF( tnrm.GT.rmax )
THEN
272 IF( iscale.EQ.1 )
THEN
273 CALL dscal( n, sigma, d, 1 )
274 CALL dscal( n-1, sigma, e( 1 ), 1 )
280 IF( .NOT.wantz )
THEN
281 CALL dsterf( n, d, e, info )
283 CALL dstedc(
'I', n, d, e, z, ldz, work, lwork, iwork, liwork,
290 $
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...