251 SUBROUTINE zheevx( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
252 $ abstol, m, w, z, ldz, work, lwork, rwork,
253 $ iwork, ifail, info )
261 CHARACTER jobz, range, uplo
262 INTEGER il, info, iu, lda, ldz, lwork, m, n
263 DOUBLE PRECISION abstol, vl, vu
266 INTEGER ifail( * ), iwork( * )
267 DOUBLE PRECISION rwork( * ), w( * )
268 COMPLEX*16 a( lda, * ), work( * ), z( ldz, * )
274 DOUBLE PRECISION zero, one
275 parameter( zero = 0.0d+0, one = 1.0d+0 )
277 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
280 LOGICAL alleig, indeig, lower, lquery, test, valeig,
283 INTEGER i, iinfo, imax, indd, inde, indee, indibl,
284 $ indisp, indiwk, indrwk, indtau, indwrk, iscale,
285 $ itmp1,
j, jj, llwork, lwkmin, lwkopt, nb,
287 DOUBLE PRECISION abstll, anrm, bignum, eps, rmax, rmin, safmin,
288 $ sigma, smlnum, tmp1, vll, vuu
302 INTRINSIC dble, max, min, sqrt
308 lower =
lsame( uplo,
'L' )
309 wantz =
lsame( jobz,
'V' )
310 alleig =
lsame( range,
'A' )
311 valeig =
lsame( range,
'V' )
312 indeig =
lsame( range,
'I' )
313 lquery = ( lwork.EQ.-1 )
316 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
318 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
320 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
322 ELSE IF( n.LT.0 )
THEN
324 ELSE IF( lda.LT.max( 1, n ) )
THEN
328 IF( n.GT.0 .AND. vu.LE.vl )
330 ELSE IF( indeig )
THEN
331 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
333 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
339 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
350 nb =
ilaenv( 1,
'ZHETRD', uplo, n, -1, -1, -1 )
351 nb = max( nb,
ilaenv( 1,
'ZUNMTR', uplo, n, -1, -1, -1 ) )
352 lwkopt = max( 1, ( nb + 1 )*n )
356 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
361 CALL
xerbla(
'ZHEEVX', -info )
363 ELSE IF( lquery )
THEN
375 IF( alleig .OR. indeig )
THEN
378 ELSE IF( valeig )
THEN
379 IF( vl.LT.dble( a( 1, 1 ) ) .AND. vu.GE.dble( a( 1, 1 ) ) )
392 safmin =
dlamch(
'Safe minimum' )
393 eps =
dlamch(
'Precision' )
394 smlnum = safmin / eps
395 bignum = one / smlnum
396 rmin = sqrt( smlnum )
397 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
407 anrm =
zlanhe(
'M', uplo, n, a, lda, rwork )
408 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
411 ELSE IF( anrm.GT.rmax )
THEN
415 IF( iscale.EQ.1 )
THEN
418 CALL
zdscal( n-
j+1, sigma, a(
j,
j ), 1 )
422 CALL
zdscal(
j, sigma, a( 1,
j ), 1 )
426 $ abstll = abstol*sigma
440 llwork = lwork - indwrk + 1
441 CALL
zhetrd( uplo, n, a, lda, rwork( indd ), rwork( inde ),
442 $ work( indtau ), work( indwrk ), llwork, iinfo )
450 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
454 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
455 CALL
dcopy( n, rwork( indd ), 1, w, 1 )
457 IF( .NOT.wantz )
THEN
458 CALL
dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
459 CALL
dsterf( n, w, rwork( indee ), info )
461 CALL
zlacpy(
'A', n, n, a, lda, z, ldz )
462 CALL
zungtr( uplo, n, z, ldz, work( indtau ),
463 $ work( indwrk ), llwork, iinfo )
464 CALL
dcopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
465 CALL
zsteqr( jobz, n, w, rwork( indee ), z, ldz,
466 $ rwork( indrwk ), info )
490 CALL
dstebz( range, order, n, vll, vuu, il, iu, abstll,
491 $ rwork( indd ), rwork( inde ), m, nsplit, w,
492 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
493 $ iwork( indiwk ), info )
496 CALL
zstein( n, rwork( indd ), rwork( inde ), m, w,
497 $ iwork( indibl ), iwork( indisp ), z, ldz,
498 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
503 CALL
zunmtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
504 $ ldz, work( indwrk ), llwork, iinfo )
510 IF( iscale.EQ.1 )
THEN
516 CALL
dscal( imax, one / sigma, w, 1 )
527 IF( w( jj ).LT.tmp1 )
THEN
534 itmp1 = iwork( indibl+i-1 )
536 iwork( indibl+i-1 ) = iwork( indibl+
j-1 )
538 iwork( indibl+
j-1 ) = itmp1
539 CALL
zswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
542 ifail( i ) = ifail(
j )
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zdscal(N, DA, ZX, INCX)
ZDSCAL
subroutine zstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
ZSTEIN
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
double precision function zlanhe(NORM, UPLO, N, A, LDA, WORK)
ZLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhetrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
ZHETRD
logical function lsame(CA, CB)
LSAME
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine zsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
ZSTEQR
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine zunmtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMTR
subroutine zungtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
ZUNGTR
subroutine zheevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, RWORK, IWORK, IFAIL, INFO)
ZHEEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for HE matrices ...