342 SUBROUTINE spbsvx( FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB,
343 $ equed, s, b, ldb, x, ldx, rcond, ferr, berr,
344 $ work, iwork, info )
352 CHARACTER EQUED, FACT, UPLO
353 INTEGER INFO, KD, LDAB, LDAFB, LDB, LDX, N, NRHS
358 REAL AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
359 $ berr( * ), ferr( * ), s( * ), work( * ),
367 parameter( zero = 0.0e+0, one = 1.0e+0 )
370 LOGICAL EQUIL, NOFACT, RCEQU, UPPER
371 INTEGER I, INFEQU, J, J1, J2
372 REAL AMAX, ANORM, BIGNUM, SCOND, SMAX, SMIN, SMLNUM
377 EXTERNAL lsame, slamch, slansb
389 nofact = lsame( fact,
'N' )
390 equil = lsame( fact,
'E' )
391 upper = lsame( uplo,
'U' )
392 IF( nofact .OR. equil )
THEN
396 rcequ = lsame( equed,
'Y' )
397 smlnum = slamch(
'Safe minimum' )
398 bignum = one / smlnum
403 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.lsame( fact,
'F' ) )
406 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
408 ELSE IF( n.LT.0 )
THEN
410 ELSE IF( kd.LT.0 )
THEN
412 ELSE IF( nrhs.LT.0 )
THEN
414 ELSE IF( ldab.LT.kd+1 )
THEN
416 ELSE IF( ldafb.LT.kd+1 )
THEN
418 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
419 $ ( rcequ .OR. lsame( equed,
'N' ) ) )
THEN
426 smin = min( smin, s( j ) )
427 smax = max( smax, s( j ) )
429 IF( smin.LE.zero )
THEN
431 ELSE IF( n.GT.0 )
THEN
432 scond = max( smin, smlnum ) / min( smax, bignum )
438 IF( ldb.LT.max( 1, n ) )
THEN
440 ELSE IF( ldx.LT.max( 1, n ) )
THEN
447 CALL
xerbla(
'SPBSVX', -info )
455 CALL
spbequ( uplo, n, kd, ab, ldab, s, scond, amax, infequ )
456 IF( infequ.EQ.0 )
THEN
460 CALL
slaqsb( uplo, n, kd, ab, ldab, s, scond, amax, equed )
461 rcequ = lsame( equed,
'Y' )
470 b( i, j ) = s( i )*b( i, j )
475 IF( nofact .OR. equil )
THEN
482 CALL
scopy( j-j1+1, ab( kd+1-j+j1, j ), 1,
483 $ afb( kd+1-j+j1, j ), 1 )
488 CALL
scopy( j2-j+1, ab( 1, j ), 1, afb( 1, j ), 1 )
492 CALL
spbtrf( uplo, n, kd, afb, ldafb, info )
504 anorm = slansb(
'1', uplo, n, kd, ab, ldab, work )
508 CALL
spbcon( uplo, n, kd, afb, ldafb, anorm, rcond, work, iwork,
513 CALL
slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
514 CALL
spbtrs( uplo, n, kd, nrhs, afb, ldafb, x, ldx, info )
519 CALL
spbrfs( uplo, n, kd, nrhs, ab, ldab, afb, ldafb, b, ldb, x,
520 $ ldx, ferr, berr, work, iwork, info )
528 x( i, j ) = s( i )*x( i, j )
532 ferr( j ) = ferr( j ) / scond
538 IF( rcond.LT.slamch(
'Epsilon' ) )
subroutine spbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
SPBEQU
subroutine spbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
SPBCON
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine slaqsb(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, EQUED)
SLAQSB scales a symmetric/Hermitian band matrix, using scaling factors computed by spbequ...
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine spbtrf(UPLO, N, KD, AB, LDAB, INFO)
SPBTRF
subroutine spbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
SPBTRS
subroutine spbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPBRFS
subroutine spbsvx(FACT, UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, EQUED, S, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
SPBSVX computes the solution to system of linear equations A * X = B for OTHER matrices ...