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,
215 EXTERNAL lsame, slamch, slansy, ilaenv2stage
228 wantz = lsame( jobz,
'V' )
229 lower = lsame( uplo,
'L' )
230 lquery = ( lwork.EQ.-1 )
233 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
235 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
237 ELSE IF( n.LT.0 )
THEN
239 ELSE IF( lda.LT.max( 1, n ) )
THEN
244 kd = ilaenv2stage( 1,
'SSYTRD_2STAGE', jobz, n, -1, -1, -1 )
245 ib = ilaenv2stage( 2,
'SSYTRD_2STAGE', jobz, n, kd, -1, -1 )
246 lhtrd = ilaenv2stage( 3,
'SSYTRD_2STAGE', jobz, n, kd, ib, -1 )
247 lwtrd = ilaenv2stage( 4,
'SSYTRD_2STAGE', jobz, n, kd, ib, -1 )
248 lwmin = 2*n + lhtrd + lwtrd
251 IF( lwork.LT.lwmin .AND. .NOT.lquery )
256 CALL xerbla(
'SSYEV_2STAGE ', -info )
258 ELSE IF( lquery )
THEN
278 safmin = slamch(
'Safe minimum' )
279 eps = slamch(
'Precision' )
280 smlnum = safmin / eps
281 bignum = one / smlnum
282 rmin = sqrt( smlnum )
283 rmax = sqrt( bignum )
287 anrm = slansy(
'M', uplo, n, a, lda, work )
289 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
292 ELSE IF( anrm.GT.rmax )
THEN
297 $
CALL slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
304 indwrk = indhous + lhtrd
305 llwork = lwork - indwrk + 1
308 $ work( indtau ), work( indhous ), lhtrd,
309 $ work( indwrk ), llwork, iinfo )
314 IF( .NOT.wantz )
THEN
315 CALL ssterf( n, w, work( inde ), info )
320 CALL sorgtr( uplo, n, a, lda, work( indtau ), work( indwrk ),
322 CALL ssteqr( jobz, n, w, work( inde ), a, lda, work( indtau ),
328 IF( iscale.EQ.1 )
THEN
334 CALL sscal( imax, one / sigma, w, 1 )
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 xerbla(SRNAME, INFO)
XERBLA
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
subroutine ssytrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
SSYTRD_2STAGE
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 sscal(N, SA, SX, INCX)
SSCAL