246 $ RWORK, LRWORK, IWORK, LIWORK, INFO )
256 INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N
260 DOUBLE PRECISION RWORK( * ), W( * )
261 COMPLEX*16 A( LDA, * ), WORK( * )
267 DOUBLE PRECISION ZERO, ONE
268 parameter( zero = 0.0d0, one = 1.0d0 )
270 parameter( cone = ( 1.0d0, 0.0d0 ) )
273 LOGICAL LOWER, LQUERY, WANTZ
274 INTEGER IINFO, IMAX, INDE, INDRWK, INDTAU, INDWK2,
275 $ indwrk, iscale, liwmin, llrwk, llwork,
276 $ llwrk2, lrwmin, lwmin,
277 $ lhtrd, lwtrd, kd, ib, indhous
280 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
286 DOUBLE PRECISION DLAMCH, ZLANHE
287 EXTERNAL lsame, dlamch, zlanhe, ilaenv2stage
294 INTRINSIC dble, max, sqrt
300 wantz = lsame( jobz,
'V' )
301 lower = lsame( uplo,
'L' )
302 lquery = ( lwork.EQ.-1 .OR. lrwork.EQ.-1 .OR. liwork.EQ.-1 )
305 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
307 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
309 ELSE IF( n.LT.0 )
THEN
311 ELSE IF( lda.LT.max( 1, n ) )
THEN
321 kd = ilaenv2stage( 1,
'ZHETRD_2STAGE', jobz,
323 ib = ilaenv2stage( 2,
'ZHETRD_2STAGE', jobz,
325 lhtrd = ilaenv2stage( 3,
'ZHETRD_2STAGE', jobz,
327 lwtrd = ilaenv2stage( 4,
'ZHETRD_2STAGE', jobz,
331 lrwmin = 1 + 5*n + 2*n**2
334 lwmin = n + 1 + lhtrd + lwtrd
343 IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
345 ELSE IF( lrwork.LT.lrwmin .AND. .NOT.lquery )
THEN
347 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
353 CALL xerbla(
'ZHEEVD_2STAGE', -info )
355 ELSE IF( lquery )
THEN
365 w( 1 ) = dble( a( 1, 1 ) )
373 safmin = dlamch(
'Safe minimum' )
374 eps = dlamch(
'Precision' )
375 smlnum = safmin / eps
376 bignum = one / smlnum
377 rmin = sqrt( smlnum )
378 rmax = sqrt( bignum )
382 anrm = zlanhe(
'M', uplo, n, a, lda, rwork )
384 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
387 ELSE IF( anrm.GT.rmax )
THEN
392 $
CALL zlascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
398 llrwk = lrwork - indrwk + 1
401 indwrk = indhous + lhtrd
402 llwork = lwork - indwrk + 1
403 indwk2 = indwrk + n*n
404 llwrk2 = lwork - indwk2 + 1
407 $ work( indtau ), work( indhous ), lhtrd,
408 $ work( indwrk ), llwork, iinfo )
416 IF( .NOT.wantz )
THEN
417 CALL dsterf( n, w, rwork( inde ), info )
419 CALL zstedc(
'I', n, w, rwork( inde ), work( indwrk ), n,
420 $ work( indwk2 ), llwrk2, rwork( indrwk ), llrwk,
421 $ iwork, liwork, info )
422 CALL zunmtr(
'L', uplo,
'N', n, n, a, lda, work( indtau ),
423 $ work( indwrk ), n, work( indwk2 ), llwrk2, iinfo )
424 CALL zlacpy(
'A', n, n, work( indwrk ), n, a, lda )
429 IF( iscale.EQ.1 )
THEN
435 CALL dscal( imax, one / sigma, w, 1 )
subroutine xerbla(srname, info)
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 mat...
subroutine zhetrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
ZHETRD_2STAGE
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
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 dscal(n, da, dx, incx)
DSCAL
subroutine zstedc(compz, n, d, e, z, ldz, work, lwork, rwork, lrwork, iwork, liwork, info)
ZSTEDC
subroutine dsterf(n, d, e, info)
DSTERF
subroutine zunmtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
ZUNMTR