557 SUBROUTINE dgbsvxx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
558 $ ldafb, ipiv, equed, r, c, b, ldb, x, ldx,
559 $ rcond, rpvgrw, berr, n_err_bnds,
560 $ err_bnds_norm, err_bnds_comp, nparams, params,
561 $ work, iwork, info )
569 CHARACTER EQUED, FACT, TRANS
570 INTEGER INFO, LDAB, LDAFB, LDB, LDX, N, NRHS, NPARAMS,
572 DOUBLE PRECISION RCOND, RPVGRW
575 INTEGER IPIV( * ), IWORK( * )
576 DOUBLE PRECISION AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
577 $ x( ldx , * ),work( * )
578 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
579 $ err_bnds_norm( nrhs, * ),
580 $ err_bnds_comp( nrhs, * )
586 DOUBLE PRECISION ZERO, ONE
587 parameter ( zero = 0.0d+0, one = 1.0d+0 )
588 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
589 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
590 INTEGER CMP_ERR_I, PIV_GROWTH_I
591 parameter ( final_nrm_err_i = 1, final_cmp_err_i = 2,
593 parameter ( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
594 parameter ( cmp_rcond_i = 7, cmp_err_i = 8,
598 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
600 DOUBLE PRECISION AMAX, BIGNUM, COLCND, RCMAX, RCMIN,
606 DOUBLE PRECISION DLAMCH, DLA_GBRPVGRW
618 nofact = lsame( fact,
'N' )
619 equil = lsame( fact,
'E' )
620 notran = lsame( trans,
'N' )
621 smlnum = dlamch(
'Safe minimum' )
622 bignum = one / smlnum
623 IF( nofact .OR. equil )
THEN
628 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
629 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
640 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
641 $ lsame( fact,
'F' ) )
THEN
643 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
644 $ lsame( trans,
'C' ) )
THEN
646 ELSE IF( n.LT.0 )
THEN
648 ELSE IF( kl.LT.0 )
THEN
650 ELSE IF( ku.LT.0 )
THEN
652 ELSE IF( nrhs.LT.0 )
THEN
654 ELSE IF( ldab.LT.kl+ku+1 )
THEN
656 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
658 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
659 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
666 rcmin = min( rcmin, r( j ) )
667 rcmax = max( rcmax, r( j ) )
669 IF( rcmin.LE.zero )
THEN
671 ELSE IF( n.GT.0 )
THEN
672 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
677 IF( colequ .AND. info.EQ.0 )
THEN
681 rcmin = min( rcmin, c( j ) )
682 rcmax = max( rcmax, c( j ) )
684 IF( rcmin.LE.zero )
THEN
686 ELSE IF( n.GT.0 )
THEN
687 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
693 IF( ldb.LT.max( 1, n ) )
THEN
695 ELSE IF( ldx.LT.max( 1, n ) )
THEN
702 CALL xerbla(
'DGBSVXX', -info )
710 CALL dgbequb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
712 IF( infequ.EQ.0 )
THEN
716 CALL dlaqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
718 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
719 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
724 IF ( .NOT.rowequ )
THEN
729 IF ( .NOT.colequ )
THEN
739 IF( rowequ )
CALL dlascl2(n, nrhs, r, b, ldb)
741 IF( colequ )
CALL dlascl2(n, nrhs, c, b, ldb)
744 IF( nofact .OR. equil )
THEN
749 DO 30, i = kl+1, 2*kl+ku+1
750 afb( i, j ) = ab( i-kl, j )
753 CALL dgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
763 rpvgrw = dla_gbrpvgrw( n, kl, ku, info, ab, ldab, afb,
771 rpvgrw = dla_gbrpvgrw( n, kl, ku, n, ab, ldab, afb, ldafb )
775 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
776 CALL dgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
782 CALL dgbrfsx( trans, equed, n, kl, ku, nrhs, ab, ldab, afb, ldafb,
783 $ ipiv, r, c, b, ldb, x, ldx, rcond, berr,
784 $ n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params,
785 $ work, iwork, info )
789 IF ( colequ .AND. notran )
THEN
790 CALL dlascl2 ( n, nrhs, c, x, ldx )
791 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
792 CALL dlascl2 ( n, nrhs, r, x, ldx )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
double precision function dlamch(CMACH)
DLAMCH
double precision function dla_gbrpvgrw(N, KL, KU, NCOLS, AB, LDAB, AFB, LDAFB)
DLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix...
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 dgbrfsx(TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DGBRFSX
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
subroutine dgbsvxx(FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DGBSVXX computes the solution to system of linear equations A * X = B for GB matrices ...
subroutine dlascl2(M, N, D, X, LDX)
DLASCL2 performs diagonal scaling on a vector.
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine dgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQUB
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS