558 SUBROUTINE cgbsvxx( FACT, TRANS, N, KL, KU, NRHS, AB, LDAB, AFB,
559 $ LDAFB, IPIV, EQUED, R, C, B, LDB, X, LDX,
560 $ RCOND, RPVGRW, BERR, N_ERR_BNDS,
561 $ ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS,
562 $ WORK, RWORK, INFO )
569 CHARACTER EQUED, FACT, TRANS
570 INTEGER INFO, LDAB, LDAFB, LDB, LDX, N, NRHS, NPARAMS,
576 COMPLEX AB( ldab, * ), AFB( ldafb, * ), B( ldb, * ),
577 $ x( ldx , * ),work( * )
578 REAL R( * ), C( * ), PARAMS( * ), BERR( * ),
579 $ err_bnds_norm( nrhs, * ),
580 $ err_bnds_comp( nrhs, * ), rwork( * )
587 parameter( zero = 0.0e+0, one = 1.0e+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 REAL AMAX, BIGNUM, COLCND, RCMAX, RCMIN,
606 REAL SLAMCH, CLA_GBRPVGRW
618 nofact = lsame( fact,
'N' )
619 equil = lsame( fact,
'E' )
620 notran = lsame( trans,
'N' )
621 smlnum = slamch(
'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(
'CGBSVXX', -info )
710 CALL cgbequb( n, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd,
712 IF( infequ.EQ.0 )
THEN 716 CALL claqgb( 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 clascl2( n, nrhs, r, b, ldb )
741 IF( colequ )
CALL clascl2( 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 cgbtrf( n, n, kl, ku, afb, ldafb, ipiv, info )
763 rpvgrw = cla_gbrpvgrw( n, kl, ku, info, ab, ldab, afb,
771 rpvgrw = cla_gbrpvgrw( n, kl, ku, n, ab, ldab, afb, ldafb )
775 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
776 CALL cgbtrs( trans, n, kl, ku, nrhs, afb, ldafb, ipiv, x, ldx,
782 CALL cgbrfsx( 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 clascl2( n, nrhs, c, x, ldx )
792 ELSE IF ( rowequ .AND. .NOT.notran )
THEN 793 CALL clascl2( n, nrhs, r, x, ldx )
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
logical function lsame(CA, CB)
LSAME
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
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 xerbla(SRNAME, INFO)
XERBLA
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 clascl2(M, N, D, X, LDX)
CLASCL2 performs diagonal scaling on a matrix.
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
subroutine cgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
CGBEQUB
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...
real function slamch(CMACH)
SLAMCH