138 SUBROUTINE chpev( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK,
151 REAL rwork( * ), w( * )
152 COMPLEX ap( * ), work( * ), z( ldz, * )
159 parameter( zero = 0.0e0, one = 1.0e0 )
163 INTEGER iinfo, imax, inde, indrwk, indtau, indwrk,
165 REAL anrm, bignum, eps, rmax, rmin, safmin, sigma,
184 wantz =
lsame( jobz,
'V' )
187 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
189 ELSE IF( .NOT.(
lsame( uplo,
'L' ) .OR.
lsame( uplo,
'U' ) ) )
192 ELSE IF( n.LT.0 )
THEN
194 ELSE IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
199 CALL
xerbla(
'CHPEV ', -info )
218 safmin =
slamch(
'Safe minimum' )
219 eps =
slamch(
'Precision' )
220 smlnum = safmin / eps
221 bignum = one / smlnum
222 rmin = sqrt( smlnum )
223 rmax = sqrt( bignum )
227 anrm =
clanhp(
'M', uplo, n, ap, rwork )
229 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
232 ELSE IF( anrm.GT.rmax )
THEN
236 IF( iscale.EQ.1 )
THEN
237 CALL
csscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
244 CALL
chptrd( uplo, n, ap, w, rwork( inde ), work( indtau ),
250 IF( .NOT.wantz )
THEN
251 CALL
ssterf( n, w, rwork( inde ), info )
254 CALL
cupgtr( uplo, n, ap, work( indtau ), z, ldz,
255 $ work( indwrk ), iinfo )
257 CALL
csteqr( jobz, n, w, rwork( inde ), z, ldz,
258 $ rwork( indrwk ), info )
263 IF( iscale.EQ.1 )
THEN
269 CALL
sscal( imax, one / sigma, w, 1 )