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, N, 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, * )
567 parameter( zero = 0.0e+0, one = 1.0e+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 REAL AMAX, 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 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(
'SGESVXX', -info )
686 CALL sgeequb( n, n, a, lda, r, c, rowcnd, colcnd, amax,
688 IF( infequ.EQ.0 )
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 IF ( .NOT.rowequ )
THEN 705 IF ( .NOT.colequ )
THEN 715 IF( rowequ )
CALL slascl2( n, nrhs, r, b, ldb )
717 IF( colequ )
CALL slascl2( n, nrhs, c, b, ldb )
720 IF( nofact .OR. 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 IF ( colequ .AND. notran )
THEN 760 CALL slascl2 ( n, nrhs, c, x, ldx )
761 ELSE IF ( rowequ .AND. .NOT.notran )
THEN 762 CALL slascl2 ( n, nrhs, r, x, ldx )
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
logical function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
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 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 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...
real function sla_gerpvgrw(N, NCOLS, A, LDA, AF, LDAF)
SLA_GERPVGRW
subroutine slascl2(M, N, D, X, LDX)
SLASCL2 performs diagonal scaling on a matrix.
real function slamch(CMACH)
SLAMCH
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.