553 SUBROUTINE dgbsvxx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB,
555 $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
556 $ RCOND, RPVGRW, BERR, N_ERR_BNDS,
557 $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS,
558 $ WORK, IWORK, INFO )
565 CHARACTER EQUED, FACT, TRANS
566 INTEGER INFO, LDAB, LDAFB, LDB, LDX, N, NRHS, NPARAMS,
568 DOUBLE PRECISION RCOND, RPVGRW
571 INTEGER IPIV( * ), IWORK( * )
572 DOUBLE PRECISION AB( LDAB, * ), AFB( LDAFB, * ), B( LDB, * ),
573 $ x( ldx , * ),work( * )
574 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
575 $ ERR_BNDS_NORM( NRHS, * ),
576 $ err_bnds_comp( nrhs, * )
582 DOUBLE PRECISION ZERO, ONE
583 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
584 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
585 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
586 INTEGER CMP_ERR_I, PIV_GROWTH_I
587 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
589 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
590 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
594 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
596 DOUBLE PRECISION AMAX, BIGNUM, COLCND, RCMAX, RCMIN,
602 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 ) )
664 rcmax = max( rcmax, 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
699 CALL xerbla(
'DGBSVXX', -info )
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,
716 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
717 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
722 IF ( .NOT.rowequ )
THEN
727 IF ( .NOT.colequ )
THEN
737 IF( rowequ )
CALL dlascl2(n, nrhs, r, b, ldb)
739 IF( colequ )
CALL dlascl2(n, nrhs, c, b, ldb)
742 IF( nofact .OR. equil )
THEN
747 DO 30, i = kl+1, 2*kl+ku+1
748 afb( i, j ) = ab( i-kl, j )
751 CALL dgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
761 rpvgrw = dla_gbrpvgrw( n, kl, ku, info, ab, ldab, afb,
769 rpvgrw = dla_gbrpvgrw( n, kl, ku, n, ab, ldab, afb, ldafb )
773 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
774 CALL dgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
780 CALL dgbrfsx( trans, equed, n, kl, ku, nrhs, ab, ldab, afb,
782 $ ipiv, r, c, b, ldb, x, ldx, rcond, berr,
783 $ n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params,
784 $ work, iwork, info )
788 IF ( colequ .AND. notran )
THEN
789 CALL dlascl2 ( n, nrhs, c, x, ldx )
790 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
791 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