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,
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 )