198 INTEGER INFO, LDA, LWORK, N
201 DOUBLE PRECISION RWORK( * ), W( * )
202 COMPLEX*16 A( LDA, * ), WORK( * )
208 DOUBLE PRECISION ZERO, ONE
209 parameter( zero = 0.0d0, one = 1.0d0 )
211 parameter( cone = ( 1.0d0, 0.0d0 ) )
214 LOGICAL LOWER, LQUERY, WANTZ
215 INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
216 $ llwork, lwmin, lhtrd, lwtrd, kd, ib, indhous
217 DOUBLE PRECISION ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
223 DOUBLE PRECISION DLAMCH, ZLANHE
224 EXTERNAL lsame, dlamch, zlanhe, ilaenv2stage
231 INTRINSIC dble, max, sqrt
237 wantz = lsame( jobz,
'V' )
238 lower = lsame( uplo,
'L' )
239 lquery = ( lwork.EQ.-1 )
242 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
244 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
246 ELSE IF( n.LT.0 )
THEN
248 ELSE IF( lda.LT.max( 1, n ) )
THEN
253 kd = ilaenv2stage( 1,
'ZHETRD_2STAGE', jobz, n, -1, -1, -1 )
254 ib = ilaenv2stage( 2,
'ZHETRD_2STAGE', jobz, n, kd, -1, -1 )
255 lhtrd = ilaenv2stage( 3,
'ZHETRD_2STAGE', jobz, n, kd, ib, -1 )
256 lwtrd = ilaenv2stage( 4,
'ZHETRD_2STAGE', jobz, n, kd, ib, -1 )
257 lwmin = n + lhtrd + lwtrd
260 IF( lwork.LT.lwmin .AND. .NOT.lquery )
265 CALL xerbla(
'ZHEEV_2STAGE ', -info )
267 ELSE IF( lquery )
THEN
278 w( 1 ) = dble( a( 1, 1 ) )
287 safmin = dlamch(
'Safe minimum' )
288 eps = dlamch(
'Precision' )
289 smlnum = safmin / eps
290 bignum = one / smlnum
291 rmin = sqrt( smlnum )
292 rmax = sqrt( bignum )
296 anrm = zlanhe(
'M', uplo, n, a, lda, rwork )
298 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
301 ELSE IF( anrm.GT.rmax )
THEN
306 $
CALL zlascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
313 indwrk = indhous + lhtrd
314 llwork = lwork - indwrk + 1
317 $ work( indtau ), work( indhous ), lhtrd,
318 $ work( indwrk ), llwork, iinfo )
323 IF( .NOT.wantz )
THEN
324 CALL dsterf( n, w, rwork( inde ), info )
326 CALL zungtr( uplo, n, a, lda, work( indtau ), work( indwrk ),
329 CALL zsteqr( jobz, n, w, rwork( inde ), a, lda,
330 $ rwork( indwrk ), info )
335 IF( iscale.EQ.1 )
THEN
341 CALL dscal( imax, one / sigma, w, 1 )
subroutine xerbla(srname, info)
subroutine zheev_2stage(jobz, uplo, n, a, lda, w, work, lwork, rwork, info)
ZHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matr...
subroutine zhetrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
ZHETRD_2STAGE
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 zsteqr(compz, n, d, e, z, ldz, work, info)
ZSTEQR
subroutine dsterf(n, d, e, info)
DSTERF
subroutine zungtr(uplo, n, a, lda, tau, work, lwork, info)
ZUNGTR