232 SUBROUTINE chpevx( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
233 $ abstol, m, w, z, ldz, work, rwork, iwork,
242 CHARACTER JOBZ, RANGE, UPLO
243 INTEGER IL, INFO, IU, LDZ, M, N
247 INTEGER IFAIL( * ), IWORK( * )
248 REAL RWORK( * ), W( * )
249 COMPLEX AP( * ), WORK( * ), Z( ldz, * )
256 parameter( zero = 0.0e0, one = 1.0e0 )
258 parameter( cone = ( 1.0e0, 0.0e0 ) )
261 LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
263 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
264 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
265 $ itmp1, j, jj, nsplit
266 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
267 $ sigma, smlnum, tmp1, vll, vuu
272 EXTERNAL lsame, clanhp, slamch
279 INTRINSIC max, min,
REAL, SQRT
285 wantz = lsame( jobz,
'V' )
286 alleig = lsame( range,
'A' )
287 valeig = lsame( range,
'V' )
288 indeig = lsame( range,
'I' )
291 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
293 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
295 ELSE IF( .NOT.( lsame( uplo,
'L' ) .OR. lsame( uplo,
'U' ) ) )
298 ELSE IF( n.LT.0 )
THEN
302 IF( n.GT.0 .AND. vu.LE.vl )
304 ELSE IF( indeig )
THEN
305 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
307 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
313 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
318 CALL xerbla(
'CHPEVX', -info )
329 IF( alleig .OR. indeig )
THEN
333 IF( vl.LT.
REAL( AP( 1 ) ) .AND. VU.GE.
REAL( AP( 1 ) ) ) then
345 safmin = slamch(
'Safe minimum' )
346 eps = slamch(
'Precision' )
347 smlnum = safmin / eps
348 bignum = one / smlnum
349 rmin = sqrt( smlnum )
350 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
363 anrm = clanhp(
'M', uplo, n, ap, rwork )
364 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
367 ELSE IF( anrm.GT.rmax )
THEN
371 IF( iscale.EQ.1 )
THEN
372 CALL csscal( ( n*( n+1 ) ) / 2, sigma, ap, 1 )
374 $ abstll = abstol*sigma
388 CALL chptrd( uplo, n, ap, rwork( indd ), rwork( inde ),
389 $ work( indtau ), iinfo )
397 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
401 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
402 CALL scopy( n, rwork( indd ), 1, w, 1 )
404 IF( .NOT.wantz )
THEN
405 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
406 CALL ssterf( n, w, rwork( indee ), info )
408 CALL cupgtr( uplo, n, ap, work( indtau ), z, ldz,
409 $ work( indwrk ), iinfo )
410 CALL scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
411 CALL csteqr( jobz, n, w, rwork( indee ), z, ldz,
412 $ rwork( indrwk ), info )
436 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
437 $ rwork( indd ), rwork( inde ), m, nsplit, w,
438 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
439 $ iwork( indiwk ), info )
442 CALL cstein( n, rwork( indd ), rwork( inde ), m, w,
443 $ iwork( indibl ), iwork( indisp ), z, ldz,
444 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
450 CALL cupmtr(
'L', uplo,
'N', n, m, ap, work( indtau ), z, ldz,
451 $ work( indwrk ), iinfo )
457 IF( iscale.EQ.1 )
THEN
463 CALL sscal( imax, one / sigma, w, 1 )
474 IF( w( jj ).LT.tmp1 )
THEN
481 itmp1 = iwork( indibl+i-1 )
483 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
485 iwork( indibl+j-1 ) = itmp1
486 CALL cswap( n, z( 1, i ), 1, z( 1, j ), 1 )
489 ifail( i ) = ifail( j )
subroutine chptrd(UPLO, N, AP, D, E, TAU, INFO)
CHPTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chpevx(JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
CHPEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine csteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
CSTEQR
subroutine cstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
CSTEIN
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine cupmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
CUPMTR
subroutine cupgtr(UPLO, N, AP, TAU, Q, LDQ, WORK, INFO)
CUPGTR
subroutine csscal(N, SA, CX, INCX)
CSSCAL
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine sscal(N, SA, SX, INCX)
SSCAL