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, LDB, LDX, N, NRHS, NPARAMS,
549 DOUBLE PRECISION RCOND, RPVGRW
552 INTEGER IPIV( * ), IWORK( * )
553 DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
554 $ X( 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.0 )
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 ) )
640 rcmax = max( rcmax, 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 IF ( .NOT.rowequ )
THEN
702 IF ( .NOT.colequ )
THEN
712 IF( rowequ )
CALL dlascl2( n, nrhs, r, b, ldb )
714 IF( colequ )
CALL dlascl2( n, nrhs, c, b, ldb )
717 IF( nofact .OR. 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 IF ( colequ .AND. notran )
THEN
757 CALL dlascl2 ( n, nrhs, c, x, ldx )
758 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
759 CALL dlascl2 ( n, nrhs, r, x, ldx )
subroutine xerbla(srname, info)
subroutine dgeequb(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
DGEEQUB
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 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 dgetrf(m, n, a, lda, ipiv, info)
DGETRF
subroutine dgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
DGETRS
double precision function dla_gerpvgrw(n, ncols, a, lda, af, ldaf)
DLA_GERPVGRW
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 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.
subroutine dlascl2(m, n, d, x, ldx)
DLASCL2 performs diagonal scaling on a matrix.
logical function lsame(ca, cb)
LSAME