220 $ IWORK, LIWORK, INFO )
230 INTEGER INFO, LDA, LIWORK, LWORK, N
234 REAL A( LDA, * ), W( * ), WORK( * )
241 parameter( zero = 0.0e+0, one = 1.0e+0 )
245 LOGICAL LOWER, LQUERY, WANTZ
246 INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
247 $ liwmin, llwork, llwrk2, lwmin,
248 $ lhtrd, lwtrd, kd, ib, indhous
249 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
256 EXTERNAL lsame, slamch, slansy, ilaenv2stage
269 wantz = lsame( jobz,
'V' )
270 lower = lsame( uplo,
'L' )
271 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
274 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
276 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
278 ELSE IF( n.LT.0 )
THEN
280 ELSE IF( lda.LT.max( 1, n ) )
THEN
289 kd = ilaenv2stage( 1,
'SSYTRD_2STAGE', jobz,
291 ib = ilaenv2stage( 2,
'SSYTRD_2STAGE', jobz,
293 lhtrd = ilaenv2stage( 3,
'SSYTRD_2STAGE', jobz,
295 lwtrd = ilaenv2stage( 4,
'SSYTRD_2STAGE', jobz,
299 lwmin = 1 + 6*n + 2*n**2
302 lwmin = 2*n + 1 + lhtrd + lwtrd
308 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
310 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
316 CALL xerbla(
'SSYEVD_2STAGE', -info )
318 ELSE IF( lquery )
THEN
336 safmin = slamch(
'Safe minimum' )
337 eps = slamch(
'Precision' )
338 smlnum = safmin / eps
339 bignum = one / smlnum
340 rmin = sqrt( smlnum )
341 rmax = sqrt( bignum )
345 anrm = slansy(
'M', uplo, n, a, lda, work )
347 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
350 ELSE IF( anrm.GT.rmax )
THEN
355 $
CALL slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
362 indwrk = indhous + lhtrd
363 llwork = lwork - indwrk + 1
364 indwk2 = indwrk + n*n
365 llwrk2 = lwork - indwk2 + 1
368 $ work( indtau ), work( indhous ), lhtrd,
369 $ work( indwrk ), llwork, iinfo )
376 IF( .NOT.wantz )
THEN
377 CALL ssterf( n, w, work( inde ), info )
382 CALL sstedc(
'I', n, w, work( inde ), work( indwrk ), n,
383 $ work( indwk2 ), llwrk2, iwork, liwork, info )
384 CALL sormtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
385 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
386 CALL slacpy(
'A', n, n, work( indwrk ), n, a, lda )
392 $
CALL sscal( n, one / sigma, w, 1 )
subroutine xerbla(srname, info)
subroutine ssyevd_2stage(jobz, uplo, n, a, lda, w, work, lwork, iwork, liwork, info)
SSYEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY mat...
subroutine ssytrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
SSYTRD_2STAGE
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
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 sstedc(compz, n, d, e, z, ldz, work, lwork, iwork, liwork, info)
SSTEDC
subroutine ssterf(n, d, e, info)
SSTERF
subroutine sormtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
SORMTR