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,
171 EXTERNAL lsame, clanhp, slamch
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 )
subroutine cupgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
CUPGTR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
subroutine chpev(JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, INFO)
CHPEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matrice...
subroutine chptrd(UPLO, N, AP, D, E, TAU, INFO)
CHPTRD
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine csscal(N, SA, CX, INCX)
CSSCAL