284 SUBROUTINE ssbgvx( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
285 $ ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z,
286 $ ldz, work, iwork, ifail, info )
294 CHARACTER jobz, range, uplo
295 INTEGER il, info, iu, ka, kb, ldab, ldbb, ldq, ldz, m,
300 INTEGER ifail( * ), iwork( * )
301 REAL ab( ldab, * ), bb( ldbb, * ), q( ldq, * ),
302 $ w( * ), work( * ), z( ldz, * )
309 parameter( zero = 0.0e+0, one = 1.0e+0 )
312 LOGICAL alleig, indeig, test, upper, valeig, wantz
313 CHARACTER order, vect
314 INTEGER i, iinfo, indd, inde, indee, indibl, indisp,
315 $ indiwo, indwrk, itmp1,
j, jj, nsplit
333 wantz =
lsame( jobz,
'V' )
334 upper =
lsame( uplo,
'U' )
335 alleig =
lsame( range,
'A' )
336 valeig =
lsame( range,
'V' )
337 indeig =
lsame( range,
'I' )
340 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
342 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
344 ELSE IF( .NOT.( upper .OR.
lsame( uplo,
'L' ) ) )
THEN
346 ELSE IF( n.LT.0 )
THEN
348 ELSE IF( ka.LT.0 )
THEN
350 ELSE IF( kb.LT.0 .OR. kb.GT.ka )
THEN
352 ELSE IF( ldab.LT.ka+1 )
THEN
354 ELSE IF( ldbb.LT.kb+1 )
THEN
356 ELSE IF( ldq.LT.1 .OR. ( wantz .AND. ldq.LT.n ) )
THEN
360 IF( n.GT.0 .AND. vu.LE.vl )
362 ELSE IF( indeig )
THEN
363 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
365 ELSE IF ( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
371 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
377 CALL
xerbla(
'SSBGVX', -info )
389 CALL
spbstf( uplo, n, kb, bb, ldbb, info )
397 CALL
ssbgst( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq,
410 CALL
ssbtrd( vect, uplo, n, ka, ab, ldab, work( indd ),
411 $ work( inde ), q, ldq, work( indwrk ), iinfo )
419 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
423 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
424 CALL
scopy( n, work( indd ), 1, w, 1 )
426 CALL
scopy( n-1, work( inde ), 1, work( indee ), 1 )
427 IF( .NOT.wantz )
THEN
428 CALL
ssterf( n, w, work( indee ), info )
430 CALL
slacpy(
'A', n, n, q, ldq, z, ldz )
431 CALL
ssteqr( jobz, n, w, work( indee ), z, ldz,
432 $ work( indwrk ), info )
457 CALL
sstebz( range, order, n, vl, vu, il, iu, abstol,
458 $ work( indd ), work( inde ), m, nsplit, w,
459 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
460 $ iwork( indiwo ), info )
463 CALL
sstein( n, work( indd ), work( inde ), m, w,
464 $ iwork( indibl ), iwork( indisp ), z, ldz,
465 $ work( indwrk ), iwork( indiwo ), ifail, info )
471 CALL
scopy( n, z( 1,
j ), 1, work( 1 ), 1 )
472 CALL
sgemv(
'N', n, n, one, q, ldq, work, 1, zero,
487 IF( w( jj ).LT.tmp1 )
THEN
494 itmp1 = iwork( indibl+i-1 )
496 iwork( indibl+i-1 ) = iwork( indibl+
j-1 )
498 iwork( indibl+
j-1 ) = itmp1
499 CALL
sswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
502 ifail( i ) = ifail(
j )
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine spbstf(UPLO, N, KD, AB, LDAB, INFO)
SPBSTF
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ssbgvx(JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSBGST
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
logical function lsame(CA, CB)
LSAME
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssbgst(VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, LDX, WORK, INFO)
SSBGST
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
subroutine ssbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
SSBTRD