161 SUBROUTINE sstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
170 INTEGER INFO, LDZ, LIWORK, LWORK, N
174 REAL D( * ), E( * ), WORK( * ), Z( LDZ, * )
181 parameter( zero = 0.0e0, one = 1.0e0 )
184 LOGICAL LQUERY, WANTZ
185 INTEGER ISCALE, LIWMIN, LWMIN
186 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
192 EXTERNAL lsame, slamch, slanst
204 wantz = lsame( jobz,
'V' )
205 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
210 IF( n.GT.1 .AND. wantz )
THEN
211 lwmin = 1 + 4*n + n**2
215 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
217 ELSE IF( n.LT.0 )
THEN
219 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
227 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
229 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
235 CALL xerbla(
'SSTEVD', -info )
237 ELSE IF( lquery )
THEN
254 safmin = slamch(
'Safe minimum' )
255 eps = slamch(
'Precision' )
256 smlnum = safmin / eps
257 bignum = one / smlnum
258 rmin = sqrt( smlnum )
259 rmax = sqrt( bignum )
264 tnrm = slanst(
'M', n, d, e )
265 IF( tnrm.GT.zero .AND. tnrm.LT.rmin )
THEN
268 ELSE IF( tnrm.GT.rmax )
THEN
272 IF( iscale.EQ.1 )
THEN
273 CALL sscal( n, sigma, d, 1 )
274 CALL sscal( n-1, sigma, e( 1 ), 1 )
280 IF( .NOT.wantz )
THEN
281 CALL ssterf( n, d, e, info )
283 CALL sstedc(
'I', n, d, e, z, ldz, work, lwork, iwork, liwork,
290 $
CALL sscal( n, one / sigma, d, 1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
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...
subroutine sscal(N, SA, SX, INCX)
SSCAL