555 SUBROUTINE dgbsvxx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
556 $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
557 $ RCOND, RPVGRW, BERR, N_ERR_BNDS,
558 $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS,
559 $ WORK, IWORK, INFO )
566 CHARACTER EQUED, , TRANS
567 INTEGER INFO, LDAB, LDAFB, LDB, LDX, N, NRHS, NPARAMS,
569 DOUBLE PRECISION RCOND, RPVGRW
572 INTEGER IPIV( * ), IWORK( * )
573 DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
574 $ X( LDX , * ),WORK( * )
575 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
576 $ err_bnds_norm( nrhs, * ),
577 $ err_bnds_comp( nrhs, * )
583 DOUBLE PRECISION ZERO, ONE
584 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
585 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
586 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
587 INTEGER CMP_ERR_I, PIV_GROWTH_I
588 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
590 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
591 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
595 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
597 DOUBLE PRECISION AMAX, BIGNUM, COLCND, RCMAX, RCMIN,
603 DOUBLE PRECISION DLAMCH, DLA_GBRPVGRW
615 nofact = lsame( fact,
'N' )
616 equil = lsame( fact,
'E' )
617 notran = lsame( trans,
'N' )
618 smlnum = dlamch(
'Safe minimum' )
619 bignum = one / smlnum
620 IF( nofact .OR. equil )
THEN
625 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
626 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
637 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
638 $ lsame( fact,
'F' ) )
THEN
640 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
641 $ lsame( trans,
'C' ) )
THEN
643 ELSE IF( n.LT.0 )
THEN
645 ELSE IF( kl.LT.0 )
THEN
647 ELSE IF( ku.LT.0 )
THEN
649 ELSE IF( nrhs.LT.0 )
THEN
651 ELSE IF( ldab.LT.kl+ku+1 )
THEN
653 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
655 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
656 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
663 rcmin =
min( rcmin, r( j ) )
666 IF( rcmin.LE.zero )
THEN
668 ELSE IF( n.GT.0 )
THEN
669 rowcnd =
max( rcmin, smlnum ) /
min( rcmax, bignum )
674 IF( colequ .AND. info.EQ.0 )
THEN
678 rcmin =
min( rcmin, c( j ) )
679 rcmax =
max( rcmax, c( j ) )
681 IF( rcmin.LE.zero )
THEN
683 ELSE IF( n.GT.0 )
THEN
684 colcnd =
max( rcmin, smlnum ) /
min( rcmax, bignum )
690 IF( ldb.LT.
max( 1, n ) )
THEN
692 ELSE IF( ldx.LT.
max( 1, n ) )
THEN
707 CALL dgbequb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
709 IF( infequ.EQ.0 )
THEN
713 CALL dlaqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd
715 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
716 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
721 IF ( .NOT.rowequ )
THEN
726 IF ( .NOT.colequ )
THEN
736 IF( rowequ )
CALL dlascl2(n, nrhs, r, b, ldb)
738 IF( colequ )
CALL dlascl2(n, nrhs, c, b, ldb)
741 IF( nofact .OR. equil )
THEN
746 DO 30, i = kl+1, 2*kl+ku+1
747 afb( i, j ) = ab( i-kl, j )
750 CALL dgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
760 rpvgrw = dla_gbrpvgrw( n, kl, ku, info, ab, ldab, afb,
768 rpvgrw = dla_gbrpvgrw( n, kl, ku, n, ab, ldab, afb, ldafb )
772 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
773 CALL dgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
779 CALL dgbrfsx( trans, equed, n, kl, ku, nrhs, ab
781 $ n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params,
782 $ work, iwork, info )
786 IF ( colequ .AND. notran )
THEN
787 CALL dlascl2 ( n, nrhs, c, x, ldx )
788 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
789 CALL dlascl2 ( n, nrhs, r, x, ldx )
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 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