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 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...
subroutine dstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEDC