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 spbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
SPBTRS
subroutine spbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
SPBCON
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 xerbla(SRNAME, INFO)
XERBLA
subroutine spbtrf(UPLO, N, KD, AB, LDAB, INFO)
SPBTRF
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 ...
subroutine spbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
SPBEQU
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY