155 SUBROUTINE sstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
164 INTEGER INFO, LDZ, LIWORK, LWORK, N
168 REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
175 parameter( zero = 0.0e0, one = 1.0e0 )
178 LOGICAL LQUERY, WANTZ
179 INTEGER ISCALE, LIWMIN, LWMIN
180 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
185 REAL SLAMCH, SLANST, SROUNDUP_LWORK
186 EXTERNAL lsame, slamch, slanst, sroundup_lwork
198 wantz = lsame( jobz,
'V' )
199 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
204 IF( n.GT.1 .AND. wantz )
THEN
205 lwmin = 1 + 4*n + n**2
209 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
211 ELSE IF( n.LT.0 )
THEN
213 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
218 work( 1 ) = sroundup_lwork(lwmin)
221 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
223 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
229 CALL xerbla(
'SSTEVD', -info )
231 ELSE IF( lquery )
THEN
248 safmin = slamch(
'Safe minimum' )
249 eps = slamch(
'Precision' )
250 smlnum = safmin / eps
251 bignum = one / smlnum
252 rmin = sqrt( smlnum )
253 rmax = sqrt( bignum )
258 tnrm = slanst(
'M', n, d, e )
259 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
262 ELSE IF( tnrm.GT.rmax )
THEN
266 IF( iscale.EQ.1 )
THEN
267 CALL sscal( n, sigma, d, 1 )
268 CALL sscal( n-1, sigma, e( 1 ), 1 )
274 IF( .NOT.wantz )
THEN
275 CALL ssterf( n, d, e, info )
277 CALL sstedc(
'I', n, d, e, z, ldz, work, lwork, iwork, liwork,
284 $
CALL sscal( n, one / sigma, d, 1 )
286 work( 1 ) = sroundup_lwork(lwmin)
subroutine xerbla(srname, info)
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine sstedc(compz, n, d, e, z, ldz, work, lwork, iwork, liwork, info)
SSTEDC
subroutine ssterf(n, d, e, info)
SSTERF
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...