537 SUBROUTINE dgesvxx( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
538 $ equed, r, c, b, ldb, x, ldx, rcond, rpvgrw,
539 $ berr, n_err_bnds, err_bnds_norm,
540 $ err_bnds_comp, nparams, params, work, iwork,
549 CHARACTER EQUED, FACT, TRANS
550 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
552 DOUBLE PRECISION RCOND, RPVGRW
555 INTEGER IPIV( * ), IWORK( * )
556 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), B( ldb, * ),
557 $ x( ldx , * ),work( * )
558 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
559 $ err_bnds_norm( nrhs, * ),
560 $ err_bnds_comp( nrhs, * )
566 DOUBLE PRECISION ZERO, ONE
567 parameter ( zero = 0.0d+0, one = 1.0d+0 )
568 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
569 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
570 INTEGER CMP_ERR_I, PIV_GROWTH_I
571 parameter ( final_nrm_err_i = 1, final_cmp_err_i = 2,
573 parameter ( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
574 parameter ( cmp_rcond_i = 7, cmp_err_i = 8,
578 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
580 DOUBLE PRECISION AMAX, BIGNUM, COLCND, RCMAX, RCMIN, ROWCND,
586 DOUBLE PRECISION DLAMCH, DLA_GERPVGRW
598 nofact = lsame( fact,
'N' )
599 equil = lsame( fact,
'E' )
600 notran = lsame( trans,
'N' )
601 smlnum = dlamch(
'Safe minimum' )
602 bignum = one / smlnum
603 IF( nofact .OR. equil )
THEN
608 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
609 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
620 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
621 $ lsame( fact,
'F' ) )
THEN
623 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
624 $ lsame( trans,
'C' ) )
THEN
626 ELSE IF( n.LT.0 )
THEN
628 ELSE IF( nrhs.LT.0 )
THEN
630 ELSE IF( lda.LT.max( 1, n ) )
THEN
632 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
634 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
635 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
642 rcmin = min( rcmin, r( j ) )
643 rcmax = max( rcmax, r( j ) )
645 IF( rcmin.LE.zero )
THEN
647 ELSE IF( n.GT.0 )
THEN
648 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
653 IF( colequ .AND. info.EQ.0 )
THEN
657 rcmin = min( rcmin, c( j ) )
658 rcmax = max( rcmax, c( j ) )
660 IF( rcmin.LE.zero )
THEN
662 ELSE IF( n.GT.0 )
THEN
663 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
669 IF( ldb.LT.max( 1, n ) )
THEN
671 ELSE IF( ldx.LT.max( 1, n ) )
THEN
678 CALL xerbla(
'DGESVXX', -info )
686 CALL dgeequb( n, n, a, lda, r, c, rowcnd, colcnd, amax,
688 IF( infequ.EQ.0 )
THEN
692 CALL dlaqge( n, n, a, lda, r, c, rowcnd, colcnd, amax,
694 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
695 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
700 IF ( .NOT.rowequ )
THEN
705 IF ( .NOT.colequ )
THEN
715 IF( rowequ )
CALL dlascl2( n, nrhs, r, b, ldb )
717 IF( colequ )
CALL dlascl2( n, nrhs, c, b, ldb )
720 IF( nofact .OR. equil )
THEN
724 CALL dlacpy(
'Full', n, n, a, lda, af, ldaf )
725 CALL dgetrf( n, n, af, ldaf, ipiv, info )
735 rpvgrw = dla_gerpvgrw( n, info, a, lda, af, ldaf )
742 rpvgrw = dla_gerpvgrw( n, n, a, lda, af, ldaf )
746 CALL dlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
747 CALL dgetrs( trans, n, nrhs, af, ldaf, ipiv, x, ldx, info )
752 CALL dgerfsx( trans, equed, n, nrhs, a, lda, af, ldaf,
753 $ ipiv, r, c, b, ldb, x, ldx, rcond, berr,
754 $ n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params,
755 $ work, iwork, info )
759 IF ( colequ .AND. notran )
THEN
760 CALL dlascl2 ( n, nrhs, c, x, ldx )
761 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
762 CALL dlascl2 ( n, nrhs, r, x, ldx )
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
subroutine dlaqge(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, EQUED)
DLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ...
double precision function dlamch(CMACH)
DLAMCH
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlascl2(M, N, D, X, LDX)
DLASCL2 performs diagonal scaling on a vector.
subroutine dgesvxx(FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, 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)
DGESVXX computes the solution to system of linear equations A * X = B for GE matrices ...
subroutine dgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQUB
double precision function dla_gerpvgrw(N, NCOLS, A, LDA, AF, LDAF)
DLA_GERPVGRW
subroutine dgerfsx(TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DGERFSX
logical function lsame(CA, CB)
LSAME