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 dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
double precision function dlamch(CMACH)
DLAMCH
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
subroutine dgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQUB
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
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
subroutine dlascl2(M, N, D, X, LDX)
DLASCL2 performs diagonal scaling on a vector.
subroutine xerbla(SRNAME, INFO)
XERBLA
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 ...
logical function lsame(CA, CB)
LSAME
double precision function dla_gerpvgrw(N, NCOLS, A, LDA, AF, LDAF)
DLA_GERPVGRW
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...