368 SUBROUTINE dgbsvx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
369 $ ldafb, ipiv, equed, r, c,
b, ldb, x, ldx,
370 $ rcond, ferr, berr, work, iwork, info )
378 CHARACTER equed, fact, trans
379 INTEGER info, kl, ku, ldab, ldafb, ldb, ldx, n, nrhs
380 DOUBLE PRECISION rcond
383 INTEGER ipiv( * ), iwork( * )
384 DOUBLE PRECISION ab( ldab, * ), afb( ldafb, * ),
b( ldb, * ),
385 $ berr( * ), c( * ), ferr( * ), r( * ),
386 $ work( * ), x( ldx, * )
392 DOUBLE PRECISION zero, one
393 parameter( zero = 0.0d+0, one = 1.0d+0 )
396 LOGICAL colequ, equil, nofact, notran, rowequ
398 INTEGER i, infequ,
j, j1, j2
399 DOUBLE PRECISION amax, anorm, bignum, colcnd, rcmax, rcmin,
400 $ rowcnd, rpvgrw, smlnum
412 INTRINSIC abs, max, min
417 nofact =
lsame( fact,
'N' )
418 equil =
lsame( fact,
'E' )
419 notran =
lsame( trans,
'N' )
420 IF( nofact .OR. equil )
THEN
425 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
426 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
427 smlnum =
dlamch(
'Safe minimum' )
428 bignum = one / smlnum
433 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
lsame( fact,
'F' ) )
436 ELSE IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) .AND. .NOT.
437 $
lsame( trans,
'C' ) )
THEN
439 ELSE IF( n.LT.0 )
THEN
441 ELSE IF( kl.LT.0 )
THEN
443 ELSE IF( ku.LT.0 )
THEN
445 ELSE IF( nrhs.LT.0 )
THEN
447 ELSE IF( ldab.LT.kl+ku+1 )
THEN
449 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
451 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
452 $ ( rowequ .OR. colequ .OR.
lsame( equed,
'N' ) ) )
THEN
459 rcmin = min( rcmin, r(
j ) )
460 rcmax = max( rcmax, r(
j ) )
462 IF( rcmin.LE.zero )
THEN
464 ELSE IF( n.GT.0 )
THEN
465 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
470 IF( colequ .AND. info.EQ.0 )
THEN
474 rcmin = min( rcmin, c(
j ) )
475 rcmax = max( rcmax, c(
j ) )
477 IF( rcmin.LE.zero )
THEN
479 ELSE IF( n.GT.0 )
THEN
480 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
486 IF( ldb.LT.max( 1, n ) )
THEN
488 ELSE IF( ldx.LT.max( 1, n ) )
THEN
495 CALL
xerbla(
'DGBSVX', -info )
503 CALL
dgbequ( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
505 IF( infequ.EQ.0 )
THEN
509 CALL
dlaqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
511 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
512 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
522 b( i,
j ) = r( i )*
b( i,
j )
526 ELSE IF( colequ )
THEN
529 b( i,
j ) = c( i )*
b( i,
j )
534 IF( nofact .OR. equil )
THEN
541 CALL
dcopy( j2-j1+1, ab( ku+1-
j+j1,
j ), 1,
542 $ afb( kl+ku+1-
j+j1,
j ), 1 )
545 CALL
dgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
556 DO 80 i = max( ku+2-
j, 1 ), min( n+ku+1-
j, kl+ku+1 )
557 anorm = max( anorm, abs( ab( i,
j ) ) )
560 rpvgrw =
dlantb(
'M',
'U',
'N', info, min( info-1, kl+ku ),
561 $ afb( max( 1, kl+ku+2-info ), 1 ), ldafb,
563 IF( rpvgrw.EQ.zero )
THEN
566 rpvgrw = anorm / rpvgrw
582 anorm =
dlangb( norm, n, kl, ku, ab, ldab, work )
583 rpvgrw =
dlantb(
'M',
'U',
'N', n, kl+ku, afb, ldafb, work )
584 IF( rpvgrw.EQ.zero )
THEN
587 rpvgrw =
dlangb(
'M', n, kl, ku, ab, ldab, work ) / rpvgrw
592 CALL
dgbcon( norm, n, kl, ku, afb, ldafb, ipiv, anorm, rcond,
593 $ work, iwork, info )
597 CALL
dlacpy(
'Full', n, nrhs,
b, ldb, x, ldx )
598 CALL
dgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
604 CALL
dgbrfs( trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv,
605 $
b, ldb, x, ldx, ferr, berr, work, iwork, info )
614 x( i,
j ) = c( i )*x( i,
j )
618 ferr(
j ) = ferr(
j ) / colcnd
621 ELSE IF( rowequ )
THEN
624 x( i,
j ) = r( i )*x( i,
j )
628 ferr(
j ) = ferr(
j ) / rowcnd
634 IF( rcond.LT.
dlamch(
'Epsilon' ) )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
double precision function dlangb(NORM, N, KL, KU, AB, LDAB, WORK)
DLANGB returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
logical function lsame(CA, CB)
LSAME
double precision function dlantb(NORM, UPLO, DIAG, N, K, AB, LDAB, WORK)
DLANTB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular band matrix.
subroutine dgbsvx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR, WORK, IWORK, INFO)
DGBSVX computes the solution to system of linear equations A * X = B for GB matrices ...
subroutine dlaqgb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, EQUED)
DLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ...
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
subroutine dgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQU
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGBRFS