Пример #1
0
static NLboolean __nlInvert_SUPERLU(__NLContext *context) {

	/* OpenNL Context */
	NLfloat* b = (context->least_squares)? context->Mtb: context->b;
	NLfloat* x = context->x;
	NLuint n = context->n, j;

	/* SuperLU variables */
	SuperMatrix B;
	NLint info;

	for(j=0; j<context->nb_rhs; j++, b+=n, x+=n) {
		/* Create superlu array for B */
		sCreate_Dense_Matrix(
			&B, n, 1, b, n, 
			SLU_DN, /* Fortran-type column-wise storage */
			SLU_S,  /* floats						  */
			SLU_GE  /* general						  */
		);

		/* Forward/Back substitution to compute x */
		sgstrs(TRANS, &(context->slu.L), &(context->slu.U),
			context->slu.perm_c, context->slu.perm_r, &B,
			&(context->slu.stat), &info);

		if(info == 0)
			memcpy(x, ((DNformat*)B.Store)->nzval, sizeof(*x)*n);

		Destroy_SuperMatrix_Store(&B);
	}

	return (info == 0);
}
Пример #2
0
void spsolve(int n,
                  float x[], /* solution */
                  float y[]  /* right-hand side */
)
{
    SuperMatrix *A = GLOBAL_A, *L = GLOBAL_L, *U = GLOBAL_U;
    SuperLUStat_t *stat = GLOBAL_STAT;
    int *perm_c = GLOBAL_PERM_C, *perm_r = GLOBAL_PERM_R;
    char equed[1] = {'N'};
    float *R = GLOBAL_R, *C = GLOBAL_C;
    superlu_options_t *options = GLOBAL_OPTIONS;
    mem_usage_t  *mem_usage = GLOBAL_MEM_USAGE;
    int info;
    static DNformat X, Y;
    static SuperMatrix XX = {SLU_DN, SLU_S, SLU_GE, 1, 1, &X};
    static SuperMatrix YY = {SLU_DN, SLU_S, SLU_GE, 1, 1, &Y};
    float rpg, rcond;

    XX.nrow = YY.nrow = n;
    X.lda = Y.lda = n;
    X.nzval = x;
    Y.nzval = y;

#if 0
    dcopy_(&n, y, &i_1, x, &i_1);
    sgstrs(NOTRANS, L, U, perm_c, perm_r, &XX, stat, &info);
#else
    sgsisx(options, A, perm_c, perm_r, NULL, equed, R, C,
	   L, U, NULL, 0, &YY, &XX, &rpg, &rcond, NULL,
	   mem_usage, stat, &info);
#endif
}
Пример #3
0
void
psgssvx(int nprocs, superlumt_options_t *superlumt_options, SuperMatrix *A,
        int *perm_c, int *perm_r, equed_t *equed, float *R, float *C,
        SuperMatrix *L, SuperMatrix *U,
        SuperMatrix *B, SuperMatrix *X, float *recip_pivot_growth,
        float *rcond, float *ferr, float *berr,
        superlu_memusage_t *superlu_memusage, int *info)
{
    /*
     * -- SuperLU MT routine (version 2.0) --
     * Lawrence Berkeley National Lab, Univ. of California Berkeley,
     * and Xerox Palo Alto Research Center.
     * September 10, 2007
     *
     * Purpose
     * =======
     *
     * psgssvx() solves the system of linear equations A*X=B or A'*X=B, using
     * the LU factorization from sgstrf(). Error bounds on the solution and
     * a condition estimate are also provided. It performs the following steps:
     *
     * 1. If A is stored column-wise (A->Stype = NC):
     *
     *    1.1. If fact = EQUILIBRATE, scaling factors are computed to equilibrate
     *         the system:
     *           trans = NOTRANS: diag(R)*A*diag(C)*inv(diag(C))*X = diag(R)*B
     *           trans = TRANS:  (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
     *           trans = CONJ:   (diag(R)*A*diag(C))**H *inv(diag(R))*X = diag(C)*B
     *         Whether or not the system will be equilibrated depends on the
     *         scaling of the matrix A, but if equilibration is used, A is
     *         overwritten by diag(R)*A*diag(C) and B by diag(R)*B
     *         (if trans = NOTRANS) or diag(C)*B (if trans = TRANS or CONJ).
     *
     *    1.2. Permute columns of A, forming A*Pc, where Pc is a permutation matrix
     *         that usually preserves sparsity.
     *         For more details of this step, see ssp_colorder.c.
     *
     *    1.3. If fact = DOFACT or EQUILIBRATE, the LU decomposition is used to
     *         factor the matrix A (after equilibration if fact = EQUILIBRATE) as
     *         Pr*A*Pc = L*U, with Pr determined by partial pivoting.
     *
     *    1.4. Compute the reciprocal pivot growth factor.
     *
     *    1.5. If some U(i,i) = 0, so that U is exactly singular, then the routine
     *         returns with info = i. Otherwise, the factored form of A is used to
     *         estimate the condition number of the matrix A. If the reciprocal of
     *         the condition number is less than machine precision,
     *         info = A->ncol+1 is returned as a warning, but the routine still
     *         goes on to solve for X and computes error bounds as described below.
     *
     *    1.6. The system of equations is solved for X using the factored form
     *         of A.
     *
     *    1.7. Iterative refinement is applied to improve the computed solution
     *         matrix and calculate error bounds and backward error estimates
     *         for it.
     *
     *    1.8. If equilibration was used, the matrix X is premultiplied by
     *         diag(C) (if trans = NOTRANS) or diag(R) (if trans = TRANS or CONJ)
     *         so that it solves the original system before equilibration.
     *
     * 2. If A is stored row-wise (A->Stype = NR), apply the above algorithm
     *    to the tranpose of A:
     *
     *    2.1. If fact = EQUILIBRATE, scaling factors are computed to equilibrate
     *         the system:
     *           trans = NOTRANS:diag(R)*A'*diag(C)*inv(diag(C))*X = diag(R)*B
     *           trans = TRANS: (diag(R)*A'*diag(C))**T *inv(diag(R))*X = diag(C)*B
     *           trans = CONJ:  (diag(R)*A'*diag(C))**H *inv(diag(R))*X = diag(C)*B
     *         Whether or not the system will be equilibrated depends on the
     *         scaling of the matrix A, but if equilibration is used, A' is
     *         overwritten by diag(R)*A'*diag(C) and B by diag(R)*B
     *         (if trans = NOTRANS) or diag(C)*B (if trans = TRANS or CONJ).
     *
     *    2.2. Permute columns of transpose(A) (rows of A),
     *         forming transpose(A)*Pc, where Pc is a permutation matrix that
     *         usually preserves sparsity.
     *         For more details of this step, see ssp_colorder.c.
     *
     *    2.3. If fact = DOFACT or EQUILIBRATE, the LU decomposition is used to
     *         factor the matrix A (after equilibration if fact = EQUILIBRATE) as
     *         Pr*transpose(A)*Pc = L*U, with the permutation Pr determined by
     *         partial pivoting.
     *
     *    2.4. Compute the reciprocal pivot growth factor.
     *
     *    2.5. If some U(i,i) = 0, so that U is exactly singular, then the routine
     *         returns with info = i. Otherwise, the factored form of transpose(A)
     *         is used to estimate the condition number of the matrix A.
     *         If the reciprocal of the condition number is less than machine
     *         precision, info = A->nrow+1 is returned as a warning, but the
     *         routine still goes on to solve for X and computes error bounds
     *         as described below.
     *
     *    2.6. The system of equations is solved for X using the factored form
     *         of transpose(A).
     *
     *    2.7. Iterative refinement is applied to improve the computed solution
     *         matrix and calculate error bounds and backward error estimates
     *         for it.
     *
     *    2.8. If equilibration was used, the matrix X is premultiplied by
     *         diag(C) (if trans = NOTRANS) or diag(R) (if trans = TRANS or CONJ)
     *         so that it solves the original system before equilibration.
     *
     * See supermatrix.h for the definition of 'SuperMatrix' structure.
     *
     * Arguments
     * =========
     *
     * nprocs (input) int
     *         Number of processes (or threads) to be spawned and used to perform
     *         the LU factorization by psgstrf(). There is a single thread of
     *         control to call psgstrf(), and all threads spawned by psgstrf()
     *         are terminated before returning from psgstrf().
     *
     * superlumt_options (input) superlumt_options_t*
     *         The structure defines the input parameters and data structure
     *         to control how the LU factorization will be performed.
     *         The following fields should be defined for this structure:
     *
     *         o fact (fact_t)
     *           Specifies whether or not the factored form of the matrix
     *           A is supplied on entry, and if not, whether the matrix A should
     *           be equilibrated before it is factored.
     *           = FACTORED: On entry, L, U, perm_r and perm_c contain the
     *             factored form of A. If equed is not NOEQUIL, the matrix A has
     *             been equilibrated with scaling factors R and C.
     *             A, L, U, perm_r are not modified.
     *           = DOFACT: The matrix A will be factored, and the factors will be
     *             stored in L and U.
     *           = EQUILIBRATE: The matrix A will be equilibrated if necessary,
     *             then factored into L and U.
     *
     *         o trans (trans_t)
     *           Specifies the form of the system of equations:
     *           = NOTRANS: A * X = B        (No transpose)
     *           = TRANS:   A**T * X = B     (Transpose)
     *           = CONJ:    A**H * X = B     (Transpose)
     *
     *         o refact (yes_no_t)
     *           Specifies whether this is first time or subsequent factorization.
     *           = NO:  this factorization is treated as the first one;
     *           = YES: it means that a factorization was performed prior to this
     *               one. Therefore, this factorization will re-use some
     *               existing data structures, such as L and U storage, column
     *               elimination tree, and the symbolic information of the
     *               Householder matrix.
     *
     *         o panel_size (int)
     *           A panel consists of at most panel_size consecutive columns.
     *
     *         o relax (int)
     *           To control degree of relaxing supernodes. If the number
     *           of nodes (columns) in a subtree of the elimination tree is less
     *           than relax, this subtree is considered as one supernode,
     *           regardless of the row structures of those columns.
     *
     *         o diag_pivot_thresh (float)
     *           Diagonal pivoting threshold. At step j of the Gaussian
     *           elimination, if
     *               abs(A_jj) >= diag_pivot_thresh * (max_(i>=j) abs(A_ij)),
     *           use A_jj as pivot, else use A_ij with maximum magnitude.
     *           0 <= diag_pivot_thresh <= 1. The default value is 1,
     *           corresponding to partial pivoting.
     *
     *         o usepr (yes_no_t)
     *           Whether the pivoting will use perm_r specified by the user.
     *           = YES: use perm_r; perm_r is input, unchanged on exit.
     *           = NO:  perm_r is determined by partial pivoting, and is output.
     *
     *         o drop_tol (double) (NOT IMPLEMENTED)
     *	     Drop tolerance parameter. At step j of the Gaussian elimination,
     *           if abs(A_ij)/(max_i abs(A_ij)) < drop_tol, drop entry A_ij.
     *           0 <= drop_tol <= 1. The default value of drop_tol is 0,
     *           corresponding to not dropping any entry.
     *
     *         o work (void*) of size lwork
     *           User-supplied work space and space for the output data structures.
     *           Not referenced if lwork = 0;
     *
     *         o lwork (int)
     *           Specifies the length of work array.
     *           = 0:  allocate space internally by system malloc;
     *           > 0:  use user-supplied work array of length lwork in bytes,
     *                 returns error if space runs out.
     *           = -1: the routine guesses the amount of space needed without
     *                 performing the factorization, and returns it in
     *                 superlu_memusage->total_needed; no other side effects.
     *
     * A       (input/output) SuperMatrix*
     *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol), where
     *         A->nrow = A->ncol. Currently, the type of A can be:
     *         Stype = NC or NR, Dtype = _D, Mtype = GE. In the future,
     *         more general A will be handled.
     *
     *         On entry, If superlumt_options->fact = FACTORED and equed is not
     *         NOEQUIL, then A must have been equilibrated by the scaling factors
     *         in R and/or C.  On exit, A is not modified
     *         if superlumt_options->fact = FACTORED or DOFACT, or
     *         if superlumt_options->fact = EQUILIBRATE and equed = NOEQUIL.
     *
     *         On exit, if superlumt_options->fact = EQUILIBRATE and equed is not
     *         NOEQUIL, A is scaled as follows:
     *         If A->Stype = NC:
     *           equed = ROW:  A := diag(R) * A
     *           equed = COL:  A := A * diag(C)
     *           equed = BOTH: A := diag(R) * A * diag(C).
     *         If A->Stype = NR:
     *           equed = ROW:  transpose(A) := diag(R) * transpose(A)
     *           equed = COL:  transpose(A) := transpose(A) * diag(C)
     *           equed = BOTH: transpose(A) := diag(R) * transpose(A) * diag(C).
     *
     * perm_c  (input/output) int*
     *	   If A->Stype = NC, Column permutation vector of size A->ncol,
     *         which defines the permutation matrix Pc; perm_c[i] = j means
     *         column i of A is in position j in A*Pc.
     *         On exit, perm_c may be overwritten by the product of the input
     *         perm_c and a permutation that postorders the elimination tree
     *         of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
     *         is already in postorder.
     *
     *         If A->Stype = NR, column permutation vector of size A->nrow,
     *         which describes permutation of columns of tranpose(A)
     *         (rows of A) as described above.
     *
     * perm_r  (input/output) int*
     *         If A->Stype = NC, row permutation vector of size A->nrow,
     *         which defines the permutation matrix Pr, and is determined
     *         by partial pivoting.  perm_r[i] = j means row i of A is in
     *         position j in Pr*A.
     *
     *         If A->Stype = NR, permutation vector of size A->ncol, which
     *         determines permutation of rows of transpose(A)
     *         (columns of A) as described above.
     *
     *         If superlumt_options->usepr = NO, perm_r is output argument;
     *         If superlumt_options->usepr = YES, the pivoting routine will try
     *            to use the input perm_r, unless a certain threshold criterion
     *            is violated. In that case, perm_r is overwritten by a new
     *            permutation determined by partial pivoting or diagonal
     *            threshold pivoting.
     *
     * equed   (input/output) equed_t*
     *         Specifies the form of equilibration that was done.
     *         = NOEQUIL: No equilibration.
     *         = ROW:  Row equilibration, i.e., A was premultiplied by diag(R).
     *         = COL:  Column equilibration, i.e., A was postmultiplied by diag(C).
     *         = BOTH: Both row and column equilibration, i.e., A was replaced
     *                 by diag(R)*A*diag(C).
     *         If superlumt_options->fact = FACTORED, equed is an input argument,
     *         otherwise it is an output argument.
     *
     * R       (input/output) double*, dimension (A->nrow)
     *         The row scale factors for A or transpose(A).
     *         If equed = ROW or BOTH, A (if A->Stype = NC) or transpose(A)
     *            (if A->Stype = NR) is multiplied on the left by diag(R).
     *         If equed = NOEQUIL or COL, R is not accessed.
     *         If fact = FACTORED, R is an input argument; otherwise, R is output.
     *         If fact = FACTORED and equed = ROW or BOTH, each element of R must
     *            be positive.
     *
     * C       (input/output) double*, dimension (A->ncol)
     *         The column scale factors for A or transpose(A).
     *         If equed = COL or BOTH, A (if A->Stype = NC) or trnspose(A)
     *            (if A->Stype = NR) is multiplied on the right by diag(C).
     *         If equed = NOEQUIL or ROW, C is not accessed.
     *         If fact = FACTORED, C is an input argument; otherwise, C is output.
     *         If fact = FACTORED and equed = COL or BOTH, each element of C must
     *            be positive.
     *
     * L       (output) SuperMatrix*
     *	   The factor L from the factorization
     *             Pr*A*Pc=L*U              (if A->Stype = NC) or
     *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
     *         Uses compressed row subscripts storage for supernodes, i.e.,
     *         L has types: Stype = SCP, Dtype = _D, Mtype = TRLU.
     *
     * U       (output) SuperMatrix*
     *	   The factor U from the factorization
     *             Pr*A*Pc=L*U              (if A->Stype = NC) or
     *             Pr*transpose(A)*Pc=L*U   (if A->Stype = NR).
     *         Uses column-wise storage scheme, i.e., U has types:
     *         Stype = NCP, Dtype = _D, Mtype = TRU.
     *
     * B       (input/output) SuperMatrix*
     *         B has types: Stype = DN, Dtype = _D, Mtype = GE.
     *         On entry, the right hand side matrix.
     *         On exit,
     *            if equed = NOEQUIL, B is not modified; otherwise
     *            if A->Stype = NC:
     *               if trans = NOTRANS and equed = ROW or BOTH, B is overwritten
     *                  by diag(R)*B;
     *               if trans = TRANS or CONJ and equed = COL of BOTH, B is
     *                  overwritten by diag(C)*B;
     *            if A->Stype = NR:
     *               if trans = NOTRANS and equed = COL or BOTH, B is overwritten
     *                  by diag(C)*B;
     *               if trans = TRANS or CONJ and equed = ROW of BOTH, B is
     *                  overwritten by diag(R)*B.
     *
     * X       (output) SuperMatrix*
     *         X has types: Stype = DN, Dtype = _D, Mtype = GE.
     *         If info = 0 or info = A->ncol+1, X contains the solution matrix
     *         to the original system of equations. Note that A and B are modified
     *         on exit if equed is not NOEQUIL, and the solution to the
     *         equilibrated system is inv(diag(C))*X if trans = NOTRANS and
     *         equed = COL or BOTH, or inv(diag(R))*X if trans = TRANS or CONJ
     *         and equed = ROW or BOTH.
     *
     * recip_pivot_growth (output) float*
     *         The reciprocal pivot growth factor computed as
     *             max_j ( max_i(abs(A_ij)) / max_i(abs(U_ij)) ).
     *         If recip_pivot_growth is much less than 1, the stability of the
     *         LU factorization could be poor.
     *
     * rcond   (output) float*
     *         The estimate of the reciprocal condition number of the matrix A
     *         after equilibration (if done). If rcond is less than the machine
     *         precision (in particular, if rcond = 0), the matrix is singular
     *         to working precision. This condition is indicated by a return
     *         code of info > 0.
     *
     * ferr    (output) float*, dimension (B->ncol)
     *         The estimated forward error bound for each solution vector
     *         X(j) (the j-th column of the solution matrix X).
     *         If XTRUE is the true solution corresponding to X(j), FERR(j)
     *         is an estimated upper bound for the magnitude of the largest
     *         element in (X(j) - XTRUE) divided by the magnitude of the
     *         largest element in X(j).  The estimate is as reliable as
     *         the estimate for RCOND, and is almost always a slight
     *         overestimate of the true error.
     *
     * berr    (output) float*, dimension (B->ncol)
     *         The componentwise relative backward error of each solution
     *         vector X(j) (i.e., the smallest relative change in
     *         any element of A or B that makes X(j) an exact solution).
     *
     * superlu_memusage (output) superlu_memusage_t*
     *         Record the memory usage statistics, consisting of following fields:
     *         - for_lu (float)
     *           The amount of space used in bytes for L\U data structures.
     *         - total_needed (float)
     *           The amount of space needed in bytes to perform factorization.
     *         - expansions (int)
     *           The number of memory expansions during the LU factorization.
     *
     * info    (output) int*
     *         = 0: successful exit
     *         < 0: if info = -i, the i-th argument had an illegal value
     *         > 0: if info = i, and i is
     *              <= A->ncol: U(i,i) is exactly zero. The factorization has
     *                    been completed, but the factor U is exactly
     *                    singular, so the solution and error bounds
     *                    could not be computed.
     *              = A->ncol+1: U is nonsingular, but RCOND is less than machine
     *                    precision, meaning that the matrix is singular to
     *                    working precision. Nevertheless, the solution and
     *                    error bounds are computed because there are a number
     *                    of situations where the computed solution can be more
     *                    accurate than the value of RCOND would suggest.
     *              > A->ncol+1: number of bytes allocated when memory allocation
     *                    failure occurred, plus A->ncol.
     *
     */

    NCformat  *Astore;
    DNformat  *Bstore, *Xstore;
    float    *Bmat, *Xmat;
    int       ldb, ldx, nrhs;
    SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
    SuperMatrix AC; /* Matrix postmultiplied by Pc */
    int       colequ, equil, dofact, notran, rowequ;
    char      norm[1];
    trans_t   trant;
    int       i, j, info1;
    float amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
    int       n, relax, panel_size;
    Gstat_t   Gstat;
    double    t0;      /* temporary time */
    double    *utime;
    flops_t   *ops, flopcnt;

    /* External functions */
    extern float slangs(char *, SuperMatrix *);
    extern double slamch_(char *);

    Astore = A->Store;
    Bstore = B->Store;
    Xstore = X->Store;
    Bmat   = Bstore->nzval;
    Xmat   = Xstore->nzval;
    n      = A->ncol;
    ldb    = Bstore->lda;
    ldx    = Xstore->lda;
    nrhs   = B->ncol;
    superlumt_options->perm_c = perm_c;
    superlumt_options->perm_r = perm_r;

    *info = 0;
    dofact = (superlumt_options->fact == DOFACT);
    equil = (superlumt_options->fact == EQUILIBRATE);
    notran = (superlumt_options->trans == NOTRANS);
    if (dofact || equil) {
        *equed = NOEQUIL;
        rowequ = FALSE;
        colequ = FALSE;
    } else {
        rowequ = (*equed == ROW) || (*equed == BOTH);
        colequ = (*equed == COL) || (*equed == BOTH);
        smlnum = slamch_("Safe minimum");
        bignum = 1. / smlnum;
    }

    /* ------------------------------------------------------------
       Test the input parameters.
       ------------------------------------------------------------*/
    if ( nprocs <= 0 ) *info = -1;
    else if ( (!dofact && !equil && (superlumt_options->fact != FACTORED))
              || (!notran && (superlumt_options->trans != TRANS) &&
                  (superlumt_options->trans != CONJ))
              || (superlumt_options->refact != YES &&
                  superlumt_options->refact != NO)
              || (superlumt_options->usepr != YES &&
                  superlumt_options->usepr != NO)
              || superlumt_options->lwork < -1 )
        *info = -2;
    else if ( A->nrow != A->ncol || A->nrow < 0 ||
              (A->Stype != SLU_NC && A->Stype != SLU_NR) ||
              A->Dtype != SLU_S || A->Mtype != SLU_GE )
        *info = -3;
    else if ((superlumt_options->fact == FACTORED) &&
             !(rowequ || colequ || (*equed == NOEQUIL))) *info = -6;
    else {
        if (rowequ) {
            rcmin = bignum;
            rcmax = 0.;
            for (j = 0; j < A->nrow; ++j) {
                rcmin = SUPERLU_MIN(rcmin, R[j]);
                rcmax = SUPERLU_MAX(rcmax, R[j]);
            }
            if (rcmin <= 0.) *info = -7;
            else if ( A->nrow > 0)
                rowcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
            else rowcnd = 1.;
        }
        if (colequ && *info == 0) {
            rcmin = bignum;
            rcmax = 0.;
            for (j = 0; j < A->nrow; ++j) {
                rcmin = SUPERLU_MIN(rcmin, C[j]);
                rcmax = SUPERLU_MAX(rcmax, C[j]);
            }
            if (rcmin <= 0.) *info = -8;
            else if (A->nrow > 0)
                colcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
            else colcnd = 1.;
        }
        if (*info == 0) {
            if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
                    B->Stype != SLU_DN || B->Dtype != SLU_S ||
                    B->Mtype != SLU_GE )
                *info = -11;
            else if ( X->ncol < 0 || Xstore->lda < SUPERLU_MAX(0, A->nrow) ||
                      B->ncol != X->ncol || X->Stype != SLU_DN ||
                      X->Dtype != SLU_S || X->Mtype != SLU_GE )
                *info = -12;
        }
    }
    if (*info != 0) {
        i = -(*info);
        xerbla_("psgssvx", &i);
        return;
    }


    /* ------------------------------------------------------------
       Allocate storage and initialize statistics variables.
       ------------------------------------------------------------*/
    panel_size = superlumt_options->panel_size;
    relax = superlumt_options->relax;
    StatAlloc(n, nprocs, panel_size, relax, &Gstat);
    StatInit(n, nprocs, &Gstat);
    utime = Gstat.utime;
    ops = Gstat.ops;

    /* ------------------------------------------------------------
       Convert A to NC format when necessary.
       ------------------------------------------------------------*/
    if ( A->Stype == SLU_NR ) {
        NRformat *Astore = A->Store;
        AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
        sCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz,
                               Astore->nzval, Astore->colind, Astore->rowptr,
                               SLU_NC, A->Dtype, A->Mtype);
        if ( notran ) { /* Reverse the transpose argument. */
            trant = TRANS;
            notran = 0;
        } else {
            trant = NOTRANS;
            notran = 1;
        }
    } else { /* A->Stype == NC */
        trant = superlumt_options->trans;
        AA = A;
    }

    /* ------------------------------------------------------------
       Diagonal scaling to equilibrate the matrix.
       ------------------------------------------------------------*/
    if ( equil ) {
        t0 = SuperLU_timer_();
        /* Compute row and column scalings to equilibrate the matrix A. */
        sgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);

        if ( info1 == 0 ) {
            /* Equilibrate matrix A. */
            slaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
            rowequ = (*equed == ROW) || (*equed == BOTH);
            colequ = (*equed == COL) || (*equed == BOTH);
        }
        utime[EQUIL] = SuperLU_timer_() - t0;
    }

    /* ------------------------------------------------------------
       Scale the right hand side.
       ------------------------------------------------------------*/
    if ( notran ) {
        if ( rowequ ) {
            for (j = 0; j < nrhs; ++j)
                for (i = 0; i < A->nrow; ++i) {
                    Bmat[i + j*ldb] *= R[i];
                }
        }
    } else if ( colequ ) {
        for (j = 0; j < nrhs; ++j)
            for (i = 0; i < A->nrow; ++i) {
                Bmat[i + j*ldb] *= C[i];
            }
    }


    /* ------------------------------------------------------------
       Perform the LU factorization.
       ------------------------------------------------------------*/
    if ( dofact || equil ) {

        /* Obtain column etree, the column count (colcnt_h) and supernode
        partition (part_super_h) for the Householder matrix. */
        t0 = SuperLU_timer_();
        sp_colorder(AA, perm_c, superlumt_options, &AC);
        utime[ETREE] = SuperLU_timer_() - t0;

#if ( PRNTlevel >= 2 )
        printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n",
               relax, panel_size, sp_ienv(3), sp_ienv(4));
        fflush(stdout);
#endif

        /* Compute the LU factorization of A*Pc. */
        t0 = SuperLU_timer_();
        psgstrf(superlumt_options, &AC, perm_r, L, U, &Gstat, info);
        utime[FACT] = SuperLU_timer_() - t0;

        flopcnt = 0;
        for (i = 0; i < nprocs; ++i) flopcnt += Gstat.procstat[i].fcops;
        ops[FACT] = flopcnt;

        if ( superlumt_options->lwork == -1 ) {
            superlu_memusage->total_needed = *info - A->ncol;
            return;
        }
    }

    if ( *info > 0 ) {
        if ( *info <= A->ncol ) {
            /* Compute the reciprocal pivot growth factor of the leading
               rank-deficient *info columns of A. */
            *recip_pivot_growth = sPivotGrowth(*info, AA, perm_c, L, U);
        }
    } else {

        /* ------------------------------------------------------------
           Compute the reciprocal pivot growth factor *recip_pivot_growth.
           ------------------------------------------------------------*/
        *recip_pivot_growth = sPivotGrowth(A->ncol, AA, perm_c, L, U);

        /* ------------------------------------------------------------
           Estimate the reciprocal of the condition number of A.
           ------------------------------------------------------------*/
        t0 = SuperLU_timer_();
        if ( notran ) {
            *(unsigned char *)norm = '1';
        } else {
            *(unsigned char *)norm = 'I';
        }
        anorm = slangs(norm, AA);
        sgscon(norm, L, U, anorm, rcond, info);
        utime[RCOND] = SuperLU_timer_() - t0;

        /* ------------------------------------------------------------
           Compute the solution matrix X.
           ------------------------------------------------------------*/
        for (j = 0; j < nrhs; j++)    /* Save a copy of the right hand sides */
            for (i = 0; i < B->nrow; i++)
                Xmat[i + j*ldx] = Bmat[i + j*ldb];

        t0 = SuperLU_timer_();
        sgstrs(trant, L, U, perm_r, perm_c, X, &Gstat, info);
        utime[SOLVE] = SuperLU_timer_() - t0;
        ops[SOLVE] = ops[TRISOLVE];

        /* ------------------------------------------------------------
           Use iterative refinement to improve the computed solution and
           compute error bounds and backward error estimates for it.
           ------------------------------------------------------------*/
        t0 = SuperLU_timer_();
        sgsrfs(trant, AA, L, U, perm_r, perm_c, *equed,
               R, C, B, X, ferr, berr, &Gstat, info);
        utime[REFINE] = SuperLU_timer_() - t0;

        /* ------------------------------------------------------------
           Transform the solution matrix X to a solution of the original
           system.
           ------------------------------------------------------------*/
        if ( notran ) {
            if ( colequ ) {
                for (j = 0; j < nrhs; ++j)
                    for (i = 0; i < A->nrow; ++i) {
                        Xmat[i + j*ldx] *= C[i];
                    }
            }
        } else if ( rowequ ) {
            for (j = 0; j < nrhs; ++j)
                for (i = 0; i < A->nrow; ++i) {
                    Xmat[i + j*ldx] *= R[i];
                }
        }

        /* Set INFO = A->ncol+1 if the matrix is singular to
           working precision.*/
        if ( *rcond < slamch_("E") ) *info = A->ncol + 1;

    }

    superlu_sQuerySpace(nprocs, L, U, panel_size, superlu_memusage);

    /* ------------------------------------------------------------
       Deallocate storage after factorization.
       ------------------------------------------------------------*/
    if ( superlumt_options->refact == NO ) {
        SUPERLU_FREE(superlumt_options->etree);
        SUPERLU_FREE(superlumt_options->colcnt_h);
        SUPERLU_FREE(superlumt_options->part_super_h);
    }
    if ( dofact || equil ) {
        Destroy_CompCol_Permuted(&AC);
    }
    if ( A->Stype == SLU_NR ) {
        Destroy_SuperMatrix_Store(AA);
        SUPERLU_FREE(AA);
    }

    /* ------------------------------------------------------------
       Print timings, then deallocate statistic variables.
       ------------------------------------------------------------*/
#ifdef PROFILE
    {
        SCPformat *Lstore = (SCPformat *) L->Store;
        ParallelProfile(n, Lstore->nsuper+1, Gstat.num_panels, nprocs, &Gstat);
    }
#endif
    PrintStat(&Gstat);
    StatFree(&Gstat);
}
Пример #4
0
void
sgssvx(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
       int *etree, char *equed, float *R, float *C,
       SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
       SuperMatrix *B, SuperMatrix *X, float *recip_pivot_growth, 
       float *rcond, float *ferr, float *berr, 
       mem_usage_t *mem_usage, SuperLUStat_t *stat, int *info )
{


    DNformat  *Bstore, *Xstore;
    float    *Bmat, *Xmat;
    int       ldb, ldx, nrhs;
    SuperMatrix *AA;/* A in SLU_NC format used by the factorization routine.*/
    SuperMatrix AC; /* Matrix postmultiplied by Pc */
    int       colequ, equil, nofact, notran, rowequ, permc_spec;
    trans_t   trant;
    char      norm[1];
    int       i, j, info1;
    float    amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
    int       relax, panel_size;
    float    diag_pivot_thresh;
    double    t0;      /* temporary time */
    double    *utime;

    /* External functions */
    extern float slangs(char *, SuperMatrix *);

    Bstore = B->Store;
    Xstore = X->Store;
    Bmat   = Bstore->nzval;
    Xmat   = Xstore->nzval;
    ldb    = Bstore->lda;
    ldx    = Xstore->lda;
    nrhs   = B->ncol;

    *info = 0;
    nofact = (options->Fact != FACTORED);
    equil = (options->Equil == YES);
    notran = (options->Trans == NOTRANS);
    if ( nofact ) {
	*(unsigned char *)equed = 'N';
	rowequ = FALSE;
	colequ = FALSE;
    } else {
	rowequ = lsame_(equed, "R") || lsame_(equed, "B");
	colequ = lsame_(equed, "C") || lsame_(equed, "B");
	smlnum = slamch_("Safe minimum");
	bignum = 1. / smlnum;
    }

#if 0
printf("dgssvx: Fact=%4d, Trans=%4d, equed=%c\n",
       options->Fact, options->Trans, *equed);
#endif

    /* Test the input parameters */
    if (options->Fact != DOFACT && options->Fact != SamePattern &&
	options->Fact != SamePattern_SameRowPerm &&
	options->Fact != FACTORED &&
	options->Trans != NOTRANS && options->Trans != TRANS && 
	options->Trans != CONJ &&
	options->Equil != NO && options->Equil != YES)
	*info = -1;
    else if ( A->nrow != A->ncol || A->nrow < 0 ||
	      (A->Stype != SLU_NC && A->Stype != SLU_NR) ||
	      A->Dtype != SLU_S || A->Mtype != SLU_GE )
	*info = -2;
    else if (options->Fact == FACTORED &&
	     !(rowequ || colequ || lsame_(equed, "N")))
	*info = -6;
    else {
	if (rowequ) {
	    rcmin = bignum;
	    rcmax = 0.;
	    for (j = 0; j < A->nrow; ++j) {
		rcmin = SUPERLU_MIN(rcmin, R[j]);
		rcmax = SUPERLU_MAX(rcmax, R[j]);
	    }
	    if (rcmin <= 0.) *info = -7;
	    else if ( A->nrow > 0)
		rowcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
	    else rowcnd = 1.;
	}
	if (colequ && *info == 0) {
	    rcmin = bignum;
	    rcmax = 0.;
	    for (j = 0; j < A->nrow; ++j) {
		rcmin = SUPERLU_MIN(rcmin, C[j]);
		rcmax = SUPERLU_MAX(rcmax, C[j]);
	    }
	    if (rcmin <= 0.) *info = -8;
	    else if (A->nrow > 0)
		colcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
	    else colcnd = 1.;
	}
	if (*info == 0) {
	    if ( lwork < -1 ) *info = -12;
	    else if ( B->ncol < 0 ) *info = -13;
	    else if ( B->ncol > 0 ) { /* no checking if B->ncol=0 */
	         if ( Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
		      B->Stype != SLU_DN || B->Dtype != SLU_S || 
		      B->Mtype != SLU_GE )
		*info = -13;
            }
	    if ( X->ncol < 0 ) *info = -14;
            else if ( X->ncol > 0 ) { /* no checking if X->ncol=0 */
                 if ( Xstore->lda < SUPERLU_MAX(0, A->nrow) ||
		      (B->ncol != 0 && B->ncol != X->ncol) ||
                      X->Stype != SLU_DN ||
		      X->Dtype != SLU_S || X->Mtype != SLU_GE )
		*info = -14;
            }
	}
    }
    if (*info != 0) {
	i = -(*info);
	xerbla_("sgssvx", &i);
	return;
    }
    
    /* Initialization for factor parameters */
    panel_size = sp_ienv(1);
    relax      = sp_ienv(2);
    diag_pivot_thresh = options->DiagPivotThresh;

    utime = stat->utime;
    
    /* Convert A to SLU_NC format when necessary. */
    if ( A->Stype == SLU_NR ) {
	NRformat *Astore = A->Store;
	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
	sCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
			       Astore->nzval, Astore->colind, Astore->rowptr,
			       SLU_NC, A->Dtype, A->Mtype);
	if ( notran ) { /* Reverse the transpose argument. */
	    trant = TRANS;
	    notran = 0;
	} else {
	    trant = NOTRANS;
	    notran = 1;
	}
    } else { /* A->Stype == SLU_NC */
	trant = options->Trans;
	AA = A;
    }

    if ( nofact && equil ) {
	t0 = SuperLU_timer_();
	/* Compute row and column scalings to equilibrate the matrix A. */
	sgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
	
	if ( info1 == 0 ) {
	    /* Equilibrate matrix A. */
	    slaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
	    rowequ = lsame_(equed, "R") || lsame_(equed, "B");
	    colequ = lsame_(equed, "C") || lsame_(equed, "B");
	}
	utime[EQUIL] = SuperLU_timer_() - t0;
    }


    if ( nofact ) {
	
        t0 = SuperLU_timer_();
	/*
	 * Gnet column permutation vector perm_c[], according to permc_spec:
	 *   permc_spec = NATURAL:  natural ordering 
	 *   permc_spec = MMD_AT_PLUS_A: minimum degree on structure of A'+A
	 *   permc_spec = MMD_ATA:  minimum degree on structure of A'*A
	 *   permc_spec = COLAMD:   approximate minimum degree column ordering
	 *   permc_spec = MY_PERMC: the ordering already supplied in perm_c[]
	 */
	permc_spec = options->ColPerm;
	if ( permc_spec != MY_PERMC && options->Fact == DOFACT )
            get_perm_c(permc_spec, AA, perm_c);
	utime[COLPERM] = SuperLU_timer_() - t0;

	t0 = SuperLU_timer_();
	sp_preorder(options, AA, perm_c, etree, &AC);
	utime[ETREE] = SuperLU_timer_() - t0;
    
/*	printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n", 
	       relax, panel_size, sp_ienv(3), sp_ienv(4));
	fflush(stdout); */
	
	/* Compute the LU factorization of A*Pc. */
	t0 = SuperLU_timer_();
	sgstrf(options, &AC, relax, panel_size, etree,
                work, lwork, perm_c, perm_r, L, U, stat, info);
	utime[FACT] = SuperLU_timer_() - t0;
	
	if ( lwork == -1 ) {
	    mem_usage->total_needed = *info - A->ncol;
	    return;
	}
    }

    if ( options->PivotGrowth ) {
        if ( *info > 0 ) {
	    if ( *info <= A->ncol ) {
	        /* Compute the reciprocal pivot growth factor of the leading
	           rank-deficient *info columns of A. */
	        *recip_pivot_growth = sPivotGrowth(*info, AA, perm_c, L, U);
	    }
	    return;
        }

        /* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
        *recip_pivot_growth = sPivotGrowth(A->ncol, AA, perm_c, L, U);
    }

    if ( options->ConditionNumber ) {
        /* Estimate the reciprocal of the condition number of A. */
        t0 = SuperLU_timer_();
        if ( notran ) {
	    *(unsigned char *)norm = '1';
        } else {
	    *(unsigned char *)norm = 'I';
        }
        anorm = slangs(norm, AA);
        sgscon(norm, L, U, anorm, rcond, stat, info);
        utime[RCOND] = SuperLU_timer_() - t0;
    }
    
    if ( nrhs > 0 ) {
        /* Scale the right hand side if equilibration was performed. */
        if ( notran ) {
	    if ( rowequ ) {
	        for (j = 0; j < nrhs; ++j)
		    for (i = 0; i < A->nrow; ++i)
		        Bmat[i + j*ldb] *= R[i];
	    }
        } else if ( colequ ) {
	    for (j = 0; j < nrhs; ++j)
	        for (i = 0; i < A->nrow; ++i)
	            Bmat[i + j*ldb] *= C[i];
        }

        /* Compute the solution matrix X. */
        for (j = 0; j < nrhs; j++)  /* Save a copy of the right hand sides */
            for (i = 0; i < B->nrow; i++)
	        Xmat[i + j*ldx] = Bmat[i + j*ldb];
    
        t0 = SuperLU_timer_();
        sgstrs (trant, L, U, perm_c, perm_r, X, stat, info);
        utime[SOLVE] = SuperLU_timer_() - t0;
    
        /* Use iterative refinement to improve the computed solution and compute
           error bounds and backward error estimates for it. */
        t0 = SuperLU_timer_();
        if ( options->IterRefine != NOREFINE ) {
            sgsrfs(trant, AA, L, U, perm_c, perm_r, equed, R, C, B,
                   X, ferr, berr, stat, info);
        } else {
            for (j = 0; j < nrhs; ++j) ferr[j] = berr[j] = 1.0;
        }
        utime[REFINE] = SuperLU_timer_() - t0;

        /* Transform the solution matrix X to a solution of the original system. */
        if ( notran ) {
	    if ( colequ ) {
	        for (j = 0; j < nrhs; ++j)
		    for (i = 0; i < A->nrow; ++i)
                        Xmat[i + j*ldx] *= C[i];
	    }
        } else if ( rowequ ) {
	    for (j = 0; j < nrhs; ++j)
	        for (i = 0; i < A->nrow; ++i)
	            Xmat[i + j*ldx] *= R[i];
        }
    } /* end if nrhs > 0 */

    if ( options->ConditionNumber ) {
        /* Set INFO = A->ncol+1 if the matrix is singular to working precision. */
        if ( *rcond < slamch_("E") ) *info = A->ncol + 1;
    }

    if ( nofact ) {
        sQuerySpace(L, U, mem_usage);
        Destroy_CompCol_Permuted(&AC);
    }
    if ( A->Stype == SLU_NR ) {
	Destroy_SuperMatrix_Store(AA);
	SUPERLU_FREE(AA);
    }

}
Пример #5
0
void
psgssv(int nprocs, SuperMatrix *A, int *perm_c, int *perm_r, 
       SuperMatrix *L, SuperMatrix *U, SuperMatrix *B, int *info )
{
/*
 * -- SuperLU MT routine (version 2.0) --
 * Lawrence Berkeley National Lab, Univ. of California Berkeley,
 * and Xerox Palo Alto Research Center.
 * September 10, 2007
 *
 * Purpose
 * =======
 *
 * PSGSSV solves the system of linear equations A*X=B, using the parallel
 * LU factorization routine PSGSTRF. It performs the following steps:
 *
 *   1. If A is stored column-wise (A->Stype = NC):
 *
 *      1.1. Permute the columns of A, forming A*Pc, where Pc is a 
 *           permutation matrix. 
 *           For more details of this step, see sp_preorder.c.
 *
 *      1.2. Factor A as Pr*A*Pc=L*U with the permutation Pr determined
 *           by Gaussian elimination with partial pivoting.
 *           L is unit lower triangular with offdiagonal entries
 *           bounded by 1 in magnitude, and U is upper triangular.
 *
 *      1.3. Solve the system of equations A*X=B using the factored
 *           form of A.
 *
 *   2. If A is stored row-wise (A->Stype = NR), apply the above algorithm
 *      to the tranpose of A:
 *
 *      2.1. Permute columns of tranpose(A) (rows of A),
 *           forming transpose(A)*Pc, where Pc is a permutation matrix. 
 *           For more details of this step, see sp_preorder.c.
 *
 *      2.2. Factor A as Pr*transpose(A)*Pc=L*U with the permutation Pr
 *           determined by Gaussian elimination with partial pivoting.
 *           L is unit lower triangular with offdiagonal entries
 *           bounded by 1 in magnitude, and U is upper triangular.
 *
 *      2.3. Solve the system of equations A*X=B using the factored
 *           form of A.
 * 
 *   See supermatrix.h for the definition of "SuperMatrix" structure.
 *
 *
 * Arguments
 * =========
 *
 * nprocs (input) int
 *        Number of processes (or threads) to be spawned and used to perform
 *        the LU factorization by psgstrf(). There is a single thread of
 *        control to call psgstrf(), and all threads spawned by psgstrf()
 *        are terminated before returning from psgstrf().
 *
 * A      (input) SuperMatrix*
 *        Matrix A in A*X=B, of dimension (A->nrow, A->ncol), where
 *        A->nrow = A->ncol. Currently, the type of A can be:
 *        Stype = NC or NR; Dtype = _D; Mtype = GE. In the future,
 *        more general A will be handled.
 *
 * perm_c (input/output) int*
 *        If A->Stype=NC, column permutation vector of size A->ncol,
 *        which defines the permutation matrix Pc; perm_c[i] = j means 
 *        column i of A is in position j in A*Pc.
 *        On exit, perm_c may be overwritten by the product of the input
 *        perm_c and a permutation that postorders the elimination tree
 *        of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
 *        is already in postorder.
 *
 *        If A->Stype=NR, column permutation vector of size A->nrow
 *        which describes permutation of columns of tranpose(A) 
 *        (rows of A) as described above.
 * 
 * perm_r (output) int*,
 *        If A->Stype=NR, row permutation vector of size A->nrow, 
 *        which defines the permutation matrix Pr, and is determined 
 *        by partial pivoting.  perm_r[i] = j means row i of A is in 
 *        position j in Pr*A.
 *
 *        If A->Stype=NR, permutation vector of size A->ncol, which
 *        determines permutation of rows of transpose(A)
 *        (columns of A) as described above.
 *
 * L      (output) SuperMatrix*
 *        The factor L from the factorization 
 *            Pr*A*Pc=L*U              (if A->Stype=NC) or
 *            Pr*transpose(A)*Pc=L*U   (if A->Stype=NR).
 *        Uses compressed row subscripts storage for supernodes, i.e.,
 *        L has types: Stype = SCP, Dtype = _D, Mtype = TRLU.
 *
 * U      (output) SuperMatrix*
 *	  The factor U from the factorization
 *            Pr*A*Pc=L*U              (if A->Stype=NC) or
 *            Pr*transpose(A)*Pc=L*U   (if A->Stype=NR).
 *        Use column-wise storage scheme, i.e., U has types:
 *        Stype = NCP, Dtype = _D, Mtype = TRU.
 *
 * B      (input/output) SuperMatrix*
 *        B has types: Stype = DN, Dtype = _D, Mtype = GE.
 *        On entry, the right hand side matrix.
 *        On exit, the solution matrix if info = 0;
 *
 * info   (output) int*
 *	  = 0: successful exit
 *        > 0: if info = i, and i is
 *             <= A->ncol: U(i,i) is exactly zero. The factorization has
 *                been completed, but the factor U is exactly singular,
 *                so the solution could not be computed.
 *             > A->ncol: number of bytes allocated when memory allocation
 *                failure occurred, plus A->ncol.
 *   
 */
    trans_t  trans;
    NCformat *Astore;
    DNformat *Bstore;
    SuperMatrix *AA; /* A in NC format used by the factorization routine.*/
    SuperMatrix AC; /* Matrix postmultiplied by Pc */
    int i, n, panel_size, relax;
    fact_t   fact;
    yes_no_t refact, usepr;
    float diag_pivot_thresh, drop_tol;
    void *work;
    int lwork;
    superlumt_options_t superlumt_options;
    Gstat_t  Gstat;
    double   t; /* Temporary time */
    double   *utime;
    flops_t  *ops, flopcnt;

    /* ------------------------------------------------------------
       Test the input parameters.
       ------------------------------------------------------------*/
    Astore = A->Store;
    Bstore = B->Store;
    *info = 0;
    if ( nprocs <= 0 ) *info = -1;
    else if ( A->nrow != A->ncol || A->nrow < 0 || 
	      (A->Stype != SLU_NC && A->Stype != SLU_NR) ||
	      A->Dtype != SLU_S || A->Mtype != SLU_GE )
	*info = -2;
    else if (B->ncol < 0 || Bstore->lda < SUPERLU_MAX(1, A->nrow)) *info = -7;
    if ( *info != 0 ) {
        i = -(*info);
	xerbla_("psgssv", &i);
	return;
    }

#if 0
    /* Use the best sequential code. 
       if this part is commented out, we will use the parallel code 
       run on one processor. */
    if ( nprocs == 1 ) {
        return;
    }
#endif

    fact               = EQUILIBRATE;
    refact             = NO;
    trans              = NOTRANS;
    panel_size         = sp_ienv(1);
    relax              = sp_ienv(2);
    diag_pivot_thresh  = 1.0;
    usepr              = NO;
    drop_tol           = 0.0;
    work               = NULL;
    lwork              = 0;

    /* ------------------------------------------------------------
       Allocate storage and initialize statistics variables. 
       ------------------------------------------------------------*/
    n = A->ncol;
    StatAlloc(n, nprocs, panel_size, relax, &Gstat);
    StatInit(n, nprocs, &Gstat);
    utime = Gstat.utime;
    ops = Gstat.ops;

    /* ------------------------------------------------------------
       Convert A to NC format when necessary.
       ------------------------------------------------------------*/
    if ( A->Stype == SLU_NR ) {
	NRformat *Astore = A->Store;
	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
	sCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
			       Astore->nzval, Astore->colind, Astore->rowptr,
			       SLU_NC, A->Dtype, A->Mtype);
	trans = TRANS;
    } else if ( A->Stype == SLU_NC ) AA = A;

    /* ------------------------------------------------------------
       Initialize the option structure superlumt_options using the
       user-input parameters;
       Apply perm_c to the columns of original A to form AC.
       ------------------------------------------------------------*/
    psgstrf_init(nprocs, fact, trans, refact, panel_size, relax,
		 diag_pivot_thresh, usepr, drop_tol, perm_c, perm_r,
		 work, lwork, AA, &AC, &superlumt_options, &Gstat);

    /* ------------------------------------------------------------
       Compute the LU factorization of A.
       The following routine will create nprocs threads.
       ------------------------------------------------------------*/
    psgstrf(&superlumt_options, &AC, perm_r, L, U, &Gstat, info);

    flopcnt = 0;
    for (i = 0; i < nprocs; ++i) flopcnt += Gstat.procstat[i].fcops;
    ops[FACT] = flopcnt;

#if ( PRNTlevel==1 )
    printf("nprocs = %d, flops %e, Mflops %.2f\n",
	   nprocs, flopcnt, flopcnt/utime[FACT]*1e-6);
    printf("Parameters: w %d, relax %d, maxsuper %d, rowblk %d, colblk %d\n",
	   sp_ienv(1), sp_ienv(2), sp_ienv(3), sp_ienv(4), sp_ienv(5));
    fflush(stdout);
#endif

    /* ------------------------------------------------------------
       Solve the system A*X=B, overwriting B with X.
       ------------------------------------------------------------*/
    if ( *info == 0 ) {
        t = SuperLU_timer_();
	sgstrs (trans, L, U, perm_r, perm_c, B, &Gstat, info);
	utime[SOLVE] = SuperLU_timer_() - t;
	ops[SOLVE] = ops[TRISOLVE];
    }

    /* ------------------------------------------------------------
       Deallocate storage after factorization.
       ------------------------------------------------------------*/
    pxgstrf_finalize(&superlumt_options, &AC);
    if ( A->Stype == SLU_NR ) {
	Destroy_SuperMatrix_Store(AA);
	SUPERLU_FREE(AA);
    }

    /* ------------------------------------------------------------
       Print timings, then deallocate statistic variables.
       ------------------------------------------------------------*/
    /*PrintStat(&Gstat);*/
    StatFree(&Gstat);
}
Пример #6
0
void
sgssv(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
      SuperMatrix *L, SuperMatrix *U, SuperMatrix *B,
      SuperLUStat_t *stat, int *info )
{
/*
 * Purpose
 * =======
 *
 * SGSSV solves the system of linear equations A*X=B, using the
 * LU factorization from SGSTRF. It performs the following steps:
 *
 *   1. If A is stored column-wise (A->Stype = SLU_NC):
 *
 *      1.1. Permute the columns of A, forming A*Pc, where Pc
 *           is a permutation matrix. For more details of this step, 
 *           see sp_preorder.c.
 *
 *      1.2. Factor A as Pr*A*Pc=L*U with the permutation Pr determined
 *           by Gaussian elimination with partial pivoting.
 *           L is unit lower triangular with offdiagonal entries
 *           bounded by 1 in magnitude, and U is upper triangular.
 *
 *      1.3. Solve the system of equations A*X=B using the factored
 *           form of A.
 *
 *   2. If A is stored row-wise (A->Stype = SLU_NR), apply the
 *      above algorithm to the transpose of A:
 *
 *      2.1. Permute columns of transpose(A) (rows of A),
 *           forming transpose(A)*Pc, where Pc is a permutation matrix. 
 *           For more details of this step, see sp_preorder.c.
 *
 *      2.2. Factor A as Pr*transpose(A)*Pc=L*U with the permutation Pr
 *           determined by Gaussian elimination with partial pivoting.
 *           L is unit lower triangular with offdiagonal entries
 *           bounded by 1 in magnitude, and U is upper triangular.
 *
 *      2.3. Solve the system of equations A*X=B using the factored
 *           form of A.
 *
 *   See supermatrix.h for the definition of 'SuperMatrix' structure.
 * 
 * Arguments
 * =========
 *
 * options (input) superlu_options_t*
 *         The structure defines the input parameters to control
 *         how the LU decomposition will be performed and how the
 *         system will be solved.
 *
 * A       (input) SuperMatrix*
 *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
 *         of linear equations is A->nrow. Currently, the type of A can be:
 *         Stype = SLU_NC or SLU_NR; Dtype = SLU_S; Mtype = SLU_GE.
 *         In the future, more general A may be handled.
 *
 * perm_c  (input/output) int*
 *         If A->Stype = SLU_NC, column permutation vector of size A->ncol
 *         which defines the permutation matrix Pc; perm_c[i] = j means 
 *         column i of A is in position j in A*Pc.
 *         If A->Stype = SLU_NR, column permutation vector of size A->nrow
 *         which describes permutation of columns of transpose(A) 
 *         (rows of A) as described above.
 * 
 *         If options->ColPerm = MY_PERMC or options->Fact = SamePattern or
 *            options->Fact = SamePattern_SameRowPerm, it is an input argument.
 *            On exit, perm_c may be overwritten by the product of the input
 *            perm_c and a permutation that postorders the elimination tree
 *            of Pc'*A'*A*Pc; perm_c is not changed if the elimination tree
 *            is already in postorder.
 *         Otherwise, it is an output argument.
 * 
 * perm_r  (input/output) int*
 *         If A->Stype = SLU_NC, row permutation vector of size A->nrow, 
 *         which defines the permutation matrix Pr, and is determined 
 *         by partial pivoting.  perm_r[i] = j means row i of A is in 
 *         position j in Pr*A.
 *         If A->Stype = SLU_NR, permutation vector of size A->ncol, which
 *         determines permutation of rows of transpose(A)
 *         (columns of A) as described above.
 *
 *         If options->RowPerm = MY_PERMR or
 *            options->Fact = SamePattern_SameRowPerm, perm_r is an
 *            input argument.
 *         otherwise it is an output argument.
 *
 * L       (output) SuperMatrix*
 *         The factor L from the factorization 
 *             Pr*A*Pc=L*U              (if A->Stype = SLU_NC) or
 *             Pr*transpose(A)*Pc=L*U   (if A->Stype = SLU_NR).
 *         Uses compressed row subscripts storage for supernodes, i.e.,
 *         L has types: Stype = SLU_SC, Dtype = SLU_S, Mtype = SLU_TRLU.
 *         
 * U       (output) SuperMatrix*
 *	   The factor U from the factorization 
 *             Pr*A*Pc=L*U              (if A->Stype = SLU_NC) or
 *             Pr*transpose(A)*Pc=L*U   (if A->Stype = SLU_NR).
 *         Uses column-wise storage scheme, i.e., U has types:
 *         Stype = SLU_NC, Dtype = SLU_S, Mtype = SLU_TRU.
 *
 * B       (input/output) SuperMatrix*
 *         B has types: Stype = SLU_DN, Dtype = SLU_S, Mtype = SLU_GE.
 *         On entry, the right hand side matrix.
 *         On exit, the solution matrix if info = 0;
 *
 * stat   (output) SuperLUStat_t*
 *        Record the statistics on runtime and doubleing-point operation count.
 *        See util.h for the definition of 'SuperLUStat_t'.
 *
 * info    (output) int*
 *	   = 0: successful exit
 *         > 0: if info = i, and i is
 *             <= A->ncol: U(i,i) is exactly zero. The factorization has
 *                been completed, but the factor U is exactly singular,
 *                so the solution could not be computed.
 *             > A->ncol: number of bytes allocated when memory allocation
 *                failure occurred, plus A->ncol.
 *   
 */
    DNformat *Bstore;
    SuperMatrix *AA = NULL;/* A in SLU_NC format used by the factorization routine.*/
    SuperMatrix AC; /* Matrix postmultiplied by Pc */
    int      lwork = 0, *etree, i;
    
    /* Set default values for some parameters */
    int      panel_size;     /* panel size */
    int      relax;          /* no of columns in a relaxed snodes */
    int      permc_spec;
    trans_t  trans = NOTRANS;
    double   *utime;
    double   t;	/* Temporary time */

    /* Test the input parameters ... */
    *info = 0;
    Bstore = B->Store;
    if ( options->Fact != DOFACT ) *info = -1;
    else if ( A->nrow != A->ncol || A->nrow < 0 ||
	 (A->Stype != SLU_NC && A->Stype != SLU_NR) ||
	 A->Dtype != SLU_S || A->Mtype != SLU_GE )
	*info = -2;
    else if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
	B->Stype != SLU_DN || B->Dtype != SLU_S || B->Mtype != SLU_GE )
	*info = -7;
    if ( *info != 0 ) {
	i = -(*info);
	xerbla_("sgssv", &i);
	return;
    }

    utime = stat->utime;

    /* Convert A to SLU_NC format when necessary. */
    if ( A->Stype == SLU_NR ) {
	NRformat *Astore = A->Store;
	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
	sCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
			       Astore->nzval, Astore->colind, Astore->rowptr,
			       SLU_NC, A->Dtype, A->Mtype);
	trans = TRANS;
    } else {
        if ( A->Stype == SLU_NC ) AA = A;
    }

    t = SuperLU_timer_();
    /*
     * Get column permutation vector perm_c[], according to permc_spec:
     *   permc_spec = NATURAL:  natural ordering 
     *   permc_spec = MMD_AT_PLUS_A: minimum degree on structure of A'+A
     *   permc_spec = MMD_ATA:  minimum degree on structure of A'*A
     *   permc_spec = COLAMD:   approximate minimum degree column ordering
     *   permc_spec = MY_PERMC: the ordering already supplied in perm_c[]
     */
    permc_spec = options->ColPerm;
    if ( permc_spec != MY_PERMC && options->Fact == DOFACT )
      get_perm_c(permc_spec, AA, perm_c);
    utime[COLPERM] = SuperLU_timer_() - t;

    etree = intMalloc(A->ncol);

    t = SuperLU_timer_();
    sp_preorder(options, AA, perm_c, etree, &AC);
    utime[ETREE] = SuperLU_timer_() - t;

    panel_size = sp_ienv(1);
    relax = sp_ienv(2);

    /*printf("Factor PA = LU ... relax %d\tw %d\tmaxsuper %d\trowblk %d\n", 
	  relax, panel_size, sp_ienv(3), sp_ienv(4));*/
    t = SuperLU_timer_(); 
    /* Compute the LU factorization of A. */
    sgstrf(options, &AC, relax, panel_size,
	   etree, NULL, lwork, perm_c, perm_r, L, U, stat, info);
    utime[FACT] = SuperLU_timer_() - t;

    t = SuperLU_timer_();
    if ( *info == 0 ) {
        /* Solve the system A*X=B, overwriting B with X. */
        sgstrs (trans, L, U, perm_c, perm_r, B, stat, info);
    }
    utime[SOLVE] = SuperLU_timer_() - t;

    SUPERLU_FREE (etree);
    Destroy_CompCol_Permuted(&AC);
    if ( A->Stype == SLU_NR ) {
	Destroy_SuperMatrix_Store(AA);
	SUPERLU_FREE(AA);
    }

}
Пример #7
0
void
sgsisx(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
       int *etree, char *equed, float *R, float *C,
       SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
       SuperMatrix *B, SuperMatrix *X,
       float *recip_pivot_growth, float *rcond,
       mem_usage_t *mem_usage, SuperLUStat_t *stat, int *info)
{

    DNformat  *Bstore, *Xstore;
    float    *Bmat, *Xmat;
    int       ldb, ldx, nrhs;
    SuperMatrix *AA;/* A in SLU_NC format used by the factorization routine.*/
    SuperMatrix AC; /* Matrix postmultiplied by Pc */
    int       colequ, equil, nofact, notran, rowequ, permc_spec, mc64;
    trans_t   trant;
    char      norm[1];
    int       i, j, info1;
    float    amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
    int       relax, panel_size;
    float    diag_pivot_thresh;
    double    t0;      /* temporary time */
    double    *utime;

    int *perm = NULL;

    /* External functions */
    extern float slangs(char *, SuperMatrix *);

    Bstore = B->Store;
    Xstore = X->Store;
    Bmat   = Bstore->nzval;
    Xmat   = Xstore->nzval;
    ldb    = Bstore->lda;
    ldx    = Xstore->lda;
    nrhs   = B->ncol;

    *info = 0;
    nofact = (options->Fact != FACTORED);
    equil = (options->Equil == YES);
    notran = (options->Trans == NOTRANS);
    mc64 = (options->RowPerm == LargeDiag);
    if ( nofact ) {
        *(unsigned char *)equed = 'N';
        rowequ = FALSE;
        colequ = FALSE;
    } else {
        rowequ = lsame_(equed, "R") || lsame_(equed, "B");
        colequ = lsame_(equed, "C") || lsame_(equed, "B");
        smlnum = slamch_("Safe minimum");
        bignum = 1. / smlnum;
    }

    /* Test the input parameters */
    if (!nofact && options->Fact != DOFACT && options->Fact != SamePattern &&
        options->Fact != SamePattern_SameRowPerm &&
        !notran && options->Trans != TRANS && options->Trans != CONJ &&
        !equil && options->Equil != NO)
        *info = -1;
    else if ( A->nrow != A->ncol || A->nrow < 0 ||
              (A->Stype != SLU_NC && A->Stype != SLU_NR) ||
              A->Dtype != SLU_S || A->Mtype != SLU_GE )
        *info = -2;
    else if (options->Fact == FACTORED &&
             !(rowequ || colequ || lsame_(equed, "N")))
        *info = -6;
    else {
        if (rowequ) {
            rcmin = bignum;
            rcmax = 0.;
            for (j = 0; j < A->nrow; ++j) {
                rcmin = SUPERLU_MIN(rcmin, R[j]);
                rcmax = SUPERLU_MAX(rcmax, R[j]);
            }
            if (rcmin <= 0.) *info = -7;
            else if ( A->nrow > 0)
                rowcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
            else rowcnd = 1.;
        }
        if (colequ && *info == 0) {
            rcmin = bignum;
            rcmax = 0.;
            for (j = 0; j < A->nrow; ++j) {
                rcmin = SUPERLU_MIN(rcmin, C[j]);
                rcmax = SUPERLU_MAX(rcmax, C[j]);
            }
            if (rcmin <= 0.) *info = -8;
            else if (A->nrow > 0)
                colcnd = SUPERLU_MAX(rcmin,smlnum) / SUPERLU_MIN(rcmax,bignum);
            else colcnd = 1.;
        }
        if (*info == 0) {
            if ( lwork < -1 ) *info = -12;
            else if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
                      B->Stype != SLU_DN || B->Dtype != SLU_S ||
                      B->Mtype != SLU_GE )
                *info = -13;
            else if ( X->ncol < 0 || Xstore->lda < SUPERLU_MAX(0, A->nrow) ||
                      (B->ncol != 0 && B->ncol != X->ncol) ||
                      X->Stype != SLU_DN ||
                      X->Dtype != SLU_S || X->Mtype != SLU_GE )
                *info = -14;
        }
    }
    if (*info != 0) {
        i = -(*info);
        xerbla_("sgsisx", &i);
        return;
    }

    /* Initialization for factor parameters */
    panel_size = sp_ienv(1);
    relax      = sp_ienv(2);
    diag_pivot_thresh = options->DiagPivotThresh;

    utime = stat->utime;

    /* Convert A to SLU_NC format when necessary. */
    if ( A->Stype == SLU_NR ) {
        NRformat *Astore = A->Store;
        AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
        sCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz,
                               Astore->nzval, Astore->colind, Astore->rowptr,
                               SLU_NC, A->Dtype, A->Mtype);
        if ( notran ) { /* Reverse the transpose argument. */
            trant = TRANS;
            notran = 0;
        } else {
            trant = NOTRANS;
            notran = 1;
        }
    } else { /* A->Stype == SLU_NC */
        trant = options->Trans;
        AA = A;
    }

    if ( nofact ) {
        register int i, j;
        NCformat *Astore = AA->Store;
        int nnz = Astore->nnz;
        int *colptr = Astore->colptr;
        int *rowind = Astore->rowind;
        float *nzval = (float *)Astore->nzval;
        int n = AA->nrow;

        if ( mc64 ) {
            *equed = 'B';
            /*rowequ = colequ = 1;*/
            t0 = SuperLU_timer_();
            if ((perm = intMalloc(n)) == NULL)
                ABORT("SUPERLU_MALLOC fails for perm[]");

            info1 = sldperm(5, n, nnz, colptr, rowind, nzval, perm, R, C);

            if (info1 > 0) { /* MC64 fails, call sgsequ() later */
                mc64 = 0;
                SUPERLU_FREE(perm);
                perm = NULL;
            } else {
                rowequ = colequ = 1;
                for (i = 0; i < n; i++) {
                    R[i] = exp(R[i]);
                    C[i] = exp(C[i]);
                }
                /* permute and scale the matrix */
                for (j = 0; j < n; j++) {
                    for (i = colptr[j]; i < colptr[j + 1]; i++) {
                        nzval[i] *= R[rowind[i]] * C[j];
                        rowind[i] = perm[rowind[i]];
                    }
                }
            }
            utime[EQUIL] = SuperLU_timer_() - t0;
        }
        if ( !mc64 & equil ) {
            t0 = SuperLU_timer_();
            /* Compute row and column scalings to equilibrate the matrix A. */
            sgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);

            if ( info1 == 0 ) {
                /* Equilibrate matrix A. */
                slaqgs(AA, R, C, rowcnd, colcnd, amax, equed);
                rowequ = lsame_(equed, "R") || lsame_(equed, "B");
                colequ = lsame_(equed, "C") || lsame_(equed, "B");
            }
            utime[EQUIL] = SuperLU_timer_() - t0;
        }
    }


    if ( nofact ) {

        t0 = SuperLU_timer_();
        /*
         * Gnet column permutation vector perm_c[], according to permc_spec:
         *   permc_spec = NATURAL:  natural ordering
         *   permc_spec = MMD_AT_PLUS_A: minimum degree on structure of A'+A
         *   permc_spec = MMD_ATA:  minimum degree on structure of A'*A
         *   permc_spec = COLAMD:   approximate minimum degree column ordering
         *   permc_spec = MY_PERMC: the ordering already supplied in perm_c[]
         */
        permc_spec = options->ColPerm;
        if ( permc_spec != MY_PERMC && options->Fact == DOFACT )
            get_perm_c(permc_spec, AA, perm_c);
        utime[COLPERM] = SuperLU_timer_() - t0;

        t0 = SuperLU_timer_();
        sp_preorder(options, AA, perm_c, etree, &AC);
        utime[ETREE] = SuperLU_timer_() - t0;

        /* Compute the LU factorization of A*Pc. */
        t0 = SuperLU_timer_();
        sgsitrf(options, &AC, relax, panel_size, etree, work, lwork,
                perm_c, perm_r, L, U, stat, info);
        utime[FACT] = SuperLU_timer_() - t0;

        if ( lwork == -1 ) {
            mem_usage->total_needed = *info - A->ncol;
            return;
        }
    }

    if ( options->PivotGrowth ) {
        if ( *info > 0 ) return;

        /* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
        *recip_pivot_growth = sPivotGrowth(A->ncol, AA, perm_c, L, U);
    }

    if ( options->ConditionNumber ) {
        /* Estimate the reciprocal of the condition number of A. */
        t0 = SuperLU_timer_();
        if ( notran ) {
            *(unsigned char *)norm = '1';
        } else {
            *(unsigned char *)norm = 'I';
        }
        anorm = slangs(norm, AA);
        sgscon(norm, L, U, anorm, rcond, stat, &info1);
        utime[RCOND] = SuperLU_timer_() - t0;
    }

    if ( nrhs > 0 ) { /* Solve the system */
        float *tmp, *rhs_work;
        int n = A->nrow;
        if ( mc64 ) {
            if ((tmp = floatMalloc(n)) == NULL)
                ABORT("SUPERLU_MALLOC fails for tmp[]");
        }

        /* Scale and permute the right-hand side if equilibration
           and permutation from MC64 were performed. */
        if ( notran ) {
            if ( rowequ ) {
                for (j = 0; j < nrhs; ++j)
                    for (i = 0; i < n; ++i)
                        Bmat[i + j*ldb] *= R[i];
            }
            if ( mc64 ) {
                for (j = 0; j < nrhs; ++j) {
                   rhs_work = &Bmat[j*ldb];
                   for (i = 0; i < n; i++) tmp[perm[i]] = rhs_work[i];
                   for (i = 0; i < n; i++) rhs_work[i] = tmp[i];
                }
            }
        } else if ( colequ ) {
            for (j = 0; j < nrhs; ++j)
                for (i = 0; i < n; ++i) {
                    Bmat[i + j*ldb] *= C[i];
                }
        }

        /* Compute the solution matrix X. */
        for (j = 0; j < nrhs; j++)  /* Save a copy of the right hand sides */
            for (i = 0; i < B->nrow; i++)
                Xmat[i + j*ldx] = Bmat[i + j*ldb];

        t0 = SuperLU_timer_();
        sgstrs (trant, L, U, perm_c, perm_r, X, stat, &info1);
        utime[SOLVE] = SuperLU_timer_() - t0;

        /* Transform the solution matrix X to a solution of the original
           system. */
        if ( notran ) {
            if ( colequ ) {
                for (j = 0; j < nrhs; ++j)
                    for (i = 0; i < n; ++i) {
                        Xmat[i + j*ldx] *= C[i];
                    }
            }
        } else { /* transposed system */
            if ( rowequ ) {
                if ( mc64 ) {
                    for (j = 0; j < nrhs; j++) {
                        for (i = 0; i < n; i++)
                            tmp[i] = Xmat[i + j * ldx]; /*dcopy*/
                        for (i = 0; i < n; i++)
                            Xmat[i + j * ldx] = R[i] * tmp[perm[i]];
                    }
                } else {
                    for (j = 0; j < nrhs; ++j)
                        for (i = 0; i < A->nrow; ++i) {
                            Xmat[i + j*ldx] *= R[i];
                        }
                }
            }
        }

        if ( mc64 ) SUPERLU_FREE(tmp);

    } /* end if nrhs > 0 */

    if ( options->ConditionNumber ) {
        /* Set INFO = A->ncol+1 if the matrix is singular to working precision. */
        if ( *rcond < slamch_("E") && *info == 0) *info = A->ncol + 1;
    }

    if (perm) SUPERLU_FREE(perm);

    if ( nofact ) {
        ilu_sQuerySpace(L, U, mem_usage);
        Destroy_CompCol_Permuted(&AC);
    }
    if ( A->Stype == SLU_NR ) {
        Destroy_SuperMatrix_Store(AA);
        SUPERLU_FREE(AA);
    }

}
Пример #8
0
void
sgsrfs(trans_t trans, SuperMatrix *A, SuperMatrix *L, SuperMatrix *U,
       int *perm_c, int *perm_r, char *equed, float *R, float *C,
       SuperMatrix *B, SuperMatrix *X, float *ferr, float *berr,
       SuperLUStat_t *stat, int *info)
{
/*
 *   Purpose   
 *   =======   
 *
 *   SGSRFS improves the computed solution to a system of linear   
 *   equations and provides error bounds and backward error estimates for 
 *   the solution.   
 *
 *   If equilibration was performed, the system becomes:
 *           (diag(R)*A_original*diag(C)) * X = diag(R)*B_original.
 *
 *   See supermatrix.h for the definition of 'SuperMatrix' structure.
 *
 *   Arguments   
 *   =========   
 *
 * trans   (input) trans_t
 *          Specifies the form of the system of equations:
 *          = NOTRANS: A * X = B  (No transpose)
 *          = TRANS:   A'* X = B  (Transpose)
 *          = CONJ:    A**H * X = B  (Conjugate transpose)
 *   
 *   A       (input) SuperMatrix*
 *           The original matrix A in the system, or the scaled A if
 *           equilibration was done. The type of A can be:
 *           Stype = SLU_NC, Dtype = SLU_S, Mtype = SLU_GE.
 *    
 *   L       (input) SuperMatrix*
 *	     The factor L from the factorization Pr*A*Pc=L*U. Use
 *           compressed row subscripts storage for supernodes, 
 *           i.e., L has types: Stype = SLU_SC, Dtype = SLU_S, Mtype = SLU_TRLU.
 * 
 *   U       (input) SuperMatrix*
 *           The factor U from the factorization Pr*A*Pc=L*U as computed by
 *           sgstrf(). Use column-wise storage scheme, 
 *           i.e., U has types: Stype = SLU_NC, Dtype = SLU_S, Mtype = SLU_TRU.
 *
 *   perm_c  (input) int*, dimension (A->ncol)
 *	     Column permutation vector, which defines the 
 *           permutation matrix Pc; perm_c[i] = j means column i of A is 
 *           in position j in A*Pc.
 *
 *   perm_r  (input) int*, dimension (A->nrow)
 *           Row permutation vector, which defines the permutation matrix Pr;
 *           perm_r[i] = j means row i of A is in position j in Pr*A.
 *
 *   equed   (input) Specifies the form of equilibration that was done.
 *           = 'N': No equilibration.
 *           = 'R': Row equilibration, i.e., A was premultiplied by diag(R).
 *           = 'C': Column equilibration, i.e., A was postmultiplied by
 *                  diag(C).
 *           = 'B': Both row and column equilibration, i.e., A was replaced 
 *                  by diag(R)*A*diag(C).
 *
 *   R       (input) float*, dimension (A->nrow)
 *           The row scale factors for A.
 *           If equed = 'R' or 'B', A is premultiplied by diag(R).
 *           If equed = 'N' or 'C', R is not accessed.
 * 
 *   C       (input) float*, dimension (A->ncol)
 *           The column scale factors for A.
 *           If equed = 'C' or 'B', A is postmultiplied by diag(C).
 *           If equed = 'N' or 'R', C is not accessed.
 *
 *   B       (input) SuperMatrix*
 *           B has types: Stype = SLU_DN, Dtype = SLU_S, Mtype = SLU_GE.
 *           The right hand side matrix B.
 *           if equed = 'R' or 'B', B is premultiplied by diag(R).
 *
 *   X       (input/output) SuperMatrix*
 *           X has types: Stype = SLU_DN, Dtype = SLU_S, Mtype = SLU_GE.
 *           On entry, the solution matrix X, as computed by sgstrs().
 *           On exit, the improved solution matrix X.
 *           if *equed = 'C' or 'B', X should be premultiplied by diag(C)
 *               in order to obtain the solution to the original system.
 *
 *   FERR    (output) float*, dimension (B->ncol)   
 *           The estimated forward error bound for each solution vector   
 *           X(j) (the j-th column of the solution matrix X).   
 *           If XTRUE is the true solution corresponding to X(j), FERR(j) 
 *           is an estimated upper bound for the magnitude of the largest 
 *           element in (X(j) - XTRUE) divided by the magnitude of the   
 *           largest element in X(j).  The estimate is as reliable as   
 *           the estimate for RCOND, and is almost always a slight   
 *           overestimate of the true error.
 *
 *   BERR    (output) float*, dimension (B->ncol)   
 *           The componentwise relative backward error of each solution   
 *           vector X(j) (i.e., the smallest relative change in   
 *           any element of A or B that makes X(j) an exact solution).
 *
 *   stat     (output) SuperLUStat_t*
 *            Record the statistics on runtime and floating-point operation count.
 *            See util.h for the definition of 'SuperLUStat_t'.
 *
 *   info    (output) int*   
 *           = 0:  successful exit   
 *            < 0:  if INFO = -i, the i-th argument had an illegal value   
 *
 *    Internal Parameters   
 *    ===================   
 *
 *    ITMAX is the maximum number of steps of iterative refinement.   
 *
 */  

#define ITMAX 5
    
    /* Table of constant values */
    int    ione = 1;
    float ndone = -1.;
    float done = 1.;
    
    /* Local variables */
    NCformat *Astore;
    float   *Aval;
    SuperMatrix Bjcol;
    DNformat *Bstore, *Xstore, *Bjcol_store;
    float   *Bmat, *Xmat, *Bptr, *Xptr;
    int      kase;
    float   safe1, safe2;
    int      i, j, k, irow, nz, count, notran, rowequ, colequ;
    int      ldb, ldx, nrhs;
    float   s, xk, lstres, eps, safmin;
    char     transc[1];
    trans_t  transt;
    float   *work;
    float   *rwork;
    int      *iwork;
    extern double slamch_(char *);
    extern int slacon_(int *, float *, float *, int *, float *, int *);
#ifdef _CRAY
    extern int SCOPY(int *, float *, int *, float *, int *);
    extern int SSAXPY(int *, float *, float *, int *, float *, int *);
#else
    extern int scopy_(int *, float *, int *, float *, int *);
    extern int saxpy_(int *, float *, float *, int *, float *, int *);
#endif

    Astore = A->Store;
    Aval   = Astore->nzval;
    Bstore = B->Store;
    Xstore = X->Store;
    Bmat   = Bstore->nzval;
    Xmat   = Xstore->nzval;
    ldb    = Bstore->lda;
    ldx    = Xstore->lda;
    nrhs   = B->ncol;
    
    /* Test the input parameters */
    *info = 0;
    notran = (trans == NOTRANS);
    if ( !notran && trans != TRANS && trans != CONJ ) *info = -1;
    else if ( A->nrow != A->ncol || A->nrow < 0 ||
	      A->Stype != SLU_NC || A->Dtype != SLU_S || A->Mtype != SLU_GE )
	*info = -2;
    else if ( L->nrow != L->ncol || L->nrow < 0 ||
 	      L->Stype != SLU_SC || L->Dtype != SLU_S || L->Mtype != SLU_TRLU )
	*info = -3;
    else if ( U->nrow != U->ncol || U->nrow < 0 ||
 	      U->Stype != SLU_NC || U->Dtype != SLU_S || U->Mtype != SLU_TRU )
	*info = -4;
    else if ( ldb < SUPERLU_MAX(0, A->nrow) ||
 	      B->Stype != SLU_DN || B->Dtype != SLU_S || B->Mtype != SLU_GE )
        *info = -10;
    else if ( ldx < SUPERLU_MAX(0, A->nrow) ||
 	      X->Stype != SLU_DN || X->Dtype != SLU_S || X->Mtype != SLU_GE )
	*info = -11;
    if (*info != 0) {
	i = -(*info);
	xerbla_("sgsrfs", &i);
	return;
    }

    /* Quick return if possible */
    if ( A->nrow == 0 || nrhs == 0) {
	for (j = 0; j < nrhs; ++j) {
	    ferr[j] = 0.;
	    berr[j] = 0.;
	}
	return;
    }

    rowequ = lsame_(equed, "R") || lsame_(equed, "B");
    colequ = lsame_(equed, "C") || lsame_(equed, "B");
    
    /* Allocate working space */
    work = floatMalloc(2*A->nrow);
    rwork = (float *) SUPERLU_MALLOC( A->nrow * sizeof(float) );
    iwork = intMalloc(2*A->nrow);
    if ( !work || !rwork || !iwork ) 
        ABORT("Malloc fails for work/rwork/iwork.");
    
    if ( notran ) {
	*(unsigned char *)transc = 'N';
        transt = TRANS;
    } else {
	*(unsigned char *)transc = 'T';
	transt = NOTRANS;
    }

    /* NZ = maximum number of nonzero elements in each row of A, plus 1 */
    nz     = A->ncol + 1;
    eps    = slamch_("Epsilon");
    safmin = slamch_("Safe minimum");
    safe1  = nz * safmin;
    safe2  = safe1 / eps;

    /* Compute the number of nonzeros in each row (or column) of A */
    for (i = 0; i < A->nrow; ++i) iwork[i] = 0;
    if ( notran ) {
	for (k = 0; k < A->ncol; ++k)
	    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) 
		++iwork[Astore->rowind[i]];
    } else {
	for (k = 0; k < A->ncol; ++k)
	    iwork[k] = Astore->colptr[k+1] - Astore->colptr[k];
    }	

    /* Copy one column of RHS B into Bjcol. */
    Bjcol.Stype = B->Stype;
    Bjcol.Dtype = B->Dtype;
    Bjcol.Mtype = B->Mtype;
    Bjcol.nrow  = B->nrow;
    Bjcol.ncol  = 1;
    Bjcol.Store = (void *) SUPERLU_MALLOC( sizeof(DNformat) );
    if ( !Bjcol.Store ) ABORT("SUPERLU_MALLOC fails for Bjcol.Store");
    Bjcol_store = Bjcol.Store;
    Bjcol_store->lda = ldb;
    Bjcol_store->nzval = work; /* address aliasing */
	
    /* Do for each right hand side ... */
    for (j = 0; j < nrhs; ++j) {
	count = 0;
	lstres = 3.;
	Bptr = &Bmat[j*ldb];
	Xptr = &Xmat[j*ldx];

	while (1) { /* Loop until stopping criterion is satisfied. */

	    /* Compute residual R = B - op(A) * X,   
	       where op(A) = A, A**T, or A**H, depending on TRANS. */
	    
#ifdef _CRAY
	    SCOPY(&A->nrow, Bptr, &ione, work, &ione);
#else
	    scopy_(&A->nrow, Bptr, &ione, work, &ione);
#endif
	    sp_sgemv(transc, ndone, A, Xptr, ione, done, work, ione);

	    /* Compute componentwise relative backward error from formula 
	       max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )   
	       where abs(Z) is the componentwise absolute value of the matrix
	       or vector Z.  If the i-th component of the denominator is less
	       than SAFE2, then SAFE1 is added to the i-th component of the   
	       numerator and denominator before dividing. */

	    for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] );
	    
	    /* Compute abs(op(A))*abs(X) + abs(B). */
	    if (notran) {
		for (k = 0; k < A->ncol; ++k) {
		    xk = fabs( Xptr[k] );
		    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i)
			rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk;
		}
	    } else {
		for (k = 0; k < A->ncol; ++k) {
		    s = 0.;
		    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) {
			irow = Astore->rowind[i];
			s += fabs(Aval[i]) * fabs(Xptr[irow]);
		    }
		    rwork[k] += s;
		}
	    }
	    s = 0.;
	    for (i = 0; i < A->nrow; ++i) {
		if (rwork[i] > safe2)
		    s = SUPERLU_MAX( s, fabs(work[i]) / rwork[i] );
		else
		    s = SUPERLU_MAX( s, (fabs(work[i]) + safe1) / 
				(rwork[i] + safe1) );
	    }
	    berr[j] = s;

	    /* Test stopping criterion. Continue iterating if   
	       1) The residual BERR(J) is larger than machine epsilon, and   
	       2) BERR(J) decreased by at least a factor of 2 during the   
	          last iteration, and   
	       3) At most ITMAX iterations tried. */

	    if (berr[j] > eps && berr[j] * 2. <= lstres && count < ITMAX) {
		/* Update solution and try again. */
		sgstrs (trans, L, U, perm_c, perm_r, &Bjcol, stat, info);
		
#ifdef _CRAY
		SAXPY(&A->nrow, &done, work, &ione,
		       &Xmat[j*ldx], &ione);
#else
		saxpy_(&A->nrow, &done, work, &ione,
		       &Xmat[j*ldx], &ione);
#endif
		lstres = berr[j];
		++count;
	    } else {
		break;
	    }
        
	} /* end while */

	stat->RefineSteps = count;

	/* Bound error from formula:
	   norm(X - XTRUE) / norm(X) .le. FERR = norm( abs(inv(op(A)))*   
	   ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)   
          where   
            norm(Z) is the magnitude of the largest component of Z   
            inv(op(A)) is the inverse of op(A)   
            abs(Z) is the componentwise absolute value of the matrix or
	       vector Z   
            NZ is the maximum number of nonzeros in any row of A, plus 1   
            EPS is machine epsilon   

          The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))   
          is incremented by SAFE1 if the i-th component of   
          abs(op(A))*abs(X) + abs(B) is less than SAFE2.   

          Use SLACON to estimate the infinity-norm of the matrix   
             inv(op(A)) * diag(W),   
          where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) */
	
	for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] );
	
	/* Compute abs(op(A))*abs(X) + abs(B). */
	if ( notran ) {
	    for (k = 0; k < A->ncol; ++k) {
		xk = fabs( Xptr[k] );
		for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i)
		    rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk;
	    }
	} else {
	    for (k = 0; k < A->ncol; ++k) {
		s = 0.;
		for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) {
		    irow = Astore->rowind[i];
		    xk = fabs( Xptr[irow] );
		    s += fabs(Aval[i]) * xk;
		}
		rwork[k] += s;
	    }
	}
	
	for (i = 0; i < A->nrow; ++i)
	    if (rwork[i] > safe2)
		rwork[i] = fabs(work[i]) + (iwork[i]+1)*eps*rwork[i];
	    else
		rwork[i] = fabs(work[i])+(iwork[i]+1)*eps*rwork[i]+safe1;

	kase = 0;

	do {
	    slacon_(&A->nrow, &work[A->nrow], work,
		    &iwork[A->nrow], &ferr[j], &kase);
	    if (kase == 0) break;

	    if (kase == 1) {
		/* Multiply by diag(W)*inv(op(A)**T)*(diag(C) or diag(R)). */
		if ( notran && colequ )
		    for (i = 0; i < A->ncol; ++i) work[i] *= C[i];
		else if ( !notran && rowequ )
		    for (i = 0; i < A->nrow; ++i) work[i] *= R[i];
		
		sgstrs (transt, L, U, perm_c, perm_r, &Bjcol, stat, info);
		
		for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i];
	    } else {
		/* Multiply by (diag(C) or diag(R))*inv(op(A))*diag(W). */
		for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i];
		
		sgstrs (trans, L, U, perm_c, perm_r, &Bjcol, stat, info);
		
		if ( notran && colequ )
		    for (i = 0; i < A->ncol; ++i) work[i] *= C[i];
		else if ( !notran && rowequ )
		    for (i = 0; i < A->ncol; ++i) work[i] *= R[i];  
	    }
	    
	} while ( kase != 0 );


	/* Normalize error. */
	lstres = 0.;
 	if ( notran && colequ ) {
	    for (i = 0; i < A->nrow; ++i)
	    	lstres = SUPERLU_MAX( lstres, C[i] * fabs( Xptr[i]) );
  	} else if ( !notran && rowequ ) {
	    for (i = 0; i < A->nrow; ++i)
	    	lstres = SUPERLU_MAX( lstres, R[i] * fabs( Xptr[i]) );
	} else {
	    for (i = 0; i < A->nrow; ++i)
	    	lstres = SUPERLU_MAX( lstres, fabs( Xptr[i]) );
	}
	if ( lstres != 0. )
	    ferr[j] /= lstres;

    } /* for each RHS j ... */
    
    SUPERLU_FREE(work);
    SUPERLU_FREE(rwork);
    SUPERLU_FREE(iwork);
    SUPERLU_FREE(Bjcol.Store);

    return;

} /* sgsrfs */
Пример #9
0
/*! \brief
 *
 * <pre>
 *   Purpose   
 *   =======   
 *
 *   SGSRFS improves the computed solution to a system of linear   
 *   equations and provides error bounds and backward error estimates for 
 *   the solution.   
 *
 *   If equilibration was performed, the system becomes:
 *           (diag(R)*A_original*diag(C)) * X = diag(R)*B_original.
 *
 *   See supermatrix.h for the definition of 'SuperMatrix' structure.
 *
 *   Arguments   
 *   =========   
 *
 * trans   (input) trans_t
 *          Specifies the form of the system of equations:
 *          = NOTRANS: A * X = B  (No transpose)
 *          = TRANS:   A'* X = B  (Transpose)
 *          = CONJ:    A**H * X = B  (Conjugate transpose)
 *   
 *   A       (input) SuperMatrix*
 *           The original matrix A in the system, or the scaled A if
 *           equilibration was done. The type of A can be:
 *           Stype = SLU_NC, Dtype = SLU_S, Mtype = SLU_GE.
 *    
 *   L       (input) SuperMatrix*
 *	     The factor L from the factorization Pr*A*Pc=L*U. Use
 *           compressed row subscripts storage for supernodes, 
 *           i.e., L has types: Stype = SLU_SC, Dtype = SLU_S, Mtype = SLU_TRLU.
 * 
 *   U       (input) SuperMatrix*
 *           The factor U from the factorization Pr*A*Pc=L*U as computed by
 *           sgstrf(). Use column-wise storage scheme, 
 *           i.e., U has types: Stype = SLU_NC, Dtype = SLU_S, Mtype = SLU_TRU.
 *
 *   perm_c  (input) int*, dimension (A->ncol)
 *	     Column permutation vector, which defines the 
 *           permutation matrix Pc; perm_c[i] = j means column i of A is 
 *           in position j in A*Pc.
 *
 *   perm_r  (input) int*, dimension (A->nrow)
 *           Row permutation vector, which defines the permutation matrix Pr;
 *           perm_r[i] = j means row i of A is in position j in Pr*A.
 *
 *   equed   (input) Specifies the form of equilibration that was done.
 *           = 'N': No equilibration.
 *           = 'R': Row equilibration, i.e., A was premultiplied by diag(R).
 *           = 'C': Column equilibration, i.e., A was postmultiplied by
 *                  diag(C).
 *           = 'B': Both row and column equilibration, i.e., A was replaced 
 *                  by diag(R)*A*diag(C).
 *
 *   R       (input) float*, dimension (A->nrow)
 *           The row scale factors for A.
 *           If equed = 'R' or 'B', A is premultiplied by diag(R).
 *           If equed = 'N' or 'C', R is not accessed.
 * 
 *   C       (input) float*, dimension (A->ncol)
 *           The column scale factors for A.
 *           If equed = 'C' or 'B', A is postmultiplied by diag(C).
 *           If equed = 'N' or 'R', C is not accessed.
 *
 *   B       (input) SuperMatrix*
 *           B has types: Stype = SLU_DN, Dtype = SLU_S, Mtype = SLU_GE.
 *           The right hand side matrix B.
 *           if equed = 'R' or 'B', B is premultiplied by diag(R).
 *
 *   X       (input/output) SuperMatrix*
 *           X has types: Stype = SLU_DN, Dtype = SLU_S, Mtype = SLU_GE.
 *           On entry, the solution matrix X, as computed by sgstrs().
 *           On exit, the improved solution matrix X.
 *           if *equed = 'C' or 'B', X should be premultiplied by diag(C)
 *               in order to obtain the solution to the original system.
 *
 *   FERR    (output) float*, dimension (B->ncol)   
 *           The estimated forward error bound for each solution vector   
 *           X(j) (the j-th column of the solution matrix X).   
 *           If XTRUE is the true solution corresponding to X(j), FERR(j) 
 *           is an estimated upper bound for the magnitude of the largest 
 *           element in (X(j) - XTRUE) divided by the magnitude of the   
 *           largest element in X(j).  The estimate is as reliable as   
 *           the estimate for RCOND, and is almost always a slight   
 *           overestimate of the true error.
 *
 *   BERR    (output) float*, dimension (B->ncol)   
 *           The componentwise relative backward error of each solution   
 *           vector X(j) (i.e., the smallest relative change in   
 *           any element of A or B that makes X(j) an exact solution).
 *
 *   stat     (output) SuperLUStat_t*
 *            Record the statistics on runtime and floating-point operation count.
 *            See util.h for the definition of 'SuperLUStat_t'.
 *
 *   info    (output) int*   
 *           = 0:  successful exit   
 *            < 0:  if INFO = -i, the i-th argument had an illegal value   
 *
 *    Internal Parameters   
 *    ===================   
 *
 *    ITMAX is the maximum number of steps of iterative refinement.   
 *
 * </pre>
 */
void
sgsrfs(trans_t trans, SuperMatrix *A, SuperMatrix *L, SuperMatrix *U,
       int *perm_c, int *perm_r, char *equed, float *R, float *C,
       SuperMatrix *B, SuperMatrix *X, float *ferr, float *berr,
       SuperLUStat_t *stat, int *info)
{


#define ITMAX 5
    
    /* Table of constant values */
    int    ione = 1;
    float ndone = -1.;
    float done = 1.;
    
    /* Local variables */
    NCformat *Astore;
    float   *Aval;
    SuperMatrix Bjcol;
    DNformat *Bstore, *Xstore, *Bjcol_store;
    float   *Bmat, *Xmat, *Bptr, *Xptr;
    int      kase;
    float   safe1, safe2;
    int      i, j, k, irow, nz, count, notran, rowequ, colequ;
    int      ldb, ldx, nrhs;
    float   s, xk, lstres, eps, safmin;
    char     transc[1];
    trans_t  transt;
    float   *work;
    float   *rwork;
    int      *iwork;

    extern int slacon_(int *, float *, float *, int *, float *, int *);
#ifdef _CRAY
    extern int SCOPY(int *, float *, int *, float *, int *);
    extern int SSAXPY(int *, float *, float *, int *, float *, int *);
#else
    extern int scopy_(int *, float *, int *, float *, int *);
    extern int saxpy_(int *, float *, float *, int *, float *, int *);
#endif

    Astore = A->Store;
    Aval   = Astore->nzval;
    Bstore = B->Store;
    Xstore = X->Store;
    Bmat   = Bstore->nzval;
    Xmat   = Xstore->nzval;
    ldb    = Bstore->lda;
    ldx    = Xstore->lda;
    nrhs   = B->ncol;
    
    /* Test the input parameters */
    *info = 0;
    notran = (trans == NOTRANS);
    if ( !notran && trans != TRANS && trans != CONJ ) *info = -1;
    else if ( A->nrow != A->ncol || A->nrow < 0 ||
	      A->Stype != SLU_NC || A->Dtype != SLU_S || A->Mtype != SLU_GE )
	*info = -2;
    else if ( L->nrow != L->ncol || L->nrow < 0 ||
 	      L->Stype != SLU_SC || L->Dtype != SLU_S || L->Mtype != SLU_TRLU )
	*info = -3;
    else if ( U->nrow != U->ncol || U->nrow < 0 ||
 	      U->Stype != SLU_NC || U->Dtype != SLU_S || U->Mtype != SLU_TRU )
	*info = -4;
    else if ( ldb < SUPERLU_MAX(0, A->nrow) ||
 	      B->Stype != SLU_DN || B->Dtype != SLU_S || B->Mtype != SLU_GE )
        *info = -10;
    else if ( ldx < SUPERLU_MAX(0, A->nrow) ||
 	      X->Stype != SLU_DN || X->Dtype != SLU_S || X->Mtype != SLU_GE )
	*info = -11;
    if (*info != 0) {
	i = -(*info);
	xerbla_("sgsrfs", &i);
	return;
    }

    /* Quick return if possible */
    if ( A->nrow == 0 || nrhs == 0) {
	for (j = 0; j < nrhs; ++j) {
	    ferr[j] = 0.;
	    berr[j] = 0.;
	}
	return;
    }

    rowequ = lsame_(equed, "R") || lsame_(equed, "B");
    colequ = lsame_(equed, "C") || lsame_(equed, "B");
    
    /* Allocate working space */
    work = floatMalloc(2*A->nrow);
    rwork = (float *) SUPERLU_MALLOC( A->nrow * sizeof(float) );
    iwork = intMalloc(2*A->nrow);
    if ( !work || !rwork || !iwork ) 
        ABORT("Malloc fails for work/rwork/iwork.");
    
    if ( notran ) {
	*(unsigned char *)transc = 'N';
        transt = TRANS;
    } else {
	*(unsigned char *)transc = 'T';
	transt = NOTRANS;
    }

    /* NZ = maximum number of nonzero elements in each row of A, plus 1 */
    nz     = A->ncol + 1;
    eps    = slamch_("Epsilon");
    safmin = slamch_("Safe minimum");
    /* Set SAFE1 essentially to be the underflow threshold times the
       number of additions in each row. */
    safe1  = nz * safmin;
    safe2  = safe1 / eps;

    /* Compute the number of nonzeros in each row (or column) of A */
    for (i = 0; i < A->nrow; ++i) iwork[i] = 0;
    if ( notran ) {
	for (k = 0; k < A->ncol; ++k)
	    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) 
		++iwork[Astore->rowind[i]];
    } else {
	for (k = 0; k < A->ncol; ++k)
	    iwork[k] = Astore->colptr[k+1] - Astore->colptr[k];
    }	

    /* Copy one column of RHS B into Bjcol. */
    Bjcol.Stype = B->Stype;
    Bjcol.Dtype = B->Dtype;
    Bjcol.Mtype = B->Mtype;
    Bjcol.nrow  = B->nrow;
    Bjcol.ncol  = 1;
    Bjcol.Store = (void *) SUPERLU_MALLOC( sizeof(DNformat) );
    if ( !Bjcol.Store ) ABORT("SUPERLU_MALLOC fails for Bjcol.Store");
    Bjcol_store = Bjcol.Store;
    Bjcol_store->lda = ldb;
    Bjcol_store->nzval = work; /* address aliasing */
	
    /* Do for each right hand side ... */
    for (j = 0; j < nrhs; ++j) {
	count = 0;
	lstres = 3.;
	Bptr = &Bmat[j*ldb];
	Xptr = &Xmat[j*ldx];

	while (1) { /* Loop until stopping criterion is satisfied. */

	    /* Compute residual R = B - op(A) * X,   
	       where op(A) = A, A**T, or A**H, depending on TRANS. */
	    
#ifdef _CRAY
	    SCOPY(&A->nrow, Bptr, &ione, work, &ione);
#else
	    scopy_(&A->nrow, Bptr, &ione, work, &ione);
#endif
	    sp_sgemv(transc, ndone, A, Xptr, ione, done, work, ione);

	    /* Compute componentwise relative backward error from formula 
	       max(i) ( abs(R(i)) / ( abs(op(A))*abs(X) + abs(B) )(i) )   
	       where abs(Z) is the componentwise absolute value of the matrix
	       or vector Z.  If the i-th component of the denominator is less
	       than SAFE2, then SAFE1 is added to the i-th component of the   
	       numerator before dividing. */

	    for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] );
	    
	    /* Compute abs(op(A))*abs(X) + abs(B). */
	    if (notran) {
		for (k = 0; k < A->ncol; ++k) {
		    xk = fabs( Xptr[k] );
		    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i)
			rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk;
		}
	    } else {
		for (k = 0; k < A->ncol; ++k) {
		    s = 0.;
		    for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) {
			irow = Astore->rowind[i];
			s += fabs(Aval[i]) * fabs(Xptr[irow]);
		    }
		    rwork[k] += s;
		}
	    }
	    s = 0.;
	    for (i = 0; i < A->nrow; ++i) {
		if (rwork[i] > safe2) {
		    s = SUPERLU_MAX( s, fabs(work[i]) / rwork[i] );
		} else if ( rwork[i] != 0.0 ) {
                    /* Adding SAFE1 to the numerator guards against
                       spuriously zero residuals (underflow). */
		    s = SUPERLU_MAX( s, (safe1 + fabs(work[i])) / rwork[i] );
                }
                /* If rwork[i] is exactly 0.0, then we know the true 
                   residual also must be exactly 0.0. */
	    }
	    berr[j] = s;

	    /* Test stopping criterion. Continue iterating if   
	       1) The residual BERR(J) is larger than machine epsilon, and   
	       2) BERR(J) decreased by at least a factor of 2 during the   
	          last iteration, and   
	       3) At most ITMAX iterations tried. */

	    if (berr[j] > eps && berr[j] * 2. <= lstres && count < ITMAX) {
		/* Update solution and try again. */
		sgstrs (trans, L, U, perm_c, perm_r, &Bjcol, stat, info);
		
#ifdef _CRAY
		SAXPY(&A->nrow, &done, work, &ione,
		       &Xmat[j*ldx], &ione);
#else
		saxpy_(&A->nrow, &done, work, &ione,
		       &Xmat[j*ldx], &ione);
#endif
		lstres = berr[j];
		++count;
	    } else {
		break;
	    }
        
	} /* end while */

	stat->RefineSteps = count;

	/* Bound error from formula:
	   norm(X - XTRUE) / norm(X) .le. FERR = norm( abs(inv(op(A)))*   
	   ( abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) / norm(X)   
          where   
            norm(Z) is the magnitude of the largest component of Z   
            inv(op(A)) is the inverse of op(A)   
            abs(Z) is the componentwise absolute value of the matrix or
	       vector Z   
            NZ is the maximum number of nonzeros in any row of A, plus 1   
            EPS is machine epsilon   

          The i-th component of abs(R)+NZ*EPS*(abs(op(A))*abs(X)+abs(B))   
          is incremented by SAFE1 if the i-th component of   
          abs(op(A))*abs(X) + abs(B) is less than SAFE2.   

          Use SLACON to estimate the infinity-norm of the matrix   
             inv(op(A)) * diag(W),   
          where W = abs(R) + NZ*EPS*( abs(op(A))*abs(X)+abs(B) ))) */
	
	for (i = 0; i < A->nrow; ++i) rwork[i] = fabs( Bptr[i] );
	
	/* Compute abs(op(A))*abs(X) + abs(B). */
	if ( notran ) {
	    for (k = 0; k < A->ncol; ++k) {
		xk = fabs( Xptr[k] );
		for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i)
		    rwork[Astore->rowind[i]] += fabs(Aval[i]) * xk;
	    }
	} else {
	    for (k = 0; k < A->ncol; ++k) {
		s = 0.;
		for (i = Astore->colptr[k]; i < Astore->colptr[k+1]; ++i) {
		    irow = Astore->rowind[i];
		    xk = fabs( Xptr[irow] );
		    s += fabs(Aval[i]) * xk;
		}
		rwork[k] += s;
	    }
	}
	
	for (i = 0; i < A->nrow; ++i)
	    if (rwork[i] > safe2)
		rwork[i] = fabs(work[i]) + (iwork[i]+1)*eps*rwork[i];
	    else
		rwork[i] = fabs(work[i])+(iwork[i]+1)*eps*rwork[i]+safe1;

	kase = 0;

	do {
	    slacon_(&A->nrow, &work[A->nrow], work,
		    &iwork[A->nrow], &ferr[j], &kase);
	    if (kase == 0) break;

	    if (kase == 1) {
		/* Multiply by diag(W)*inv(op(A)**T)*(diag(C) or diag(R)). */
		if ( notran && colequ )
		    for (i = 0; i < A->ncol; ++i) work[i] *= C[i];
		else if ( !notran && rowequ )
		    for (i = 0; i < A->nrow; ++i) work[i] *= R[i];
		
		sgstrs (transt, L, U, perm_c, perm_r, &Bjcol, stat, info);
		
		for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i];
	    } else {
		/* Multiply by (diag(C) or diag(R))*inv(op(A))*diag(W). */
		for (i = 0; i < A->nrow; ++i) work[i] *= rwork[i];
		
		sgstrs (trans, L, U, perm_c, perm_r, &Bjcol, stat, info);
		
		if ( notran && colequ )
		    for (i = 0; i < A->ncol; ++i) work[i] *= C[i];
		else if ( !notran && rowequ )
		    for (i = 0; i < A->ncol; ++i) work[i] *= R[i];  
	    }
	    
	} while ( kase != 0 );


	/* Normalize error. */
	lstres = 0.;
 	if ( notran && colequ ) {
	    for (i = 0; i < A->nrow; ++i)
	    	lstres = SUPERLU_MAX( lstres, C[i] * fabs( Xptr[i]) );
  	} else if ( !notran && rowequ ) {
	    for (i = 0; i < A->nrow; ++i)
	    	lstres = SUPERLU_MAX( lstres, R[i] * fabs( Xptr[i]) );
	} else {
	    for (i = 0; i < A->nrow; ++i)
	    	lstres = SUPERLU_MAX( lstres, fabs( Xptr[i]) );
	}
	if ( lstres != 0. )
	    ferr[j] /= lstres;

    } /* for each RHS j ... */
    
    SUPERLU_FREE(work);
    SUPERLU_FREE(rwork);
    SUPERLU_FREE(iwork);
    SUPERLU_FREE(Bjcol.Store);

    return;

} /* sgsrfs */