198 INTEGER INFO, LDA, LWORK, N
201 REAL RWORK( * ), W( * )
202 COMPLEX A( LDA, * ), WORK( * )
209 parameter( zero = 0.0e0, one = 1.0e0 )
211 parameter( cone = ( 1.0e0, 0.0e0 ) )
214 LOGICAL LOWER, LQUERY, WANTZ
215 INTEGER IINFO, IMAX, INDE, INDTAU, INDWRK, ISCALE,
216 $ llwork, lwmin, lhtrd, lwtrd, kd, ib, indhous
217 REAL ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA,
223 REAL SLAMCH, CLANHE, SROUNDUP_LWORK
224 EXTERNAL lsame, slamch, clanhe, ilaenv2stage,
232 INTRINSIC real, max, sqrt
238 wantz = lsame( jobz,
'V' )
239 lower = lsame( uplo,
'L' )
240 lquery = ( lwork.EQ.-1 )
243 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
245 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
247 ELSE IF( n.LT.0 )
THEN
249 ELSE IF( lda.LT.max( 1, n ) )
THEN
254 kd = ilaenv2stage( 1,
'CHETRD_2STAGE', jobz, n, -1, -1, -1 )
255 ib = ilaenv2stage( 2,
'CHETRD_2STAGE', jobz, n, kd, -1, -1 )
256 lhtrd = ilaenv2stage( 3,
'CHETRD_2STAGE', jobz, n, kd, ib, -1 )
257 lwtrd = ilaenv2stage( 4,
'CHETRD_2STAGE', jobz, n, kd, ib, -1 )
258 lwmin = n + lhtrd + lwtrd
259 work( 1 ) = sroundup_lwork(lwmin)
261 IF( lwork.LT.lwmin .AND. .NOT.lquery )
266 CALL xerbla(
'CHEEV_2STAGE ', -info )
268 ELSE IF( lquery )
THEN
279 w( 1 ) = real( a( 1, 1 ) )
288 safmin = slamch(
'Safe minimum' )
289 eps = slamch(
'Precision' )
290 smlnum = safmin / eps
291 bignum = one / smlnum
292 rmin = sqrt( smlnum )
293 rmax = sqrt( bignum )
297 anrm = clanhe(
'M', uplo, n, a, lda, rwork )
299 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
302 ELSE IF( anrm.GT.rmax )
THEN
307 $
CALL clascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
314 indwrk = indhous + lhtrd
315 llwork = lwork - indwrk + 1
318 $ work( indtau ), work( indhous ), lhtrd,
319 $ work( indwrk ), llwork, iinfo )
324 IF( .NOT.wantz )
THEN
325 CALL ssterf( n, w, rwork( inde ), info )
327 CALL cungtr( uplo, n, a, lda, work( indtau ), work( indwrk ),
330 CALL csteqr( jobz, n, w, rwork( inde ), a, lda,
331 $ rwork( indwrk ), info )
336 IF( iscale.EQ.1 )
THEN
342 CALL sscal( imax, one / sigma, w, 1 )
347 work( 1 ) = sroundup_lwork(lwmin)
subroutine xerbla(srname, info)
subroutine cheev_2stage(jobz, uplo, n, a, lda, w, work, lwork, rwork, info)
CHEEV_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matr...
subroutine chetrd_2stage(vect, uplo, n, a, lda, d, e, tau, hous2, lhous2, work, lwork, info)
CHETRD_2STAGE
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 sscal(n, sa, sx, incx)
SSCAL
subroutine csteqr(compz, n, d, e, z, ldz, work, info)
CSTEQR
subroutine ssterf(n, d, e, info)
SSTERF
subroutine cungtr(uplo, n, a, lda, tau, work, lwork, info)
CUNGTR