557 SUBROUTINE zgbsvxx( 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, rwork, info )
569 CHARACTER equed, fact, trans
570 INTEGER info, ldab, ldafb, ldb, ldx, n, nrhs, nparams,
572 DOUBLE PRECISION rcond, rpvgrw
576 COMPLEX*16 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, * ), rwork( * )
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
599 INTEGER infequ, i,
j, kl, ku
600 DOUBLE PRECISION amax, bignum, colcnd, rcmax, rcmin,
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(
'ZGBSVXX', -info )
710 CALL
zgbequb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
712 IF( infequ.EQ.0 )
THEN
716 CALL
zlaqgb( 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
zlascl2( n, nrhs, r,
b, ldb )
741 IF( colequ ) CALL
zlascl2( 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
zgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
771 rpvgrw =
zla_gbrpvgrw( n, kl, ku, n, ab, ldab, afb, ldafb )
775 CALL
zlacpy(
'Full', n, nrhs,
b, ldb, x, ldx )
776 CALL
zgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
782 CALL
zgbrfsx( 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, rwork, info )
790 IF ( colequ .AND. notran )
THEN
791 CALL
zlascl2( n, nrhs, c, x, ldx )
792 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
793 CALL
zlascl2( n, nrhs, r, x, ldx )
subroutine zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a vector.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zgbrfsx(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, RWORK, INFO)
ZGBRFSX
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine zlaqgb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, EQUED)
ZLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ...
subroutine zgbsvxx(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, RWORK, INFO)
ZGBSVXX computes the solution to system of linear equations A * X = B for GB matrices ...
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
double precision function zla_gbrpvgrw(N, KL, KU, NCOLS, AB, LDAB, AFB, LDAFB)
ZLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix...
subroutine zgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQUB
subroutine zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF