540 SUBROUTINE sgesvxx( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
541 $ equed, r, c, b, ldb, x, ldx, rcond, rpvgrw,
542 $ berr, n_err_bnds, err_bnds_norm,
543 $ err_bnds_comp, nparams, params, work, iwork,
552 CHARACTER EQUED, FACT, TRANS
553 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
558 INTEGER IPIV( * ), IWORK( * )
559 REAL A( lda, * ), AF( ldaf, * ), B( ldb, * ),
560 $ x( ldx , * ),work( * )
561 REAL R( * ), C( * ), PARAMS( * ), BERR( * ),
562 $ err_bnds_norm( nrhs, * ),
563 $ err_bnds_comp( nrhs, * )
570 parameter( zero = 0.0e+0, one = 1.0e+0 )
571 INTEGER FINAL_NRM_ERR_I, FINAL_CMP_ERR_I, BERR_I
572 INTEGER RCOND_I, NRM_RCOND_I, NRM_ERR_I, CMP_RCOND_I
573 INTEGER CMP_ERR_I, PIV_GROWTH_I
574 parameter( final_nrm_err_i = 1, final_cmp_err_i = 2,
576 parameter( rcond_i = 4, nrm_rcond_i = 5, nrm_err_i = 6 )
577 parameter( cmp_rcond_i = 7, cmp_err_i = 8,
581 LOGICAL COLEQU, EQUIL, NOFACT, NOTRAN, ROWEQU
583 REAL AMAX, BIGNUM, COLCND, RCMAX, RCMIN, ROWCND,
589 REAL SLAMCH, SLA_GERPVGRW
601 nofact = lsame( fact,
'N' )
602 equil = lsame( fact,
'E' )
603 notran = lsame( trans,
'N' )
604 smlnum = slamch(
'Safe minimum' )
605 bignum = one / smlnum
606 IF( nofact .OR. equil )
THEN
611 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
612 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
623 IF( .NOT.nofact .AND. .NOT.equil .AND. .NOT.
624 $ lsame( fact,
'F' ) )
THEN
626 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
627 $ lsame( trans,
'C' ) )
THEN
629 ELSE IF( n.LT.0 )
THEN
631 ELSE IF( nrhs.LT.0 )
THEN
633 ELSE IF( lda.LT.max( 1, n ) )
THEN
635 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
637 ELSE IF( lsame( fact,
'F' ) .AND. .NOT.
638 $ ( rowequ .OR. colequ .OR. lsame( equed,
'N' ) ) )
THEN
645 rcmin = min( rcmin, r( j ) )
646 rcmax = max( rcmax, r( j ) )
648 IF( rcmin.LE.zero )
THEN
650 ELSE IF( n.GT.0 )
THEN
651 rowcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
656 IF( colequ .AND. info.EQ.0 )
THEN
660 rcmin = min( rcmin, c( j ) )
661 rcmax = max( rcmax, c( j ) )
663 IF( rcmin.LE.zero )
THEN
665 ELSE IF( n.GT.0 )
THEN
666 colcnd = max( rcmin, smlnum ) / min( rcmax, bignum )
672 IF( ldb.LT.max( 1, n ) )
THEN
674 ELSE IF( ldx.LT.max( 1, n ) )
THEN
681 CALL
xerbla(
'SGESVXX', -info )
689 CALL
sgeequb( n, n, a, lda, r, c, rowcnd, colcnd, amax,
691 IF( infequ.EQ.0 )
THEN
695 CALL
slaqge( n, n, a, lda, r, c, rowcnd, colcnd, amax,
697 rowequ = lsame( equed,
'R' ) .OR. lsame( equed,
'B' )
698 colequ = lsame( equed,
'C' ) .OR. lsame( equed,
'B' )
703 IF ( .NOT.rowequ )
THEN
708 IF ( .NOT.colequ )
THEN
718 IF( rowequ ) CALL
slascl2( n, nrhs, r, b, ldb )
720 IF( colequ ) CALL
slascl2( n, nrhs, c, b, ldb )
723 IF( nofact .OR. equil )
THEN
727 CALL
slacpy(
'Full', n, n, a, lda, af, ldaf )
728 CALL
sgetrf( n, n, af, ldaf, ipiv, info )
738 rpvgrw = sla_gerpvgrw( n, info, a, lda, af, ldaf )
745 rpvgrw = sla_gerpvgrw( n, n, a, lda, af, ldaf )
749 CALL
slacpy(
'Full', n, nrhs, b, ldb, x, ldx )
750 CALL
sgetrs( trans, n, nrhs, af, ldaf, ipiv, x, ldx, info )
755 CALL
sgerfsx( trans, equed, n, nrhs, a, lda, af, ldaf,
756 $ ipiv, r, c, b, ldb, x, ldx, rcond, berr,
757 $ n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params,
758 $ work, iwork, info )
762 IF ( colequ .AND. notran )
THEN
763 CALL
slascl2( n, nrhs, c, x, ldx )
764 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
765 CALL
slascl2( n, nrhs, r, x, ldx )
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
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 xerbla(SRNAME, INFO)
XERBLA
subroutine slascl2(M, N, D, X, LDX)
SLASCL2 performs diagonal scaling on a vector.
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQUB
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 ...