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 )