163 SUBROUTINE sstevd( JOBZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
173 INTEGER INFO, LDZ, LIWORK, LWORK, N
177 REAL D( * ), E( * ), WORK( * ), Z( ldz, * )
184 parameter ( zero = 0.0e0, one = 1.0e0 )
187 LOGICAL LQUERY, WANTZ
188 INTEGER ISCALE, LIWMIN, LWMIN
189 REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
195 EXTERNAL lsame, slamch, slanst
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(
'SSTEVD', -info )
240 ELSE IF( lquery )
THEN
257 safmin = slamch(
'Safe minimum' )
258 eps = slamch(
'Precision' )
259 smlnum = safmin / eps
260 bignum = one / smlnum
261 rmin = sqrt( smlnum )
262 rmax = sqrt( bignum )
267 tnrm = slanst(
'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 sscal( n, sigma, d, 1 )
277 CALL sscal( n-1, sigma, e( 1 ), 1 )
283 IF( .NOT.wantz )
THEN
284 CALL ssterf( n, d, e, info )
286 CALL sstedc(
'I', n, d, e, z, ldz, work, lwork, iwork, liwork,
293 $
CALL sscal( n, one / sigma, d, 1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
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 matric...