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,
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 )
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 )
double precision function dla_gerpvgrw(N, NCOLS, A, LDA, AF, LDAF)
DLA_GERPVGRW
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 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 ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
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 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