538 SUBROUTINE sgesvxx( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
539 $ EQUED, R, C, B, LDB, X, LDX, RCOND, RPVGRW,
540 $ BERR, N_ERR_BNDS, ERR_BNDS_NORM,
541 $ ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK,
549 CHARACTER EQUED, FACT, TRANS
550 INTEGER INFO, LDA, LDAF, LDB, LDX, , NRHS, NPARAMS,
555 INTEGER IPIV( * ), IWORK( * )
556 REAL A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
557 $ X( LDX , * ),WORK( * )
558 REAL R( * ), C( * ), PARAMS( * ), BERR( * ),
559 $ err_bnds_norm( nrhs, * ),
560 $ err_bnds_comp( nrhs, * )
568 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
569 INTEGER 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 REAL , BIGNUM, COLCND, RCMAX, RCMIN, ROWCND,
586 REAL SLAMCH, SLA_GERPVGRW
598 nofact = lsame( fact, 'n
' )
599 EQUIL = LSAME( FACT, 'e
' )
600 NOTRAN = LSAME( TRANS, 'n
' )
601 SMLNUM = SLAMCH( 'safe minimum
' )
602 BIGNUM = ONE / SMLNUM
603.OR.
IF( NOFACT EQUIL ) THEN
608 ROWEQU = LSAME( EQUED, 'r.OR.
' ) LSAME( EQUED, 'b
' )
609 COLEQU = LSAME( EQUED, 'c.OR.
' ) LSAME( EQUED, 'b
' )
620.NOT..AND..NOT..AND..NOT.
IF( NOFACT EQUIL
621 $ LSAME( FACT, 'f
' ) ) THEN
623.NOT..AND..NOT.
ELSE IF( NOTRAN LSAME( TRANS, 't.AND..NOT.
' )
624 $ LSAME( TRANS, 'c
' ) ) THEN
626.LT.
ELSE IF( N0 ) THEN
628.LT.
ELSE IF( NRHS0 ) THEN
630.LT.
ELSE IF( LDAMAX( 1, N ) ) THEN
632.LT.
ELSE IF( LDAFMAX( 1, N ) ) THEN
634 ELSE IF( LSAME( FACT, 'f.AND..NOT.
' )
635.OR..OR.
$ ( ROWEQU COLEQU LSAME( EQUED, 'n
' ) ) ) THEN
642 RCMIN = MIN( RCMIN, R( J ) )
643 RCMAX = MAX( RCMAX, R( J ) )
645.LE.
IF( RCMINZERO ) THEN
647.GT.
ELSE IF( N0 ) THEN
648 ROWCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
653.AND..EQ.
IF( COLEQU INFO0 ) THEN
657 RCMIN = MIN( RCMIN, C( J ) )
658 RCMAX = MAX( RCMAX, C( J ) )
660.LE.
IF( RCMINZERO ) THEN
662.GT.
ELSE IF( N0 ) THEN
663 COLCND = MAX( RCMIN, SMLNUM ) / MIN( RCMAX, BIGNUM )
669.LT.
IF( LDBMAX( 1, N ) ) THEN
671.LT.
ELSE IF( LDXMAX( 1, N ) ) THEN
678 CALL XERBLA( 'sgesvxx', -INFO )
686 CALL SGEEQUB( N, N, A, LDA, R, C, ROWCND, COLCND, AMAX,
688.EQ.
IF( INFEQU0 ) THEN
692 CALL SLAQGE( 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.NOT.
IF ( ROWEQU ) THEN
705.NOT.
IF ( COLEQU ) THEN
715 IF( ROWEQU ) CALL SLASCL2( N, NRHS, R, B, LDB )
717 IF( COLEQU ) CALL SLASCL2( N, NRHS, C, B, LDB )
720.OR.
IF( NOFACT EQUIL ) THEN
724 CALL SLACPY( 'full
', N, N, A, LDA, AF, LDAF )
725 CALL SGETRF( N, N, AF, LDAF, IPIV, INFO )
735 RPVGRW = SLA_GERPVGRW( N, INFO, A, LDA, AF, LDAF )
742 RPVGRW = SLA_GERPVGRW( N, N, A, LDA, AF, LDAF )
746 CALL SLACPY( 'full
', N, NRHS, B, LDB, X, LDX )
747 CALL SGETRS( TRANS, N, NRHS, AF, LDAF, IPIV, X, LDX, INFO )
752 CALL SGERFSX( 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.AND.
IF ( COLEQU NOTRAN ) THEN
760 CALL SLASCL2 ( N, NRHS, C, X, LDX )
761.AND..NOT.
ELSE IF ( ROWEQU NOTRAN ) THEN
762 CALL SLASCL2 ( N, NRHS, R, X, LDX )
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
subroutine xerbla(srname, info)
XERBLA
logical function lsame(ca, cb)
LSAME
subroutine slaqge(m, n, a, lda, r, c, rowcnd, colcnd, amax, equed)
SLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ.
subroutine sgetrf(m, n, a, lda, ipiv, info)
SGETRF
subroutine sgerfsx(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)
SGERFSX
subroutine sgeequb(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
SGEEQUB
subroutine sgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
SGETRS
real function sla_gerpvgrw(n, ncols, a, lda, af, ldaf)
SLA_GERPVGRW
subroutine sgesvxx(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)
SGESVXX computes the solution to system of linear equations A * X = B for GE matrices
subroutine slascl2(m, n, d, x, ldx)
SLASCL2 performs diagonal scaling on a vector.
real function slamch(cmach)
SLAMCH