535 SUBROUTINE dgesvxx( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
536 $ EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW,
537 $ BERR, N_ERR_BNDS, ERR_BNDS_NORM,
538 $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK,
546 CHARACTER EQUED, FACT, TRANS
547 INTEGER INFO, LDA, LDAF
549DOUBLE PRECISION , RPVGRW
552 INTEGER IPIV( * ), IWORK( * )
553 DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
554 $ ( LDX , * ),WORK( * )
555 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
556 $ err_bnds_norm( nrhs, * ),
557 $ err_bnds_comp( nrhs, * )
563 DOUBLE PRECISION ZERO, ONE
564 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
565 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
566 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
567 INTEGER CMP_ERR_I, PIV_GROWTH_I
568 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
570 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
571 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
575 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
577 DOUBLE PRECISION AMAX, BIGNUM, COLCND, RCMAX, RCMIN, ROWCND,
583 DOUBLE PRECISION DLAMCH, DLA_GERPVGRW
595 nofact = lsame( fact,
'N' )
596 equil = lsame( fact,
'E' )
597 notran = lsame( trans,
'N' )
598 smlnum = dlamch(
'Safe minimum' )
599 bignum = one / smlnum
600 IF( nofact .OR. equil )
THEN
605 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
606 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
617 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
618 $ lsame( fact,
'F' ) )
THEN
620 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
621 $ lsame( trans,
'C' ) )
THEN
623 ELSE IF( n.LT.0 )
THEN
625 ELSE IF( nrhs.LT.
THEN
627 ELSE IF( lda.LT.
max( 1, n ) )
THEN
629 ELSE IF( ldaf.LT.
max( 1, n ) )
THEN
631 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
632 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
639 rcmin =
min( rcmin, r( j ) )
642 IF( rcmin.LE.zero )
THEN
644 ELSE IF( n.GT.0 )
THEN
645 rowcnd =
max( rcmin, smlnum ) /
min( rcmax, bignum )
650 IF( colequ .AND. info.EQ.0 )
THEN
654 rcmin =
min( rcmin, c( j ) )
655 rcmax =
max( rcmax, c( j ) )
657 IF( rcmin.LE.zero )
THEN
659 ELSE IF( n.GT.0 )
THEN
660 colcnd =
max( rcmin, smlnum ) /
min( rcmax, bignum )
666 IF( ldb.LT.
max( 1, n ) )
THEN
668 ELSE IF( ldx.LT.
max( 1, n ) )
THEN
675 CALL xerbla(
'DGESVXX', -info )
683 CALL dgeequb( n, n, a, lda, r, c, rowcnd, colcnd, amax,
685 IF( infequ.EQ.0 )
THEN
689 CALL dlaqge( n, n, a, lda, r, c, rowcnd, colcnd, amax,
691 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
692 colequ = lsame( equed, 'c.OR.
' ) LSAME( EQUED, 'b
' )
697.NOT.
IF ( ROWEQU ) THEN
702.NOT.
IF ( COLEQU ) THEN
712 IF( ROWEQU ) CALL DLASCL2( N, NRHS, R, B, LDB )
714 IF( COLEQU ) CALL DLASCL2( N, NRHS, C, B, LDB )
717.OR.
IF( NOFACT EQUIL ) THEN
721 CALL DLACPY( 'full
', N, N, A, LDA, AF, LDAF )
722 CALL DGETRF( N, N, AF, LDAF, IPIV, INFO )
732 RPVGRW = DLA_GERPVGRW( N, INFO, A, LDA, AF, LDAF )
739 RPVGRW = DLA_GERPVGRW( N, N, A, LDA, AF, LDAF )
743 CALL DLACPY( 'full
', N, NRHS, B, LDB, X, LDX )
744 CALL DGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
749 CALL DGERFSX( TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF,
750 $ IPIV, R, C, B, LDB, X, LDX, RCOND, BERR,
751 $ N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS,
752 $ WORK, IWORK, INFO )
756.AND.
IF ( COLEQU NOTRAN ) THEN
757 CALL DLASCL2 ( N, NRHS, C, X, LDX )
758.AND..NOT.
ELSE IF ( ROWEQU NOTRAN ) THEN
759 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.
subroutine xerbla(srname, info)
XERBLA
logical function lsame(ca, cb)
LSAME
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 dla_gerpvgrw(n, ncols, a, lda, af, ldaf)
DLA_GERPVGRW
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 dgetrf(m, n, a, lda, ipiv, info)
DGETRF
subroutine dgeequb(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
DGEEQUB
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 dlascl2(m, n, d, x, ldx)
DLASCL2 performs diagonal scaling on a vector.
double precision function dlamch(cmach)
DLAMCH