163 SUBROUTINE dstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
173 INTEGER INFO, LDZ, LIWORK, LWORK, N
177 DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( ldz, * )
183 DOUBLE PRECISION ZERO, ONE
184 parameter( zero = 0.0d0, one = 1.0d0 )
187 LOGICAL LQUERY, WANTZ
188 INTEGER ISCALE, LIWMIN, LWMIN
189 DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
194 DOUBLE PRECISION DLAMCH, DLANST
195 EXTERNAL lsame, dlamch, dlanst
207 wantz = lsame( jobz,
'V' )
208 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
213 IF( n.GT.1 .AND. wantz )
THEN
214 lwmin = 1 + 4*n + n**2
218 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
220 ELSE IF( n.LT.0 )
THEN
222 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
230 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
232 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
238 CALL
xerbla(
'DSTEVD', -info )
240 ELSE IF( lquery )
THEN
257 safmin = dlamch(
'Safe minimum' )
258 eps = dlamch(
'Precision' )
259 smlnum = safmin / eps
260 bignum = one / smlnum
261 rmin = sqrt( smlnum )
262 rmax = sqrt( bignum )
267 tnrm = dlanst(
'M', n, d, e )
268 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
271 ELSE IF( tnrm.GT.rmax )
THEN
275 IF( iscale.EQ.1 )
THEN
276 CALL
dscal( n, sigma, d, 1 )
277 CALL
dscal( n-1, sigma, e( 1 ), 1 )
283 IF( .NOT.wantz )
THEN
284 CALL
dsterf( n, d, e, info )
286 CALL
dstedc(
'I', n, d, e, z, ldz, work, lwork, iwork, liwork,
293 $ CALL
dscal( n, one / sigma, d, 1 )
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 dscal(N, DA, DX, INCX)
DSCAL
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 matric...