560 SUBROUTINE cgbsvxx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
561 $ ldafb, ipiv, equed, r, c,
b, ldb, x, ldx,
562 $ rcond, rpvgrw, berr, n_err_bnds,
563 $ err_bnds_norm, err_bnds_comp, nparams, params,
564 $ work, rwork, info )
572 CHARACTER equed, fact, trans
573 INTEGER info, ldab, ldafb, ldb, ldx, n, nrhs, nparams,
579 COMPLEX ab( ldab, * ), afb( ldafb, * ),
b( ldb, * ),
580 $ x( ldx , * ),work( * )
581 REAL r( * ), c( * ), params( * ), berr( * ),
582 $ err_bnds_norm( nrhs, * ),
583 $ err_bnds_comp( nrhs, * ), rwork( * )
590 parameter( zero = 0.0e+0, one = 1.0e+0 )
591 INTEGER final_nrm_err_i, final_cmp_err_i, berr_i
592 INTEGER rcond_i, nrm_rcond_i, nrm_err_i, cmp_rcond_i
593 INTEGER cmp_err_i, piv_growth_i
594 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
596 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
597 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
601 LOGICAL colequ, equil, nofact, notran, rowequ
602 INTEGER infequ, i,
j, kl, ku
603 REAL amax, bignum, colcnd, rcmax, rcmin,
621 nofact =
lsame( fact,
'N' )
622 equil =
lsame( fact,
'E' )
623 notran =
lsame( trans,
'N' )
624 smlnum =
slamch(
'Safe minimum' )
625 bignum = one / smlnum
626 IF( nofact .OR. equil )
THEN
631 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
632 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
643 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
644 $
lsame( fact,
'F' ) )
THEN
646 ELSE IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) .AND. .NOT.
647 $
lsame( trans,
'C' ) )
THEN
649 ELSE IF( n.LT.0 )
THEN
651 ELSE IF( kl.LT.0 )
THEN
653 ELSE IF( ku.LT.0 )
THEN
655 ELSE IF( nrhs.LT.0 )
THEN
657 ELSE IF( ldab.LT.kl+ku+1 )
THEN
659 ELSE IF( ldafb.LT.2*kl+ku+1 )
THEN
661 ELSE IF(
lsame( fact,
'F' ) .AND. .NOT.
662 $ ( rowequ .OR. colequ .OR.
lsame( equed,
'N' ) ) )
THEN
669 rcmin = min( rcmin, r(
j ) )
670 rcmax = max( rcmax, r(
j ) )
672 IF( rcmin.LE.zero )
THEN
674 ELSE IF( n.GT.0 )
THEN
675 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
680 IF( colequ .AND. info.EQ.0 )
THEN
684 rcmin = min( rcmin, c(
j ) )
685 rcmax = max( rcmax, c(
j ) )
687 IF( rcmin.LE.zero )
THEN
689 ELSE IF( n.GT.0 )
THEN
690 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
696 IF( ldb.LT.max( 1, n ) )
THEN
698 ELSE IF( ldx.LT.max( 1, n ) )
THEN
705 CALL
xerbla(
'CGBSVXX', -info )
713 CALL
cgbequb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
715 IF( infequ.EQ.0 )
THEN
719 CALL
claqgb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
721 rowequ =
lsame( equed,
'R' ) .OR.
lsame( equed,
'B' )
722 colequ =
lsame( equed,
'C' ) .OR.
lsame( equed,
'B' )
727 IF ( .NOT.rowequ )
THEN
732 IF ( .NOT.colequ )
THEN
742 IF( rowequ ) CALL
clascl2( n, nrhs, r,
b, ldb )
744 IF( colequ ) CALL
clascl2( n, nrhs, c,
b, ldb )
747 IF( nofact .OR. equil )
THEN
752 DO 30, i = kl+1, 2*kl+ku+1
753 afb( i,
j ) = ab( i-kl,
j )
756 CALL
cgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
774 rpvgrw =
cla_gbrpvgrw( n, kl, ku, n, ab, ldab, afb, ldafb )
778 CALL
clacpy(
'Full', n, nrhs,
b, ldb, x, ldx )
779 CALL
cgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
785 CALL
cgbrfsx( trans, equed, n, kl, ku, nrhs, ab, ldab, afb, ldafb,
786 $ ipiv, r, c,
b, ldb, x, ldx, rcond, berr,
787 $ n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params,
788 $ work, rwork, info )
793 IF ( colequ .AND. notran )
THEN
794 CALL
clascl2( n, nrhs, c, x, ldx )
795 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
796 CALL
clascl2( n, nrhs, r, x, ldx )
subroutine clascl2(M, N, D, X, LDX)
CLASCL2 performs diagonal scaling on a vector.
subroutine claqgb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, EQUED)
CLAQGB scales a general band matrix, using row and column scaling factors computed by sgbequ...
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine cgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQUB
subroutine cgbsvxx(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)
CGBSVXX computes the solution to system of linear equations A * X = B for GB matrices ...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
real function slamch(CMACH)
SLAMCH
subroutine cgbrfsx(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)
CGBRFSX
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
real function cla_gbrpvgrw(N, KL, KU, NCOLS, AB, LDAB, AFB, LDAFB)
CLA_GBRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a general banded matrix...
subroutine cgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
CGBTRS
subroutine cgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
CGBTRF