140 SUBROUTINE zheev( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
150 INTEGER info, lda, lwork, n
153 DOUBLE PRECISION rwork( * ), w( * )
154 COMPLEX*16 a( lda, * ), work( * )
160 DOUBLE PRECISION zero, one
161 parameter( zero = 0.0d0, one = 1.0d0 )
163 parameter( cone = ( 1.0d0, 0.0d0 ) )
166 LOGICAL lower, lquery, wantz
167 INTEGER iinfo, imax, inde, indtau, indwrk, iscale,
169 DOUBLE PRECISION anrm, bignum, eps, rmax, rmin, safmin, sigma,
189 wantz =
lsame( jobz,
'V' )
190 lower =
lsame( uplo,
'L' )
191 lquery = ( lwork.EQ.-1 )
194 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
196 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
198 ELSE IF( n.LT.0 )
THEN
200 ELSE IF( lda.LT.max( 1, n ) )
THEN
205 nb =
ilaenv( 1,
'ZHETRD', uplo, n, -1, -1, -1 )
206 lwkopt = max( 1, ( nb+1 )*n )
209 IF( lwork.LT.max( 1, 2*n-1 ) .AND. .NOT.lquery )
214 CALL
xerbla(
'ZHEEV ', -info )
216 ELSE IF( lquery )
THEN
236 safmin =
dlamch(
'Safe minimum' )
237 eps =
dlamch(
'Precision' )
238 smlnum = safmin / eps
239 bignum = one / smlnum
240 rmin = sqrt( smlnum )
241 rmax = sqrt( bignum )
245 anrm =
zlanhe(
'M', uplo, n, a, lda, rwork )
247 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
250 ELSE IF( anrm.GT.rmax )
THEN
255 $ CALL
zlascl( uplo, 0, 0, one, sigma, n, n, a, lda, info )
262 llwork = lwork - indwrk + 1
263 CALL
zhetrd( uplo, n, a, lda, w, rwork( inde ), work( indtau ),
264 $ work( indwrk ), llwork, iinfo )
269 IF( .NOT.wantz )
THEN
270 CALL
dsterf( n, w, rwork( inde ), info )
272 CALL
zungtr( uplo, n, a, lda, work( indtau ), work( indwrk ),
275 CALL
zsteqr( jobz, n, w, rwork( inde ), a, lda,
276 $ rwork( indwrk ), info )
281 IF( iscale.EQ.1 )
THEN
287 CALL
dscal( imax, one / sigma, w, 1 )