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 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 sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
subroutine slascl2(M, N, D, X, LDX)
SLASCL2 performs diagonal scaling on a vector.
real function sla_gerpvgrw(N, NCOLS, A, LDA, AF, LDAF)
SLA_GERPVGRW
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
subroutine xerbla(SRNAME, INFO)
XERBLA
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 ...
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
subroutine sgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQUB
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
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