253 SUBROUTINE cheevd_2stage( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
254 $ rwork, lrwork, iwork, liwork, info )
265 INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N
269 REAL RWORK( * ), W( * )
270 COMPLEX A( lda, * ), WORK( * )
277 parameter ( zero = 0.0e0, one = 1.0e0 )
279 parameter ( cone = ( 1.0e0, 0.0e0 ) )
282 LOGICAL LOWER, LQUERY, WANTZ
283 INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2,
284 $ indwrk, iscale, liwmin, llrwk, llwork,
285 $ llwrk2, lrwmin, lwmin,
286 $ lhtrd, lwtrd, kd, ib, indhous
289 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
296 EXTERNAL lsame, ilaenv, slamch, clanhe
303 INTRINSIC REAL, MAX, SQRT
309 wantz = lsame( jobz,
'V' )
310 lower = lsame( uplo,
'L' )
311 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
314 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
316 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
318 ELSE IF( n.LT.0 )
THEN
320 ELSE IF( lda.LT.max( 1, n ) )
THEN
330 kd = ilaenv( 17,
'CHETRD_2STAGE', jobz, n, -1, -1, -1 )
331 ib = ilaenv( 18,
'CHETRD_2STAGE', jobz, n, kd, -1, -1 )
332 lhtrd = ilaenv( 19,
'CHETRD_2STAGE', jobz, n, kd, ib, -1 )
333 lwtrd = ilaenv( 20,
'CHETRD_2STAGE', jobz, n, kd, ib, -1 )
336 lrwmin = 1 + 5*n + 2*n**2
339 lwmin = n + 1 + lhtrd + lwtrd
348 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
350 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
352 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
358 CALL xerbla(
'CHEEVD_2STAGE', -info )
360 ELSE IF( lquery )
THEN
370 w( 1 ) =
REAL( A( 1, 1 ) )
378 safmin = slamch(
'Safe minimum' )
379 eps = slamch(
'Precision' )
380 smlnum = safmin / eps
381 bignum = one / smlnum
382 rmin = sqrt( smlnum )
383 rmax = sqrt( bignum )
387 anrm = clanhe(
'M', uplo, n, a, lda, rwork )
389 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
392 ELSE IF( anrm.GT.rmax )
THEN
397 $
CALL clascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
403 llrwk = lrwork - indrwk + 1
406 indwrk = indhous + lhtrd
407 llwork = lwork - indwrk + 1
408 indwk2 = indwrk + n*n
409 llwrk2 = lwork - indwk2 + 1
412 $ work( indtau ), work( indhous ), lhtrd,
413 $ work( indwrk ), llwork, iinfo )
421 IF( .NOT.wantz )
THEN
422 CALL ssterf( n, w, rwork( inde ), info )
424 CALL cstedc(
'I', n, w, rwork( inde ), work( indwrk ), n,
425 $ work( indwk2 ), llwrk2, rwork( indrwk ), llrwk,
426 $ iwork, liwork, info )
427 CALL cunmtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
428 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
429 CALL clacpy(
'A', n, n, work( indwrk ), n, a, lda )
434 IF( iscale.EQ.1 )
THEN
440 CALL sscal( imax, one / sigma, w, 1 )
subroutine cheevd_2stage(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE ma...
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine chetrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
CHETRD_2STAGE
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine cunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMTR
subroutine cstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
CSTEDC