538 SUBROUTINE cgesvxx( 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, RWORK,
549 CHARACTER EQUED, FACT, TRANS
550 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
556 COMPLEX 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, * ), rwork( * )
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,
586 REAL SLAMCH, CLA_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(
'CGESVXX', -info )
686 CALL cgeequb( n, n, a, lda, r, c, rowcnd, colcnd, amax,
688 IF( infequ.EQ.0 )
THEN
692 CALL claqge( 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 clascl2( n, nrhs, r, b, ldb )
717 IF( colequ )
CALL clascl2( n, nrhs, c, b, ldb )
720 IF( nofact .OR. equil )
THEN
724 CALL clacpy(
'Full', n, n, a, lda, af, ldaf )
725 CALL cgetrf( n, n, af, ldaf, ipiv, info )
735 rpvgrw = cla_gerpvgrw( n, info, a, lda, af, ldaf )
742 rpvgrw = cla_gerpvgrw( n, n, a, lda, af, ldaf )
746 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
747 CALL cgetrs( trans, n, nrhs, af, ldaf, ipiv, x, ldx, info )
752 CALL cgerfsx( 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, rwork, info )
759 IF ( colequ .AND. notran )
THEN
760 CALL clascl2 ( n, nrhs, c, x, ldx )
761 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
762 CALL clascl2 ( n, nrhs, r, x, ldx )
subroutine xerbla(srname, info)
subroutine cgeequb(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
CGEEQUB
subroutine cgerfsx(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, rwork, info)
CGERFSX
subroutine cgesvxx(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, rwork, info)
CGESVXX computes the solution to system of linear equations A * X = B for GE matrices
subroutine cgetrf(m, n, a, lda, ipiv, info)
CGETRF
subroutine cgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
CGETRS
real function cla_gerpvgrw(n, ncols, a, lda, af, ldaf)
CLA_GERPVGRW multiplies a square real matrix by a complex matrix.
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
real function slamch(cmach)
SLAMCH
subroutine claqge(m, n, a, lda, r, c, rowcnd, colcnd, amax, equed)
CLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ.
subroutine clascl2(m, n, d, x, ldx)
CLASCL2 performs diagonal scaling on a matrix.
logical function lsame(ca, cb)
LSAME