153 SUBROUTINE sstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
162 INTEGER INFO, LDZ, LIWORK, LWORK, N
166 REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
173 parameter( zero = 0.0e0, one = 1.0e0 )
176 LOGICAL LQUERY, WANTZ
177 INTEGER ISCALE, LIWMIN, LWMIN
178 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
183 REAL SLAMCH, SLANST, SROUNDUP_LWORK
184 EXTERNAL lsame, slamch, slanst,
197 wantz = lsame( jobz,
'V' )
198 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
203 IF( n.GT.1 .AND. wantz )
THEN
204 lwmin = 1 + 4*n + n**2
208 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
210 ELSE IF( n.LT.0 )
THEN
212 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
217 work( 1 ) = sroundup_lwork(lwmin)
220 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
222 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
228 CALL xerbla(
'SSTEVD', -info )
230 ELSE IF( lquery )
THEN
247 safmin = slamch(
'Safe minimum' )
248 eps = slamch(
'Precision' )
249 smlnum = safmin / eps
250 bignum = one / smlnum
251 rmin = sqrt( smlnum )
252 rmax = sqrt( bignum )
257 tnrm = slanst(
'M', n, d, e )
258 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
261 ELSE IF( tnrm.GT.rmax )
THEN
265 IF( iscale.EQ.1 )
THEN
266 CALL sscal( n, sigma, d, 1 )
267 CALL sscal( n-1, sigma, e( 1 ), 1 )
273 IF( .NOT.wantz )
THEN
274 CALL ssterf( n, d, e, info )
276 CALL sstedc(
'I', n, d, e, z, ldz, work, lwork, iwork,
284 $
CALL sscal( n, one / sigma, d, 1 )
286 work( 1 ) = sroundup_lwork(lwmin)
subroutine sstedc(compz, n, d, e, z, ldz, work, lwork, iwork, liwork, info)
SSTEDC
subroutine sstevd(jobz, n, d, e, z, ldz, work, lwork, iwork, liwork, info)
SSTEVD computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...