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,
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 )
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 zlascl2(M, N, D, X, LDX)
ZLASCL2 performs diagonal scaling on a vector.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
double precision function zla_gerpvgrw(N, NCOLS, A, LDA, AF, LDAF)
ZLA_GERPVGRW multiplies a square real matrix by a complex matrix.
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...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine zgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQUB
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 zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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 zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.