192 INTEGER INFO, LDA, LWORK, N
195 REAL A( LDA, * ), W( * ), WORK( * )
202 parameter( zero = 0.0e0, one = 1.0e0 )
205 LOGICAL LOWER, LQUERY, WANTZ
206 INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
207 $ llwork, lwmin, lhtrd, lwtrd, kd, ib, indhous
208 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
214 REAL SLAMCH, SLANSY, SROUNDUP_LWORK
215 EXTERNAL lsame, slamch, slansy, ilaenv2stage,
229 wantz = lsame( jobz,
'V' )
230 lower = lsame( uplo,
'L' )
231 lquery = ( lwork.EQ.-1 )
234 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
236 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
238 ELSE IF( n.LT.0 )
THEN
240 ELSE IF( lda.LT.max( 1, n ) )
THEN
245 kd = ilaenv2stage( 1,
'SSYTRD_2STAGE', jobz, n, -1, -1, -1 )
246 ib = ilaenv2stage( 2,
'SSYTRD_2STAGE', jobz, n, kd, -1, -1 )
247 lhtrd = ilaenv2stage( 3,
'SSYTRD_2STAGE', jobz, n, kd, ib, -1 )
248 lwtrd = ilaenv2stage( 4,
'SSYTRD_2STAGE', jobz, n, kd, ib, -1 )
249 lwmin = 2*n + lhtrd + lwtrd
252 IF( lwork.LT.lwmin .AND. .NOT.lquery )
257 CALL xerbla(
'SSYEV_2STAGE ', -info )
259 ELSE IF( lquery )
THEN
279 safmin = slamch(
'Safe minimum' )
280 eps = slamch(
'Precision' )
281 smlnum = safmin / eps
282 bignum = one / smlnum
283 rmin = sqrt( smlnum )
284 rmax = sqrt( bignum )
288 anrm = slansy(
'M', uplo, n, a, lda, work )
290 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
293 ELSE IF( anrm.GT.rmax )
THEN
298 $
CALL slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
305 indwrk = indhous + lhtrd
306 llwork = lwork - indwrk + 1
309 $ work( indtau ), work( indhous ), lhtrd,
310 $ work( indwrk ), llwork, iinfo )
315 IF( .NOT.wantz )
THEN
316 CALL ssterf( n, w, work( inde ), info )
321 CALL sorgtr( uplo, n, a, lda, work( indtau ), work( indwrk ),
323 CALL ssteqr( jobz, n, w, work( inde ), a, lda, work( indtau ),
329 IF( iscale.EQ.1 )
THEN
335 CALL sscal( imax, one / sigma, w, 1 )
340 work( 1 ) = sroundup_lwork(lwmin)
subroutine xerbla(srname, info)
subroutine ssyev_2stage(jobz, uplo, n, a, lda, w, work, lwork, info)
SSYEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matr...
subroutine ssytrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
SSYTRD_2STAGE
subroutine slascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine ssteqr(compz, n, d, e, z, ldz, work, info)
SSTEQR
subroutine ssterf(n, d, e, info)
SSTERF
subroutine sorgtr(uplo, n, a, lda, tau, work, lwork, info)
SORGTR