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 dscal(N, DA, DX, INCX)
DSCAL
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 matric...