540 SUBROUTINE cgesvxx( 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, rwork,
552 CHARACTER EQUED, FACT, TRANS
553 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
559 COMPLEX 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, * ), rwork( * )
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,
589 REAL SLAMCH, CLA_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(
'CGESVXX', -info )
689 CALL cgeequb( n, n, a, lda, r, c, rowcnd, colcnd, amax,
691 IF( infequ.EQ.0 )
THEN
695 CALL claqge( 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 clascl2( n, nrhs, r, b, ldb )
720 IF( colequ )
CALL clascl2( n, nrhs, c, b, ldb )
723 IF( nofact .OR. equil )
THEN
727 CALL clacpy(
'Full', n, n, a, lda, af, ldaf )
728 CALL cgetrf( n, n, af, ldaf, ipiv, info )
738 rpvgrw = cla_gerpvgrw( n, info, a, lda, af, ldaf )
745 rpvgrw = cla_gerpvgrw( n, n, a, lda, af, ldaf )
749 CALL clacpy(
'Full', n, nrhs, b, ldb, x, ldx )
750 CALL cgetrs( trans, n, nrhs, af, ldaf, ipiv, x, ldx, info )
755 CALL cgerfsx( 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, rwork, info )
762 IF ( colequ .AND. notran )
THEN
763 CALL clascl2 ( n, nrhs, c, x, ldx )
764 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
765 CALL clascl2 ( n, nrhs, r, x, ldx )
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 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 xerbla(SRNAME, INFO)
XERBLA
subroutine cgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
CGEEQUB
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 vector.
subroutine cgetrf(M, N, A, LDA, IPIV, INFO)
CGETRF
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 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 ...
logical function lsame(CA, CB)
LSAME