227 SUBROUTINE ssyevd_2stage( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
228 $ iwork, liwork, info )
239 INTEGER INFO, LDA, LIWORK, LWORK, N
243 REAL A( lda, * ), W( * ), WORK( * )
250 parameter ( zero = 0.0e+0, one = 1.0e+0 )
254 LOGICAL LOWER, LQUERY, WANTZ
255 INTEGER IINFO, INDE, INDTAU, INDWK2, INDWRK, ISCALE,
256 $ liwmin, llwork, llwrk2, lwmin,
257 $ lhtrd, lwtrd, kd, ib, indhous
258 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
265 EXTERNAL lsame, slamch, slansy, ilaenv
278 wantz = lsame( jobz,
'V' )
279 lower = lsame( uplo,
'L' )
280 lquery = ( lwork.EQ.-1 .OR. liwork.EQ.-1 )
283 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
285 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
287 ELSE IF( n.LT.0 )
THEN
289 ELSE IF( lda.LT.max( 1, n ) )
THEN
298 kd = ilaenv( 17,
'SSYTRD_2STAGE', jobz, n, -1, -1, -1 )
299 ib = ilaenv( 18,
'SSYTRD_2STAGE', jobz, n, kd, -1, -1 )
300 lhtrd = ilaenv( 19,
'SSYTRD_2STAGE', jobz, n, kd, ib, -1 )
301 lwtrd = ilaenv( 20,
'SSYTRD_2STAGE', jobz, n, kd, ib, -1 )
304 lwmin = 1 + 6*n + 2*n**2
307 lwmin = 2*n + 1 + lhtrd + lwtrd
313 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
315 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
321 CALL xerbla(
'SSYEVD_2STAGE', -info )
323 ELSE IF( lquery )
THEN
341 safmin = slamch(
'Safe minimum' )
342 eps = slamch(
'Precision' )
343 smlnum = safmin / eps
344 bignum = one / smlnum
345 rmin = sqrt( smlnum )
346 rmax = sqrt( bignum )
350 anrm = slansy(
'M', uplo, n, a, lda, work )
352 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
355 ELSE IF( anrm.GT.rmax )
THEN
360 $
CALL slascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
367 indwrk = indhous + lhtrd
368 llwork = lwork - indwrk + 1
369 indwk2 = indwrk + n*n
370 llwrk2 = lwork - indwk2 + 1
373 $ work( indtau ), work( indhous ), lhtrd,
374 $ work( indwrk ), llwork, iinfo )
381 IF( .NOT.wantz )
THEN
382 CALL ssterf( n, w, work( inde ), info )
387 CALL sstedc(
'I', n, w, work( inde ), work( indwrk ), n,
388 $ work( indwk2 ), llwrk2, iwork, liwork, info )
389 CALL sormtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
390 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
391 CALL slacpy(
'A', n, n, work( indwrk ), n, a, lda )
397 $
CALL sscal( n, one / sigma, w, 1 )
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 ma...
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
subroutine xerbla(SRNAME, INFO)
XERBLA
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 ssytrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
SSYTRD_2STAGE
subroutine sstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK, LIWORK, INFO)
SSTEDC
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine ssterf(N, D, E, INFO)
SSTERF