537 SUBROUTINE zgesvxx( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
538 $ equed, r, c, b, ldb, x, ldx, rcond, rpvgrw,
539 $ berr, n_err_bnds, err_bnds_norm,
540 $ err_bnds_comp, nparams, params, work, rwork,
549 CHARACTER EQUED, FACT, TRANS
550 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS, NPARAMS,
552 DOUBLE PRECISION RCOND, RPVGRW
556 COMPLEX*16 A( lda, * ), AF( ldaf, * ), B( ldb, * ),
557 $ x( ldx , * ),work( * )
558 DOUBLE PRECISION R( * ), C( * ), PARAMS( * ), BERR( * ),
559 $ err_bnds_norm( nrhs, * ),
560 $ err_bnds_comp( nrhs, * ), rwork( * )
566 DOUBLE PRECISION ZERO, ONE
567 parameter ( zero = 0.0d+0, one = 1.0d+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 DOUBLE PRECISION AMAX, BIGNUM, COLCND, RCMAX, RCMIN,
586 DOUBLE PRECISION DLAMCH, ZLA_GERPVGRW
598 nofact = lsame( fact,
'N' )
599 equil = lsame( fact,
'E' )
600 notran = lsame( trans,
'N' )
601 smlnum = dlamch(
'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(
'ZGESVXX', -info )
686 CALL zgeequb( n, n, a, lda, r, c, rowcnd, colcnd, amax,
688 IF( infequ.EQ.0 )
THEN
692 CALL zlaqge( 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 zlascl2( n, nrhs, r, b, ldb )
717 IF( colequ )
CALL zlascl2( n, nrhs, c, b, ldb )
720 IF( nofact .OR. equil )
THEN
724 CALL zlacpy(
'Full', n, n, a, lda, af, ldaf )
725 CALL zgetrf( n, n, af, ldaf, ipiv, info )
735 rpvgrw = zla_gerpvgrw( n, info, a, lda, af, ldaf )
742 rpvgrw = zla_gerpvgrw( n, n, a, lda, af, ldaf )
746 CALL zlacpy(
'Full', n, nrhs, b, ldb, x, ldx )
747 CALL zgetrs( trans, n, nrhs, af, ldaf, ipiv, x, ldx, info )
752 CALL zgerfsx( 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 zlascl2 ( n, nrhs, c, x, ldx )
761 ELSE IF ( rowequ .AND. .NOT.notran )
THEN
762 CALL zlascl2 ( n, nrhs, r, x, ldx )
subroutine zgesvxx(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)
ZGESVXX computes the solution to system of linear equations A * X = B for GE matrices ...
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQUB
double precision function dlamch(CMACH)
DLAMCH
subroutine zgerfsx(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)
ZGERFSX
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlaqge(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, EQUED)
ZLAQGE scales a general rectangular matrix, using row and column scaling factors computed by sgeequ...
double precision function zla_gerpvgrw(N, NCOLS, A, LDA, AF, LDAF)
ZLA_GERPVGRW multiplies a square real matrix by a complex matrix.
logical function lsame(CA, CB)
LSAME
subroutine zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a vector.