253 SUBROUTINE zheevd_2stage( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
254 $ rwork, lrwork, iwork, liwork, info )
265 INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N
269 DOUBLE PRECISION RWORK( * ), W( * )
270 COMPLEX*16 A( lda, * ), WORK( * )
276 DOUBLE PRECISION ZERO, ONE
277 parameter ( zero = 0.0d0, one = 1.0d0 )
279 parameter ( cone = ( 1.0d0, 0.0d0 ) )
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 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
295 DOUBLE PRECISION DLAMCH, ZLANHE
296 EXTERNAL lsame, ilaenv, dlamch, zlanhe
303 INTRINSIC dble, 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,
'ZHETRD_2STAGE', jobz, n, -1, -1, -1 )
331 ib = ilaenv( 18,
'ZHETRD_2STAGE', jobz, n, kd, -1, -1 )
332 lhtrd = ilaenv( 19,
'ZHETRD_2STAGE', jobz, n, kd, ib, -1 )
333 lwtrd = ilaenv( 20,
'ZHETRD_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(
'ZHEEVD_2STAGE', -info )
360 ELSE IF( lquery )
THEN
370 w( 1 ) = dble( a( 1, 1 ) )
378 safmin = dlamch(
'Safe minimum' )
379 eps = dlamch(
'Precision' )
380 smlnum = safmin / eps
381 bignum = one / smlnum
382 rmin = sqrt( smlnum )
383 rmax = sqrt( bignum )
387 anrm = zlanhe(
'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 zlascl( 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 dsterf( n, w, rwork( inde ), info )
424 CALL zstedc(
'I', n, w, rwork( inde ), work( indwrk ), n,
425 $ work( indwk2 ), llwrk2, rwork( indrwk ), llrwk,
426 $ iwork, liwork, info )
427 CALL zunmtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
428 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
429 CALL zlacpy(
'A', n, n, work( indwrk ), n, a, lda )
434 IF( iscale.EQ.1 )
THEN
440 CALL dscal( imax, one / sigma, w, 1 )
subroutine zhetrd_2stage(VECT, UPLO, N, A, LDA, D, E, TAU, HOUS2, LHOUS2, WORK, LWORK, INFO)
ZHETRD_2STAGE
subroutine zheevd_2stage(JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZHEEVD_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE ma...
subroutine zstedc(COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO)
ZSTEDC
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine zunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMTR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL