290 SUBROUTINE chbgvx( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
291 $ ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z,
292 $ ldz, work, rwork, iwork, ifail, info )
300 CHARACTER jobz, range, uplo
301 INTEGER il, info, iu, ka, kb, ldab, ldbb, ldq, ldz, m,
306 INTEGER ifail( * ), iwork( * )
307 REAL rwork( * ), w( * )
308 COMPLEX ab( ldab, * ), bb( ldbb, * ), q( ldq, * ),
309 $ work( * ), z( ldz, * )
316 parameter( zero = 0.0e+0 )
318 parameter( czero = ( 0.0e+0, 0.0e+0 ),
319 $ cone = ( 1.0e+0, 0.0e+0 ) )
322 LOGICAL alleig, indeig, test, upper, valeig, wantz
323 CHARACTER order, vect
324 INTEGER i, iinfo, indd, inde, indee, indibl, indisp,
325 $ indiwk, indrwk, indwrk, itmp1,
j, jj, nsplit
344 wantz =
lsame( jobz,
'V' )
345 upper =
lsame( uplo,
'U' )
346 alleig =
lsame( range,
'A' )
347 valeig =
lsame( range,
'V' )
348 indeig =
lsame( range,
'I' )
351 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
353 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
355 ELSE IF( .NOT.( upper .OR.
lsame( uplo,
'L' ) ) )
THEN
357 ELSE IF( n.LT.0 )
THEN
359 ELSE IF( ka.LT.0 )
THEN
361 ELSE IF( kb.LT.0 .OR. kb.GT.ka )
THEN
363 ELSE IF( ldab.LT.ka+1 )
THEN
365 ELSE IF( ldbb.LT.kb+1 )
THEN
367 ELSE IF( ldq.LT.1 .OR. ( wantz .AND. ldq.LT.n ) )
THEN
371 IF( n.GT.0 .AND. vu.LE.vl )
373 ELSE IF( indeig )
THEN
374 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
376 ELSE IF ( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
382 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
388 CALL
xerbla(
'CHBGVX', -info )
400 CALL
cpbstf( uplo, n, kb, bb, ldbb, info )
408 CALL
chbgst( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq,
409 $ work, rwork, iinfo )
423 CALL
chbtrd( vect, uplo, n, ka, ab, ldab, rwork( indd ),
424 $ rwork( inde ), q, ldq, work( indwrk ), iinfo )
432 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
436 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
437 CALL
scopy( n, rwork( indd ), 1, w, 1 )
439 CALL
scopy( n-1, rwork( inde ), 1, rwork( indee ), 1 )
440 IF( .NOT.wantz )
THEN
441 CALL
ssterf( n, w, rwork( indee ), info )
443 CALL
clacpy(
'A', n, n, q, ldq, z, ldz )
444 CALL
csteqr( jobz, n, w, rwork( indee ), z, ldz,
445 $ rwork( indrwk ), info )
470 CALL
sstebz( range, order, n, vl, vu, il, iu, abstol,
471 $ rwork( indd ), rwork( inde ), m, nsplit, w,
472 $ iwork( indibl ), iwork( indisp ), rwork( indrwk ),
473 $ iwork( indiwk ), info )
476 CALL
cstein( n, rwork( indd ), rwork( inde ), m, w,
477 $ iwork( indibl ), iwork( indisp ), z, ldz,
478 $ rwork( indrwk ), iwork( indiwk ), ifail, info )
484 CALL
ccopy( n, z( 1,
j ), 1, work( 1 ), 1 )
485 CALL
cgemv(
'N', n, n, cone, q, ldq, work, 1, czero,
500 IF( w( jj ).LT.tmp1 )
THEN
507 itmp1 = iwork( indibl+i-1 )
509 iwork( indibl+i-1 ) = iwork( indibl+
j-1 )
511 iwork( indibl+
j-1 ) = itmp1
512 CALL
cswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
515 ifail( i ) = ifail(
j )
subroutine cpbstf(UPLO, N, KD, AB, LDAB, INFO)
CPBSTF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
CHBTRD
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
logical function lsame(CA, CB)
LSAME
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
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 chbgst(VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, LDX, WORK, RWORK, INFO)
CHBGST
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine chbgvx(JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, RWORK, IWORK, IFAIL, INFO)
CHBGST