Пример #1
0
main(int argc, char *argv[])
{
    SuperMatrix A, AC, L, U, B;
    NCformat    *Astore;
    SCPformat   *Lstore;
    NCPformat   *Ustore;
    superlumt_options_t superlumt_options;
    pxgstrf_shared_t pxgstrf_shared;
    pdgstrf_threadarg_t *pdgstrf_threadarg;
    int         nprocs;
    fact_t      fact;
    trans_t     trans;
    yes_no_t    refact, usepr;
    double      u, drop_tol;
    double      *a;
    int         *asub, *xa;
    int         *perm_c; /* column permutation vector */
    int         *perm_r; /* row permutations from partial pivoting */
    void        *work;
    int         info, lwork, nrhs, ldx; 
    int         m, n, nnz, permc_spec, panel_size, relax;
    int         i, firstfact;
    double      *rhsb, *xact;
    Gstat_t Gstat;
    flops_t     flopcnt;
    void parse_command_line();

    /* Default parameters to control factorization. */
    nprocs = 1;
    fact  = EQUILIBRATE;
    trans = NOTRANS;
    panel_size = sp_ienv(1);
    relax = sp_ienv(2);
    u     = 1.0;
    usepr = NO;
    drop_tol = 0.0;
    work = NULL;
    lwork = 0;
    nrhs  = 1;

    /* Get the number of processes from command line. */
    parse_command_line(argc, argv, &nprocs);

    /* Read the input matrix stored in Harwell-Boeing format. */
    dreadhb(&m, &n, &nnz, &a, &asub, &xa);

    /* Set up the sparse matrix data structure for A. */
    dCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE);

    if (!(rhsb = doubleMalloc(m * nrhs))) SUPERLU_ABORT("Malloc fails for rhsb[].");
    dCreate_Dense_Matrix(&B, m, nrhs, rhsb, m, SLU_DN, SLU_D, SLU_GE);
    xact = doubleMalloc(n * nrhs);
    ldx = n;
    dGenXtrue(n, nrhs, xact, ldx);
    dFillRHS(trans, nrhs, xact, ldx, &A, &B);
    
    if (!(perm_r = intMalloc(m))) SUPERLU_ABORT("Malloc fails for perm_r[].");
    if (!(perm_c = intMalloc(n))) SUPERLU_ABORT("Malloc fails for perm_c[].");


    /********************************
     * THE FIRST TIME FACTORIZATION *
     ********************************/

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

    /* ------------------------------------------------------------
       Get column permutation vector perm_c[], according to permc_spec:
       permc_spec = 0: natural ordering 
       permc_spec = 1: minimum degree ordering on structure of A'*A
       permc_spec = 2: minimum degree ordering on structure of A'+A
       permc_spec = 3: approximate minimum degree for unsymmetric matrices
       ------------------------------------------------------------*/ 	
    permc_spec = 1;
    get_perm_c(permc_spec, &A, perm_c);

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

    /* ------------------------------------------------------------
       Compute the LU factorization of A.
       The following routine will create nprocs threads.
       ------------------------------------------------------------*/
    pdgstrf(&superlumt_options, &AC, perm_r, &L, &U, &Gstat, &info);
    
    flopcnt = 0;
    for (i = 0; i < nprocs; ++i) flopcnt += Gstat.procstat[i].fcops;
    Gstat.ops[FACT] = flopcnt;

    /* ------------------------------------------------------------
       Solve the system A*X=B, overwriting B with X.
       ------------------------------------------------------------*/
    dgstrs(trans, &L, &U, perm_r, perm_c, &B, &Gstat, &info);
    
    printf("\n** Result of sparse LU **\n");
    dinf_norm_error(nrhs, &B, xact); /* Check inf. norm of the error */

    Destroy_CompCol_Permuted(&AC); /* Free extra arrays in AC. */


    /*********************************
     * THE SUBSEQUENT FACTORIZATIONS *
     *********************************/

    /* ------------------------------------------------------------
       Re-initialize statistics variables and options used by the
       factorization routine pdgstrf().
       ------------------------------------------------------------*/
    StatInit(n, nprocs, &Gstat);
    refact= YES;
    pdgstrf_init(nprocs, fact, trans, refact, panel_size, relax,
		 u, usepr, drop_tol, perm_c, perm_r,
		 work, lwork, &A, &AC, &superlumt_options, &Gstat);

    /* ------------------------------------------------------------
       Compute the LU factorization of A.
       The following routine will create nprocs threads.
       ------------------------------------------------------------*/
    pdgstrf(&superlumt_options, &AC, perm_r, &L, &U, &Gstat, &info);
    
    flopcnt = 0;
    for (i = 0; i < nprocs; ++i) flopcnt += Gstat.procstat[i].fcops;
    Gstat.ops[FACT] = flopcnt;

    /* ------------------------------------------------------------
       Re-generate right-hand side B, then solve A*X= B.
       ------------------------------------------------------------*/
    dFillRHS(trans, nrhs, xact, ldx, &A, &B);
    dgstrs(trans, &L, &U, perm_r, perm_c, &B, &Gstat, &info);

    
     /* ------------------------------------------------------------
       Deallocate storage after factorization.
       ------------------------------------------------------------*/
    pxgstrf_finalize(&superlumt_options, &AC);

    printf("\n** Result of sparse LU **\n");
    dinf_norm_error(nrhs, &B, xact); /* Check inf. norm of the error */

    Lstore = (SCPformat *) L.Store;
    Ustore = (NCPformat *) U.Store;
    printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
    printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
    printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
    fflush(stdout);

    SUPERLU_FREE (rhsb);
    SUPERLU_FREE (xact);
    SUPERLU_FREE (perm_r);
    SUPERLU_FREE (perm_c);
    Destroy_CompCol_Matrix(&A);
    Destroy_SuperMatrix_Store(&B);
    if ( lwork >= 0 ) {
        Destroy_SuperNode_SCP(&L);
        Destroy_CompCol_NCP(&U);
    }
    StatFree(&Gstat);
}
Пример #2
0
bool SparseMatrix::solveSLU (Vector& B)
{
  int ierr = ncol+1;
  if (!factored) this->optimiseSLU();

#ifdef HAS_SUPERLU_MT
  if (!slu) {
    // Create a new SuperLU matrix
    slu = new SuperLUdata;
    slu->perm_c = new int[ncol];
    slu->perm_r = new int[nrow];
    dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
                           &A.front(), &JA.front(), &IA.front(),
                           SLU_NC, SLU_D, SLU_GE);
  }
  else {
    Destroy_SuperMatrix_Store(&slu->A);
    Destroy_SuperNode_Matrix(&slu->L);
    Destroy_CompCol_Matrix(&slu->U);
    dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
                           &A.front(), &JA.front(), &IA.front(),
                           SLU_NC, SLU_D, SLU_GE);
  }

  // Get column permutation vector perm_c[], according to permc_spec:
  //   permc_spec = 0: natural ordering
  //   permc_spec = 1: minimum degree ordering on structure of A'*A
  //   permc_spec = 2: minimum degree ordering on structure of A'+A
  //   permc_spec = 3: approximate minimum degree for unsymmetric matrices
  int permc_spec = 1;
  get_perm_c(permc_spec, &slu->A, slu->perm_c);

  // Create right-hand-side/solution vector(s)
  size_t nrhs = B.size() / nrow;
  SuperMatrix Bmat;
  dCreate_Dense_Matrix(&Bmat, nrow, nrhs, B.ptr(), nrow,
                       SLU_DN, SLU_D, SLU_GE);

  // Invoke the simple driver
  pdgssv(numThreads, &slu->A, slu->perm_c, slu->perm_r,
         &slu->L, &slu->U, &Bmat, &ierr);

  if (ierr > 0)
    std::cerr <<"SuperLU_MT Failure "<< ierr << std::endl;

  Destroy_SuperMatrix_Store(&Bmat);

#elif defined(HAS_SUPERLU)
  if (!slu) {
    // Create a new SuperLU matrix
    slu = new SuperLUdata(1);
    slu->perm_c = new int[ncol];
    slu->perm_r = new int[nrow];
    dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
                           &A.front(), &JA.front(), &IA.front(),
                           SLU_NC, SLU_D, SLU_GE);
  }
  else if (factored)
    slu->opts->Fact = FACTORED; // Re-use previous factorization
  else {
    Destroy_SuperMatrix_Store(&slu->A);
    Destroy_SuperNode_Matrix(&slu->L);
    Destroy_CompCol_Matrix(&slu->U);
    dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
                           &A.front(), &JA.front(), &IA.front(),
                           SLU_NC, SLU_D, SLU_GE);
  }

  // Create right-hand-side/solution vector(s)
  size_t nrhs = B.size() / nrow;
  SuperMatrix Bmat;
  dCreate_Dense_Matrix(&Bmat, nrow, nrhs, B.ptr(), nrow,
                       SLU_DN, SLU_D, SLU_GE);

  SuperLUStat_t stat;
  StatInit(&stat);

  // Invoke the simple driver
  dgssv(slu->opts, &slu->A, slu->perm_c, slu->perm_r,
        &slu->L, &slu->U, &Bmat, &stat, &ierr);

  if (ierr > 0)
    std::cerr <<"SuperLU Failure "<< ierr << std::endl;
  else
    factored = true;

  if (printSLUstat)
    StatPrint(&stat);
  StatFree(&stat);

  Destroy_SuperMatrix_Store(&Bmat);
#else
  std::cerr <<"SparseMatrix::solve: SuperLU solver not available"<< std::endl;
#endif
  return ierr == 0;
}
Пример #3
0
void
cgssv(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
      SuperMatrix *L, SuperMatrix *U, SuperMatrix *B,
      SuperLUStat_t *stat, int *info )
{

    DNformat *Bstore;
    SuperMatrix *AA;/* 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_C || 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_C || B->Mtype != SLU_GE )
	*info = -7;
    if ( *info != 0 ) {
	i = -(*info);
	xerbla_("cgssv", &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) );
	cCreate_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. */
    cgstrf(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. */
        cgstrs (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);
    }

}
Пример #4
0
main(int argc, char *argv[])
{
/*
 * Purpose
 * =======
 *
 * ZDRIVE is the main test program for the DOUBLE COMPLEX linear
 * equation driver routines ZGSSV and ZGSSVX.
 *
 * The program is invoked by a shell script file -- ztest.csh.
 * The output from the tests are written into a file -- ztest.out.
 *
 * =====================================================================
 */
    doublecomplex         *a, *a_save;
    int            *asub, *asub_save;
    int            *xa, *xa_save;
    SuperMatrix  A, B, X, L, U;
    SuperMatrix  ASAV, AC;
    mem_usage_t    mem_usage;
    int            *perm_r; /* row permutation from partial pivoting */
    int            *perm_c, *pc_save; /* column permutation */
    int            *etree;
    doublecomplex  zero = {0.0, 0.0};
    double         *R, *C;
    double         *ferr, *berr;
    double         *rwork;
    doublecomplex          *wwork;
    void           *work;
    int            info, lwork, nrhs, panel_size, relax;
    int            m, n, nnz;
    doublecomplex         *xact;
    doublecomplex         *rhsb, *solx, *bsav;
    int            ldb, ldx;
    double         rpg, rcond;
    int            i, j, k1;
    double         rowcnd, colcnd, amax;
    int            maxsuper, rowblk, colblk;
    int            prefact, nofact, equil, iequed;
    int            nt, nrun, nfail, nerrs, imat, fimat, nimat;
    int            nfact, ifact, itran;
    int            kl, ku, mode, lda;
    int            zerot, izero, ioff;
    double         u;
    double         anorm, cndnum;
    doublecomplex         *Afull;
    double         result[NTESTS];
    superlu_options_t options;
    fact_t         fact;
    trans_t        trans;
    SuperLUStat_t  stat;
    static char    matrix_type[8];
    static char    equed[1], path[4], sym[1], dist[1];

    /* Fixed set of parameters */
    int            iseed[]  = {1988, 1989, 1990, 1991};
    static char    equeds[]  = {'N', 'R', 'C', 'B'};
    static fact_t  facts[] = {FACTORED, DOFACT, SamePattern,
                              SamePattern_SameRowPerm};
    static trans_t transs[]  = {NOTRANS, TRANS, CONJ};

    /* Some function prototypes */
    extern int zgst01(int, int, SuperMatrix *, SuperMatrix *,
                      SuperMatrix *, int *, int *, double *);
    extern int zgst02(trans_t, int, int, int, SuperMatrix *, doublecomplex *,
                      int, doublecomplex *, int, double *resid);
    extern int zgst04(int, int, doublecomplex *, int,
                      doublecomplex *, int, double rcond, double *resid);
    extern int zgst07(trans_t, int, int, SuperMatrix *, doublecomplex *, int,
                         doublecomplex *, int, doublecomplex *, int,
                         double *, double *, double *);
    extern int zlatb4_(char *, int *, int *, int *, char *, int *, int *,
                       double *, int *, double *, char *);
    extern int zlatms_(int *, int *, char *, int *, char *, double *d,
                       int *, double *, double *, int *, int *,
                       char *, doublecomplex *, int *, doublecomplex *, int *);
    extern int sp_zconvert(int, int, doublecomplex *, int, int, int,
                           doublecomplex *a, int *, int *, int *);


    /* Executable statements */

    strcpy(path, "ZGE");
    nrun  = 0;
    nfail = 0;
    nerrs = 0;

    /* Defaults */
    lwork      = 0;
    n          = 1;
    nrhs       = 1;
    panel_size = sp_ienv(1);
    relax      = sp_ienv(2);
    u          = 1.0;
    strcpy(matrix_type, "LA");
    parse_command_line(argc, argv, matrix_type, &n,
                       &panel_size, &relax, &nrhs, &maxsuper,
                       &rowblk, &colblk, &lwork, &u);
    if ( lwork > 0 ) {
        work = SUPERLU_MALLOC(lwork);
        if ( !work ) {
            fprintf(stderr, "expert: cannot allocate %d bytes\n", lwork);
            exit (-1);
        }
    }

    /* Set the default input options. */
    set_default_options(&options);
    options.DiagPivotThresh = u;
    options.PrintStat = NO;
    options.PivotGrowth = YES;
    options.ConditionNumber = YES;
    options.IterRefine = DOUBLE;

    if ( strcmp(matrix_type, "LA") == 0 ) {
        /* Test LAPACK matrix suite. */
        m = n;
        lda = SUPERLU_MAX(n, 1);
        nnz = n * n;        /* upper bound */
        fimat = 1;
        nimat = NTYPES;
        Afull = doublecomplexCalloc(lda * n);
        zallocateA(n, nnz, &a, &asub, &xa);
    } else {
        /* Read a sparse matrix */
        fimat = nimat = 0;
        zreadhb(&m, &n, &nnz, &a, &asub, &xa);
    }

    zallocateA(n, nnz, &a_save, &asub_save, &xa_save);
    rhsb = doublecomplexMalloc(m * nrhs);
    bsav = doublecomplexMalloc(m * nrhs);
    solx = doublecomplexMalloc(n * nrhs);
    ldb  = m;
    ldx  = n;
    zCreate_Dense_Matrix(&B, m, nrhs, rhsb, ldb, SLU_DN, SLU_Z, SLU_GE);
    zCreate_Dense_Matrix(&X, n, nrhs, solx, ldx, SLU_DN, SLU_Z, SLU_GE);
    xact = doublecomplexMalloc(n * nrhs);
    etree   = intMalloc(n);
    perm_r  = intMalloc(n);
    perm_c  = intMalloc(n);
    pc_save = intMalloc(n);
    R       = (double *) SUPERLU_MALLOC(m*sizeof(double));
    C       = (double *) SUPERLU_MALLOC(n*sizeof(double));
    ferr    = (double *) SUPERLU_MALLOC(nrhs*sizeof(double));
    berr    = (double *) SUPERLU_MALLOC(nrhs*sizeof(double));
    j = SUPERLU_MAX(m,n) * SUPERLU_MAX(4,nrhs);
    rwork   = (double *) SUPERLU_MALLOC(j*sizeof(double));
    for (i = 0; i < j; ++i) rwork[i] = 0.;
    if ( !R ) ABORT("SUPERLU_MALLOC fails for R");
    if ( !C ) ABORT("SUPERLU_MALLOC fails for C");
    if ( !ferr ) ABORT("SUPERLU_MALLOC fails for ferr");
    if ( !berr ) ABORT("SUPERLU_MALLOC fails for berr");
    if ( !rwork ) ABORT("SUPERLU_MALLOC fails for rwork");
    wwork   = doublecomplexCalloc( SUPERLU_MAX(m,n) * SUPERLU_MAX(4,nrhs) );

    for (i = 0; i < n; ++i) perm_c[i] = pc_save[i] = i;
    options.ColPerm = MY_PERMC;

    for (imat = fimat; imat <= nimat; ++imat) { /* All matrix types */

        if ( imat ) {

            /* Skip types 5, 6, or 7 if the matrix size is too small. */
            zerot = (imat >= 5 && imat <= 7);
            if ( zerot && n < imat-4 )
                continue;

            /* Set up parameters with ZLATB4 and generate a test matrix
               with ZLATMS.  */
            zlatb4_(path, &imat, &n, &n, sym, &kl, &ku, &anorm, &mode,
                    &cndnum, dist);

            zlatms_(&n, &n, dist, iseed, sym, &rwork[0], &mode, &cndnum,
                    &anorm, &kl, &ku, "No packing", Afull, &lda,
                    &wwork[0], &info);

            if ( info ) {
                printf(FMT3, "ZLATMS", info, izero, n, nrhs, imat, nfail);
                continue;
            }

            /* For types 5-7, zero one or more columns of the matrix
               to test that INFO is returned correctly.   */
            if ( zerot ) {
                if ( imat == 5 ) izero = 1;
                else if ( imat == 6 ) izero = n;
                else izero = n / 2 + 1;
                ioff = (izero - 1) * lda;
                if ( imat < 7 ) {
                    for (i = 0; i < n; ++i) Afull[ioff + i] = zero;
                } else {
                    for (j = 0; j < n - izero + 1; ++j)
                        for (i = 0; i < n; ++i)
                            Afull[ioff + i + j*lda] = zero;
                }
            } else {
                izero = 0;
            }

            /* Convert to sparse representation. */
            sp_zconvert(n, n, Afull, lda, kl, ku, a, asub, xa, &nnz);

        } else {
            izero = 0;
            zerot = 0;
        }

        zCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_Z, SLU_GE);

        /* Save a copy of matrix A in ASAV */
        zCreate_CompCol_Matrix(&ASAV, m, n, nnz, a_save, asub_save, xa_save,
                              SLU_NC, SLU_Z, SLU_GE);
        zCopy_CompCol_Matrix(&A, &ASAV);

        /* Form exact solution. */
        zGenXtrue(n, nrhs, xact, ldx);

        StatInit(&stat);

        for (iequed = 0; iequed < 4; ++iequed) {
            *equed = equeds[iequed];
            if (iequed == 0) nfact = 4;
            else nfact = 1; /* Only test factored, pre-equilibrated matrix */

            for (ifact = 0; ifact < nfact; ++ifact) {
                fact = facts[ifact];
                options.Fact = fact;

                for (equil = 0; equil < 2; ++equil) {
                    options.Equil = equil;
                    prefact   = ( options.Fact == FACTORED ||
                                  options.Fact == SamePattern_SameRowPerm );
                                /* Need a first factor */
                    nofact    = (options.Fact != FACTORED);  /* Not factored */

                    /* Restore the matrix A. */
                    zCopy_CompCol_Matrix(&ASAV, &A);

                    if ( zerot ) {
                        if ( prefact ) continue;
                    } else if ( options.Fact == FACTORED ) {
                        if ( equil || iequed ) {
                            /* Compute row and column scale factors to
                               equilibrate matrix A.    */
                            zgsequ(&A, R, C, &rowcnd, &colcnd, &amax, &info);

                            /* Force equilibration. */
                            if ( !info && n > 0 ) {
                                if ( lsame_(equed, "R") ) {
                                    rowcnd = 0.;
                                    colcnd = 1.;
                                } else if ( lsame_(equed, "C") ) {
                                    rowcnd = 1.;
                                    colcnd = 0.;
                                } else if ( lsame_(equed, "B") ) {
                                    rowcnd = 0.;
                                    colcnd = 0.;
                                }
                            }

                            /* Equilibrate the matrix. */
                            zlaqgs(&A, R, C, rowcnd, colcnd, amax, equed);
                        }
                    }

                    if ( prefact ) { /* Need a factor for the first time */

                        /* Save Fact option. */
                        fact = options.Fact;
                        options.Fact = DOFACT;

                        /* Preorder the matrix, obtain the column etree. */
                        sp_preorder(&options, &A, perm_c, etree, &AC);

                        /* Factor the matrix AC. */
                        zgstrf(&options, &AC, relax, panel_size,
                               etree, work, lwork, perm_c, perm_r, &L, &U,
                               &stat, &info);

                        if ( info ) {
                            printf("** First factor: info %d, equed %c\n",
                                   info, *equed);
                            if ( lwork == -1 ) {
                                printf("** Estimated memory: %d bytes\n",
                                        info - n);
                                exit(0);
                            }
                        }

                        Destroy_CompCol_Permuted(&AC);

                        /* Restore Fact option. */
                        options.Fact = fact;
                    } /* if .. first time factor */

                    for (itran = 0; itran < NTRAN; ++itran) {
                        trans = transs[itran];
                        options.Trans = trans;

                        /* Restore the matrix A. */
                        zCopy_CompCol_Matrix(&ASAV, &A);

                        /* Set the right hand side. */
                        zFillRHS(trans, nrhs, xact, ldx, &A, &B);
                        zCopy_Dense_Matrix(m, nrhs, rhsb, ldb, bsav, ldb);

                        /*----------------
                         * Test zgssv
                         *----------------*/
                        if ( options.Fact == DOFACT && itran == 0) {
                            /* Not yet factored, and untransposed */

                            zCopy_Dense_Matrix(m, nrhs, rhsb, ldb, solx, ldx);
                            zgssv(&options, &A, perm_c, perm_r, &L, &U, &X,
                                  &stat, &info);

                            if ( info && info != izero ) {
                                printf(FMT3, "zgssv",
                                       info, izero, n, nrhs, imat, nfail);
                            } else {
                                /* Reconstruct matrix from factors and
                                   compute residual. */
                                zgst01(m, n, &A, &L, &U, perm_c, perm_r,
                                         &result[0]);
                                nt = 1;
                                if ( izero == 0 ) {
                                    /* Compute residual of the computed
                                       solution. */
                                    zCopy_Dense_Matrix(m, nrhs, rhsb, ldb,
                                                       wwork, ldb);
                                    zgst02(trans, m, n, nrhs, &A, solx,
                                              ldx, wwork,ldb, &result[1]);
                                    nt = 2;
                                }

                                /* Print information about the tests that
                                   did not pass the threshold.      */
                                for (i = 0; i < nt; ++i) {
                                    if ( result[i] >= THRESH ) {
                                        printf(FMT1, "zgssv", n, i,
                                               result[i]);
                                        ++nfail;
                                    }
                                }
                                nrun += nt;
                            } /* else .. info == 0 */

                            /* Restore perm_c. */
                            for (i = 0; i < n; ++i) perm_c[i] = pc_save[i];

                            if (lwork == 0) {
                                Destroy_SuperNode_Matrix(&L);
                                Destroy_CompCol_Matrix(&U);
                            }
                        } /* if .. end of testing zgssv */

                        /*----------------
                         * Test zgssvx
                         *----------------*/

                        /* Equilibrate the matrix if fact = FACTORED and
                           equed = 'R', 'C', or 'B'.   */
                        if ( options.Fact == FACTORED &&
                             (equil || iequed) && n > 0 ) {
                            zlaqgs(&A, R, C, rowcnd, colcnd, amax, equed);
                        }

                        /* Solve the system and compute the condition number
                           and error bounds using zgssvx.      */
                        zgssvx(&options, &A, perm_c, perm_r, etree,
                               equed, R, C, &L, &U, work, lwork, &B, &X, &rpg,
                               &rcond, ferr, berr, &mem_usage, &stat, &info);

                        if ( info && info != izero ) {
                            printf(FMT3, "zgssvx",
                                   info, izero, n, nrhs, imat, nfail);
                            if ( lwork == -1 ) {
                                printf("** Estimated memory: %.0f bytes\n",
                                        mem_usage.total_needed);
                                exit(0);
                            }
                        } else {
                            if ( !prefact ) {
                                /* Reconstruct matrix from factors and
                                   compute residual. */
                                zgst01(m, n, &A, &L, &U, perm_c, perm_r,
                                         &result[0]);
                                k1 = 0;
                            } else {
                                k1 = 1;
                            }

                            if ( !info ) {
                                /* Compute residual of the computed solution.*/
                                zCopy_Dense_Matrix(m, nrhs, bsav, ldb,
                                                  wwork, ldb);
                                zgst02(trans, m, n, nrhs, &ASAV, solx, ldx,
                                          wwork, ldb, &result[1]);

                                /* Check solution from generated exact
                                   solution. */
                                zgst04(n, nrhs, solx, ldx, xact, ldx, rcond,
                                          &result[2]);

                                /* Check the error bounds from iterative
                                   refinement. */
                                zgst07(trans, n, nrhs, &ASAV, bsav, ldb,
                                          solx, ldx, xact, ldx, ferr, berr,
                                          &result[3]);

                                /* Print information about the tests that did
                                   not pass the threshold.    */
                                for (i = k1; i < NTESTS; ++i) {
                                    if ( result[i] >= THRESH ) {
                                        printf(FMT2, "zgssvx",
                                               options.Fact, trans, *equed,
                                               n, imat, i, result[i]);
                                        ++nfail;
                                    }
                                }
                                nrun += NTESTS;
                            } /* if .. info == 0 */
                        } /* else .. end of testing zgssvx */

                    } /* for itran ... */

                    if ( lwork == 0 ) {
                        Destroy_SuperNode_Matrix(&L);
                        Destroy_CompCol_Matrix(&U);
                    }

                } /* for equil ... */
            } /* for ifact ... */
        } /* for iequed ... */
#if 0
    if ( !info ) {
        PrintPerf(&L, &U, &mem_usage, rpg, rcond, ferr, berr, equed);
    }
#endif

    } /* for imat ... */

    /* Print a summary of the results. */
    PrintSumm("ZGE", nfail, nrun, nerrs);

    SUPERLU_FREE (rhsb);
    SUPERLU_FREE (bsav);
    SUPERLU_FREE (solx);
    SUPERLU_FREE (xact);
    SUPERLU_FREE (etree);
    SUPERLU_FREE (perm_r);
    SUPERLU_FREE (perm_c);
    SUPERLU_FREE (pc_save);
    SUPERLU_FREE (R);
    SUPERLU_FREE (C);
    SUPERLU_FREE (ferr);
    SUPERLU_FREE (berr);
    SUPERLU_FREE (rwork);
    SUPERLU_FREE (wwork);
    Destroy_SuperMatrix_Store(&B);
    Destroy_SuperMatrix_Store(&X);
    Destroy_CompCol_Matrix(&A);
    Destroy_CompCol_Matrix(&ASAV);
    if ( lwork > 0 ) {
        SUPERLU_FREE (work);
        Destroy_SuperMatrix_Store(&L);
        Destroy_SuperMatrix_Store(&U);
    }
    StatFree(&stat);

    return 0;
}
Пример #5
0
bool SparseMatrix::solveSLUx (Vector& B, Real* rcond)
{
  int ierr = ncol+1;
  if (!factored) this->optimiseSLU();

#ifdef HAS_SUPERLU_MT
  if (!slu) {
    // Create a new SuperLU matrix
    slu = new SuperLUdata(numThreads);
    slu->equed = NOEQUIL;
    slu->perm_c = new int[ncol];
    slu->perm_r = new int[nrow];
    slu->C = new Real[ncol];
    slu->R = new Real[nrow];
    slu->opts->etree = new int[ncol];
    slu->opts->colcnt_h = new int[ncol];
    slu->opts->part_super_h = new int[ncol];
    memset(slu->opts->colcnt_h, 0, ncol*sizeof(int));
    memset(slu->opts->part_super_h, 0, ncol*sizeof(int));
    memset(slu->opts->etree, 0, ncol*sizeof(int));
    dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
                           &A.front(), &JA.front(), &IA.front(),
                           SLU_NC, SLU_D, SLU_GE);

    // Get column permutation vector perm_c[], according to permc_spec:
    //   permc_spec = 0: natural ordering
    //   permc_spec = 1: minimum degree ordering on structure of A'*A
    //   permc_spec = 2: minimum degree ordering on structure of A'+A
    //   permc_spec = 3: approximate minimum degree for unsymmetric matrices
    int permc_spec = 1;
    get_perm_c(permc_spec, &slu->A, slu->perm_c);
  }
  else if (factored)
    slu->opts->fact = FACTORED; // Re-use previous factorization
  else
    slu->opts->refact = YES; // Re-use previous ordering

  // Create right-hand-side and solution vector(s)
  Vector      X(B.size());
  SuperMatrix Bmat, Xmat;
  const size_t nrhs = B.size() / nrow;
  dCreate_Dense_Matrix(&Bmat, nrow, nrhs, B.ptr(), nrow,
                       SLU_DN, SLU_D, SLU_GE);
  dCreate_Dense_Matrix(&Xmat, nrow, nrhs, X.ptr(), nrow,
                       SLU_DN, SLU_D, SLU_GE);

  Real ferr[nrhs], berr[nrhs];
  superlu_memusage_t mem_usage;

  // Invoke the expert driver
  pdgssvx(numThreads, slu->opts, &slu->A, slu->perm_c, slu->perm_r,
          &slu->equed, slu->R, slu->C, &slu->L, &slu->U, &Bmat, &Xmat,
          &slu->rpg, &slu->rcond, ferr, berr, &mem_usage, &ierr);

  B.swap(X);

  if (ierr > 0)
    std::cerr <<"SuperLU_MT Failure "<< ierr << std::endl;
  else if (!factored)
  {
    factored = true;
    if (rcond)
      *rcond = slu->rcond;
  }

  Destroy_SuperMatrix_Store(&Bmat);
  Destroy_SuperMatrix_Store(&Xmat);

#elif defined(HAS_SUPERLU)
  if (!slu) {
    // Create a new SuperLU matrix
    slu = new SuperLUdata(1);
    slu->perm_c = new int[ncol];
    slu->perm_r = new int[nrow];
    slu->etree = new int[ncol];
    slu->C = new Real[ncol];
    slu->R = new Real[nrow];
    dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
                           &A.front(), &JA.front(), &IA.front(),
                           SLU_NC, SLU_D, SLU_GE);
  }
  else if (factored)
    slu->opts->Fact = FACTORED; // Re-use previous factorization
  else {
    Destroy_SuperMatrix_Store(&slu->A);
    Destroy_SuperNode_Matrix(&slu->L);
    Destroy_CompCol_Matrix(&slu->U);
    dCreate_CompCol_Matrix(&slu->A, nrow, ncol, this->size(),
                           &A.front(), &JA.front(), &IA.front(),
                           SLU_NC, SLU_D, SLU_GE);
  }

  // Create right-hand-side vector and solution vector
  Vector      X(B.size());
  SuperMatrix Bmat, Xmat;
  const  size_t nrhs = B.size() / nrow;
  dCreate_Dense_Matrix(&Bmat, nrow, nrhs, B.ptr(), nrow,
                       SLU_DN, SLU_D, SLU_GE);
  dCreate_Dense_Matrix(&Xmat, nrow, nrhs, X.ptr(), nrow,
                       SLU_DN, SLU_D, SLU_GE);

  slu->opts->ConditionNumber = printSLUstat || rcond ? YES : NO;
  slu->opts->PivotGrowth = printSLUstat ? YES : NO;

  void* work = 0;
  int  lwork = 0;
  Real ferr[nrhs], berr[nrhs];
  mem_usage_t mem_usage;

  SuperLUStat_t stat;
  StatInit(&stat);

  // Invoke the expert driver
#if SUPERLU_VERSION == 5
  GlobalLU_t Glu;
  dgssvx(slu->opts, &slu->A, slu->perm_c, slu->perm_r, slu->etree, slu->equed,
         slu->R, slu->C, &slu->L, &slu->U, work, lwork, &Bmat, &Xmat,
         &slu->rpg, &slu->rcond, ferr, berr, &Glu, &mem_usage, &stat, &ierr);
#else
  dgssvx(slu->opts, &slu->A, slu->perm_c, slu->perm_r, slu->etree, slu->equed,
         slu->R, slu->C, &slu->L, &slu->U, work, lwork, &Bmat, &Xmat,
         &slu->rpg, &slu->rcond, ferr, berr, &mem_usage, &stat, &ierr);
#endif

  B.swap(X);

  if (ierr > 0)
    std::cerr <<"SuperLU Failure "<< ierr << std::endl;
  else if (!factored)
  {
    factored = true;
    if (rcond)
      *rcond = slu->rcond;
  }

  if (printSLUstat)
  {
    StatPrint(&stat);
    IFEM::cout <<"Reciprocal condition number = "<< slu->rcond
               <<"\nReciprocal pivot growth = "<< slu->rpg << std::endl;
  }
  StatFree(&stat);

  Destroy_SuperMatrix_Store(&Bmat);
  Destroy_SuperMatrix_Store(&Xmat);
#else
  std::cerr <<"SparseMatrix::solve: SuperLU solver not available"<< std::endl;
#endif
  return ierr == 0;
}
Пример #6
0
void
c_fortran_dgssv_(int *iopt, int *n, int *nnz, int *nrhs,
                 double *values, int *rowind, int *colptr,
                 double *b, int *ldb,
                 fptr *f_factors, /* a handle containing the address
                                     pointing to the factored matrices */
                 int *info)

{
    /*
     * This routine can be called from Fortran.
     *
     * iopt (input) int
     *      Specifies the operation:
     *      = 1, performs LU decomposition for the first time
     *      = 2, performs triangular solve
     *      = 3, free all the storage in the end
     *
     * f_factors (input/output) fptr*
     *      If iopt == 1, it is an output and contains the pointer pointing to
     *                    the structure of the factored matrices.
     *      Otherwise, it it an input.
     *
     */

    SuperMatrix A, AC, B;
    SuperMatrix *L, *U;
    int *perm_r; /* row permutations from partial pivoting */
    int *perm_c; /* column permutation vector */
    int *etree;  /* column elimination tree */
    SCformat *Lstore;
    NCformat *Ustore;
    int      i, panel_size, permc_spec, relax;
    trans_t  trans;
    mem_usage_t   mem_usage;
    superlu_options_t options;
    SuperLUStat_t stat;
    factors_t *LUfactors;

    trans = NOTRANS;

    if ( *iopt == 1 ) { /* LU decomposition */

        /* Set the default input options. */
        set_default_options(&options);

        /* Initialize the statistics variables. */
        StatInit(&stat);

        /* Adjust to 0-based indexing */
        for (i = 0; i < *nnz; ++i) --rowind[i];
        for (i = 0; i <= *n; ++i) --colptr[i];

        dCreate_CompCol_Matrix(&A, *n, *n, *nnz, values, rowind, colptr,
                               SLU_NC, SLU_D, SLU_GE);
        L = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
        U = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
        if ( !(perm_r = intMalloc(*n)) ) ABORT("Malloc fails for perm_r[].");
        if ( !(perm_c = intMalloc(*n)) ) ABORT("Malloc fails for perm_c[].");
        if ( !(etree = intMalloc(*n)) ) ABORT("Malloc fails for etree[].");

        /*
         * Get column permutation vector perm_c[], according to permc_spec:
         *   permc_spec = 0: natural ordering
         *   permc_spec = 1: minimum degree on structure of A'*A
         *   permc_spec = 2: minimum degree on structure of A'+A
         *   permc_spec = 3: approximate minimum degree for unsymmetric matrices
         */
        permc_spec = options.ColPerm;
        get_perm_c(permc_spec, &A, perm_c);

        sp_preorder(&options, &A, perm_c, etree, &AC);

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

        dgstrf(&options, &AC, relax, panel_size, etree,
               NULL, 0, perm_c, perm_r, L, U, &stat, info);

        if ( *info == 0 ) {
            Lstore = (SCformat *) L->Store;
            Ustore = (NCformat *) U->Store;
            printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
            printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
            printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz);
            dQuerySpace(L, U, &mem_usage);
            printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
                   mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
        } else {
            printf("dgstrf() error returns INFO= %d\n", *info);
            if ( *info <= *n ) { /* factorization completes */
                dQuerySpace(L, U, &mem_usage);
                printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
                       mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
            }
        }

        /* Restore to 1-based indexing */
        for (i = 0; i < *nnz; ++i) ++rowind[i];
        for (i = 0; i <= *n; ++i) ++colptr[i];

        /* Save the LU factors in the factors handle */
        LUfactors = (factors_t*) SUPERLU_MALLOC(sizeof(factors_t));
        LUfactors->L = L;
        LUfactors->U = U;
        LUfactors->perm_c = perm_c;
        LUfactors->perm_r = perm_r;
        *f_factors = (fptr) LUfactors;

        /* Free un-wanted storage */
        SUPERLU_FREE(etree);
        Destroy_SuperMatrix_Store(&A);
        Destroy_CompCol_Permuted(&AC);
        StatFree(&stat);

    } else if ( *iopt == 2 ) { /* Triangular solve */
        /* Initialize the statistics variables. */
        StatInit(&stat);

        /* Extract the LU factors in the factors handle */
        LUfactors = (factors_t*) *f_factors;
        L = LUfactors->L;
        U = LUfactors->U;
        perm_c = LUfactors->perm_c;
        perm_r = LUfactors->perm_r;

        dCreate_Dense_Matrix(&B, *n, *nrhs, b, *ldb, SLU_DN, SLU_D, SLU_GE);

        /* Solve the system A*X=B, overwriting B with X. */
        dgstrs (trans, L, U, perm_c, perm_r, &B, &stat, info);

        Destroy_SuperMatrix_Store(&B);
        StatFree(&stat);

    } else if ( *iopt == 3 ) { /* Free storage */
        /* Free the LU factors in the factors handle */
        LUfactors = (factors_t*) *f_factors;
        SUPERLU_FREE (LUfactors->perm_r);
        SUPERLU_FREE (LUfactors->perm_c);
        Destroy_SuperNode_Matrix(LUfactors->L);
        Destroy_CompCol_Matrix(LUfactors->U);
        SUPERLU_FREE (LUfactors->L);
        SUPERLU_FREE (LUfactors->U);
        SUPERLU_FREE (LUfactors);
    } else {
        fprintf(stderr,"Invalid iopt=%d passed to c_fortran_dgssv()\n",*iopt);
        exit(-1);
    }
}
Пример #7
0
int main(int argc, char *argv[])
{
/*
 * Purpose
 * =======
 *
 * The driver program SLINSOLX1.
 *
 * This example illustrates how to use SGSSVX to solve systems with the same
 * A but different right-hand side.
 * In this case, we factorize A only once in the first call to DGSSVX,
 * and reuse the following data structures in the subsequent call to SGSSVX:
 *     perm_c, perm_r, R, C, L, U.
 * 
 */
    char           equed[1];
    yes_no_t       equil;
    trans_t        trans;
    SuperMatrix    A, L, U;
    SuperMatrix    B, X;
    NCformat       *Astore;
    NCformat       *Ustore;
    SCformat       *Lstore;
    float         *a;
    int            *asub, *xa;
    int            *perm_c; /* column permutation vector */
    int            *perm_r; /* row permutations from partial pivoting */
    int            *etree;
    void           *work;
    int            info, lwork, nrhs, ldx;
    int            i, m, n, nnz;
    float         *rhsb, *rhsx, *xact;
    float         *R, *C;
    float         *ferr, *berr;
    float         u, rpg, rcond;
    mem_usage_t    mem_usage;
    superlu_options_t options;
    SuperLUStat_t stat;
    extern void    parse_command_line();

#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Enter main()");
#endif

    /* Defaults */
    lwork = 0;
    nrhs  = 1;
    equil = YES;	
    u     = 1.0;
    trans = NOTRANS;

    /* Set the default values for options argument:
	options.Fact = DOFACT;
        options.Equil = YES;
    	options.ColPerm = COLAMD;
	options.DiagPivotThresh = 1.0;
    	options.Trans = NOTRANS;
    	options.IterRefine = NOREFINE;
    	options.SymmetricMode = NO;
    	options.PivotGrowth = NO;
    	options.ConditionNumber = NO;
    	options.PrintStat = YES;
    */
    set_default_options(&options);

    /* Can use command line input to modify the defaults. */
    parse_command_line(argc, argv, &lwork, &u, &equil, &trans);
    options.Equil = equil;
    options.DiagPivotThresh = u;
    options.Trans = trans;
    
    if ( lwork > 0 ) {
	work = SUPERLU_MALLOC(lwork);
	if ( !work ) {
	    ABORT("SLINSOLX: cannot allocate work[]");
	}
    }

    /* Read matrix A from a file in Harwell-Boeing format.*/
    sreadhb(&m, &n, &nnz, &a, &asub, &xa);
    
    sCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_S, SLU_GE);
    Astore = A.Store;
    printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
    
    if ( !(rhsb = floatMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb[].");
    if ( !(rhsx = floatMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsx[].");
    sCreate_Dense_Matrix(&B, m, nrhs, rhsb, m, SLU_DN, SLU_S, SLU_GE);
    sCreate_Dense_Matrix(&X, m, nrhs, rhsx, m, SLU_DN, SLU_S, SLU_GE);
    xact = floatMalloc(n * nrhs);
    ldx = n;
    sGenXtrue(n, nrhs, xact, ldx);
    sFillRHS(trans, nrhs, xact, ldx, &A, &B);
    
    if ( !(etree = intMalloc(n)) ) ABORT("Malloc fails for etree[].");
    if ( !(perm_r = intMalloc(m)) ) ABORT("Malloc fails for perm_r[].");
    if ( !(perm_c = intMalloc(n)) ) ABORT("Malloc fails for perm_c[].");
    if ( !(R = (float *) SUPERLU_MALLOC(A.nrow * sizeof(float))) ) 
        ABORT("SUPERLU_MALLOC fails for R[].");
    if ( !(C = (float *) SUPERLU_MALLOC(A.ncol * sizeof(float))) )
        ABORT("SUPERLU_MALLOC fails for C[].");
    if ( !(ferr = (float *) SUPERLU_MALLOC(nrhs * sizeof(float))) )
        ABORT("SUPERLU_MALLOC fails for ferr[].");
    if ( !(berr = (float *) SUPERLU_MALLOC(nrhs * sizeof(float))) ) 
        ABORT("SUPERLU_MALLOC fails for berr[].");

    /* Initialize the statistics variables. */
    StatInit(&stat);
    
    /* ONLY PERFORM THE LU DECOMPOSITION */
    B.ncol = 0;  /* Indicate not to solve the system */
    sgssvx(&options, &A, perm_c, perm_r, etree, equed, R, C,
           &L, &U, work, lwork, &B, &X, &rpg, &rcond, ferr, berr,
           &mem_usage, &stat, &info);

    printf("LU factorization: sgssvx() returns info %d\n", info);

    if ( info == 0 || info == n+1 ) {

	if ( options.PivotGrowth ) printf("Recip. pivot growth = %e\n", rpg);
	if ( options.ConditionNumber )
	    printf("Recip. condition number = %e\n", rcond);
        Lstore = (SCformat *) L.Store;
        Ustore = (NCformat *) U.Store;
	printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
    	printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
    	printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
    	printf("FILL ratio = %.1f\n", (float)(Lstore->nnz + Ustore->nnz - n)/nnz);

	printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
	       mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
	fflush(stdout);

    } else if ( info > 0 && lwork == -1 ) {
        printf("** Estimated memory: %d bytes\n", info - n);
    }

    if ( options.PrintStat ) StatPrint(&stat);
    StatFree(&stat);

    /* ------------------------------------------------------------
       NOW WE SOLVE THE LINEAR SYSTEM USING THE FACTORED FORM OF A.
       ------------------------------------------------------------*/
    options.Fact = FACTORED; /* Indicate the factored form of A is supplied. */
    B.ncol = nrhs;  /* Set the number of right-hand side */

    /* Initialize the statistics variables. */
    StatInit(&stat);

    sgssvx(&options, &A, perm_c, perm_r, etree, equed, R, C,
           &L, &U, work, lwork, &B, &X, &rpg, &rcond, ferr, berr,
           &mem_usage, &stat, &info);

    printf("Triangular solve: sgssvx() returns info %d\n", info);

    if ( info == 0 || info == n+1 ) {

        /* This is how you could access the solution matrix. */
        float *sol = (float*) ((DNformat*) X.Store)->nzval; 

	if ( options.IterRefine ) {
            printf("Iterative Refinement:\n");
	    printf("%8s%8s%16s%16s\n", "rhs", "Steps", "FERR", "BERR");
	    for (i = 0; i < nrhs; ++i)
	      printf("%8d%8d%16e%16e\n", i+1, stat.RefineSteps, ferr[i], berr[i]);
	}
	fflush(stdout);
    } else if ( info > 0 && lwork == -1 ) {
        printf("** Estimated memory: %d bytes\n", info - n);
    }

    if ( options.PrintStat ) StatPrint(&stat);
    StatFree(&stat);

    SUPERLU_FREE (rhsb);
    SUPERLU_FREE (rhsx);
    SUPERLU_FREE (xact);
    SUPERLU_FREE (etree);
    SUPERLU_FREE (perm_r);
    SUPERLU_FREE (perm_c);
    SUPERLU_FREE (R);
    SUPERLU_FREE (C);
    SUPERLU_FREE (ferr);
    SUPERLU_FREE (berr);
    Destroy_CompCol_Matrix(&A);
    Destroy_SuperMatrix_Store(&B);
    Destroy_SuperMatrix_Store(&X);
    if ( lwork == 0 ) {
        Destroy_SuperNode_Matrix(&L);
        Destroy_CompCol_Matrix(&U);
    } else if ( lwork > 0 ) {
        SUPERLU_FREE(work);
    }


#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Exit main()");
#endif
}
Пример #8
0
int main(int argc, char *argv[])
{
    char           equed[1];
    yes_no_t       equil;
    trans_t        trans;
    SuperMatrix    A, L, U;
    SuperMatrix    B, X;
    NCformat       *Astore;
    NCformat       *Ustore;
    SCformat       *Lstore;
    GlobalLU_t	   Glu; /* facilitate multiple factorizations with 
                           SamePattern_SameRowPerm                  */
    doublecomplex         *a;
    int            *asub, *xa;
    int            *perm_r; /* row permutations from partial pivoting */
    int            *perm_c; /* column permutation vector */
    int            *etree;
    void           *work;
    int            info, lwork, nrhs, ldx;
    int            i, m, n, nnz;
    doublecomplex         *rhsb, *rhsx, *xact;
    double         *R, *C;
    double         *ferr, *berr;
    double         u, rpg, rcond;
    mem_usage_t    mem_usage;
    superlu_options_t options;
    SuperLUStat_t stat;
    FILE           *fp = stdin;

    extern void  parse_command_line();

#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Enter main()");
#endif

    /* Defaults */
    lwork = 0;
    nrhs  = 1;
    equil = YES;	
    u     = 1.0;
    trans = NOTRANS;
    
    /* Set the default input options:
	options.Fact = DOFACT;
        options.Equil = YES;
    	options.ColPerm = COLAMD;
	options.DiagPivotThresh = 1.0;
    	options.Trans = NOTRANS;
    	options.IterRefine = NOREFINE;
    	options.SymmetricMode = NO;
    	options.PivotGrowth = NO;
    	options.ConditionNumber = NO;
    	options.PrintStat = YES;
    */
    set_default_options(&options);

    /* Can use command line input to modify the defaults. */
    parse_command_line(argc, argv, &lwork, &u, &equil, &trans);
    options.Equil = equil;
    options.DiagPivotThresh = u;
    options.Trans = trans;

    /* Add more functionalities that the defaults. */
    options.PivotGrowth = YES;    /* Compute reciprocal pivot growth */
    options.ConditionNumber = YES;/* Compute reciprocal condition number */
    options.IterRefine = SLU_DOUBLE;  /* Perform double-precision refinement */
    
    if ( lwork > 0 ) {
	work = SUPERLU_MALLOC(lwork);
	if ( !work ) {
	    ABORT("ZLINSOLX: cannot allocate work[]");
	}
    }

    /* Read matrix A from a file in Harwell-Boeing format.*/
    zreadhb(fp, &m, &n, &nnz, &a, &asub, &xa);
    
    zCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_Z, SLU_GE);
    Astore = A.Store;
    printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
    
    if ( !(rhsb = doublecomplexMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb[].");
    if ( !(rhsx = doublecomplexMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsx[].");
    zCreate_Dense_Matrix(&B, m, nrhs, rhsb, m, SLU_DN, SLU_Z, SLU_GE);
    zCreate_Dense_Matrix(&X, m, nrhs, rhsx, m, SLU_DN, SLU_Z, SLU_GE);
    xact = doublecomplexMalloc(n * nrhs);
    ldx = n;
    zGenXtrue(n, nrhs, xact, ldx);
    zFillRHS(trans, nrhs, xact, ldx, &A, &B);
    
    if ( !(etree = intMalloc(n)) ) ABORT("Malloc fails for etree[].");
    if ( !(perm_r = intMalloc(m)) ) ABORT("Malloc fails for perm_r[].");
    if ( !(perm_c = intMalloc(n)) ) ABORT("Malloc fails for perm_c[].");
    if ( !(R = (double *) SUPERLU_MALLOC(A.nrow * sizeof(double))) ) 
        ABORT("SUPERLU_MALLOC fails for R[].");
    if ( !(C = (double *) SUPERLU_MALLOC(A.ncol * sizeof(double))) )
        ABORT("SUPERLU_MALLOC fails for C[].");
    if ( !(ferr = (double *) SUPERLU_MALLOC(nrhs * sizeof(double))) )
        ABORT("SUPERLU_MALLOC fails for ferr[].");
    if ( !(berr = (double *) SUPERLU_MALLOC(nrhs * sizeof(double))) ) 
        ABORT("SUPERLU_MALLOC fails for berr[].");

    
    /* Initialize the statistics variables. */
    StatInit(&stat);
    
    /* Solve the system and compute the condition number
       and error bounds using dgssvx.      */
    
    zgssvx(&options, &A, perm_c, perm_r, etree, equed, R, C,
           &L, &U, work, lwork, &B, &X, &rpg, &rcond, ferr, berr,
           &Glu, &mem_usage, &stat, &info);

    printf("zgssvx(): info %d\n", info);

    if ( info == 0 || info == n+1 ) {

        /* This is how you could access the solution matrix. */
        doublecomplex *sol = (doublecomplex*) ((DNformat*) X.Store)->nzval; 

	if ( options.PivotGrowth == YES )
            printf("Recip. pivot growth = %e\n", rpg);
	if ( options.ConditionNumber == YES )
	    printf("Recip. condition number = %e\n", rcond);
	if ( options.IterRefine != NOREFINE ) {
            printf("Iterative Refinement:\n");
	    printf("%8s%8s%16s%16s\n", "rhs", "Steps", "FERR", "BERR");
	    for (i = 0; i < nrhs; ++i)
	      printf("%8d%8d%16e%16e\n", i+1, stat.RefineSteps, ferr[i], berr[i]);
	}
        Lstore = (SCformat *) L.Store;
        Ustore = (NCformat *) U.Store;
	printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
    	printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
    	printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
    	printf("FILL ratio = %.1f\n", (float)(Lstore->nnz + Ustore->nnz - n)/nnz);

	printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
	       mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
	     
	fflush(stdout);

    } else if ( info > 0 && lwork == -1 ) {
        printf("** Estimated memory: %d bytes\n", info - n);
    }

    if ( options.PrintStat ) StatPrint(&stat);
    StatFree(&stat);

    SUPERLU_FREE (rhsb);
    SUPERLU_FREE (rhsx);
    SUPERLU_FREE (xact);
    SUPERLU_FREE (etree);
    SUPERLU_FREE (perm_r);
    SUPERLU_FREE (perm_c);
    SUPERLU_FREE (R);
    SUPERLU_FREE (C);
    SUPERLU_FREE (ferr);
    SUPERLU_FREE (berr);
    Destroy_CompCol_Matrix(&A);
    Destroy_SuperMatrix_Store(&B);
    Destroy_SuperMatrix_Store(&X);
    if ( lwork == 0 ) {
        Destroy_SuperNode_Matrix(&L);
        Destroy_CompCol_Matrix(&U);
    } else if ( lwork > 0 ) {
        SUPERLU_FREE(work);
    }

#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Exit main()");
#endif
}
Пример #9
0
/* Here is a driver inspired by A. Sheffer's "cow flattener". */
static NLboolean __nlFactorize_SUPERLU(__NLContext *context, NLint *permutation) {

	/* OpenNL Context */
	__NLSparseMatrix* M = (context->least_squares)? &context->MtM: &context->M;
	NLuint n = context->n;
	NLuint nnz = __nlSparseMatrixNNZ(M); /* number of non-zero coeffs */

	/*if(n > 10)
		n = 10;*/

	/* Compressed Row Storage matrix representation */
	NLint	*xa		= __NL_NEW_ARRAY(NLint, n+1);
	NLfloat	*rhs	= __NL_NEW_ARRAY(NLfloat, n);
	NLfloat	*a		= __NL_NEW_ARRAY(NLfloat, nnz);
	NLint	*asub	= __NL_NEW_ARRAY(NLint, nnz);
	NLint	*etree	= __NL_NEW_ARRAY(NLint, n);

	/* SuperLU variables */
	SuperMatrix At, AtP;
	NLint info, panel_size, relax;
	superlu_options_t options;

	/* Temporary variables */
	NLuint i, jj, count;
	
	__nl_assert(!(M->storage & __NL_SYMMETRIC));
	__nl_assert(M->storage & __NL_ROWS);
	__nl_assert(M->m == M->n);
	
	/* Convert M to compressed column format */
	for(i=0, count=0; i<n; i++) {
		__NLRowColumn *Ri = M->row + i;
		xa[i] = count;

		for(jj=0; jj<Ri->size; jj++, count++) {
			a[count] = Ri->coeff[jj].value;
			asub[count] = Ri->coeff[jj].index;
		}
	}
	xa[n] = nnz;

	/* Free M, don't need it anymore at this point */
	__nlSparseMatrixClear(M);

	/* Create superlu A matrix transposed */
	sCreate_CompCol_Matrix(
		&At, n, n, nnz, a, asub, xa, 
		SLU_NC,		/* Colum wise, no supernode */
		SLU_S,		/* floats */ 
		SLU_GE		/* general storage */
	);

	/* Set superlu options */
	set_default_options(&options);
	options.ColPerm = MY_PERMC;
	options.Fact = DOFACT;

	StatInit(&(context->slu.stat));

	panel_size = sp_ienv(1); /* sp_ienv give us the defaults */
	relax = sp_ienv(2);

	/* Compute permutation and permuted matrix */
	context->slu.perm_r = __NL_NEW_ARRAY(NLint, n);
	context->slu.perm_c = __NL_NEW_ARRAY(NLint, n);

	if ((permutation == NULL) || (*permutation == -1)) {
		get_perm_c(3, &At, context->slu.perm_c);

		if (permutation)
			memcpy(permutation, context->slu.perm_c, sizeof(NLint)*n);
	}
	else
		memcpy(context->slu.perm_c, permutation, sizeof(NLint)*n);

	sp_preorder(&options, &At, context->slu.perm_c, etree, &AtP);

	/* Decompose into L and U */
	sgstrf(&options, &AtP, relax, panel_size,
		etree, NULL, 0, context->slu.perm_c, context->slu.perm_r,
		&(context->slu.L), &(context->slu.U), &(context->slu.stat), &info);

	/* Cleanup */

	Destroy_SuperMatrix_Store(&At);
	Destroy_CompCol_Permuted(&AtP);

	__NL_DELETE_ARRAY(etree);
	__NL_DELETE_ARRAY(xa);
	__NL_DELETE_ARRAY(rhs);
	__NL_DELETE_ARRAY(a);
	__NL_DELETE_ARRAY(asub);

	context->slu.alloc_slu = NL_TRUE;

	return (info == 0);
}
Пример #10
0
int main(int argc, char *argv[])
{
    void dmatvec_mult(double alpha, double x[], double beta, double y[]);
    void dpsolve(int n, double x[], double y[]);
    extern int dfgmr( int n,
	void (*matvec_mult)(double, double [], double, double []),
	void (*psolve)(int n, double [], double[]),
	double *rhs, double *sol, double tol, int restrt, int *itmax,
	FILE *fits);
    extern int dfill_diag(int n, NCformat *Astore);

    char     equed[1] = {'B'};
    yes_no_t equil;
    trans_t  trans;
    SuperMatrix A, L, U;
    SuperMatrix B, X;
    NCformat *Astore;
    NCformat *Ustore;
    SCformat *Lstore;
    double   *a;
    int      *asub, *xa;
    int      *etree;
    int      *perm_c; /* column permutation vector */
    int      *perm_r; /* row permutations from partial pivoting */
    int      nrhs, ldx, lwork, info, m, n, nnz;
    double   *rhsb, *rhsx, *xact;
    double   *work = NULL;
    double   *R, *C;
    double   u, rpg, rcond;
    double zero = 0.0;
    double one = 1.0;
    mem_usage_t   mem_usage;
    superlu_options_t options;
    SuperLUStat_t stat;

    int restrt, iter, maxit, i;
    double resid;
    double *x, *b;

#ifdef DEBUG
    extern int num_drop_L, num_drop_U;
#endif

#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Enter main()");
#endif

    /* Defaults */
    lwork = 0;
    nrhs  = 1;
    equil = YES;
    u	  = 0.1; /* u=1.0 for complete factorization */
    trans = NOTRANS;

    /* Set the default input options:
	options.Fact = DOFACT;
	options.Equil = YES;
	options.ColPerm = COLAMD;
	options.DiagPivotThresh = 0.1; //different from complete LU
	options.Trans = NOTRANS;
	options.IterRefine = NOREFINE;
	options.SymmetricMode = NO;
	options.PivotGrowth = NO;
	options.ConditionNumber = NO;
	options.PrintStat = YES;
	options.RowPerm = LargeDiag;
	options.ILU_DropTol = 1e-4;
	options.ILU_FillTol = 1e-2;
	options.ILU_FillFactor = 10.0;
	options.ILU_DropRule = DROP_BASIC | DROP_AREA;
	options.ILU_Norm = INF_NORM;
	options.ILU_MILU = SILU;
     */
    ilu_set_default_options(&options);

    /* Modify the defaults. */
    options.PivotGrowth = YES;	  /* Compute reciprocal pivot growth */
    options.ConditionNumber = YES;/* Compute reciprocal condition number */

    if ( lwork > 0 ) {
	work = SUPERLU_MALLOC(lwork);
	if ( !work ) ABORT("Malloc fails for work[].");
    }

    /* Read matrix A from a file in Harwell-Boeing format.*/
    if (argc < 2)
    {
	printf("Usage:\n%s [OPTION] < [INPUT] > [OUTPUT]\nOPTION:\n"
		"-h -hb:\n\t[INPUT] is a Harwell-Boeing format matrix.\n"
		"-r -rb:\n\t[INPUT] is a Rutherford-Boeing format matrix.\n"
		"-t -triplet:\n\t[INPUT] is a triplet format matrix.\n",
		argv[0]);
	return 0;
    }
    else
    {
	switch (argv[1][1])
	{
	    case 'H':
	    case 'h':
		printf("Input a Harwell-Boeing format matrix:\n");
		dreadhb(&m, &n, &nnz, &a, &asub, &xa);
		break;
	    case 'R':
	    case 'r':
		printf("Input a Rutherford-Boeing format matrix:\n");
		dreadrb(&m, &n, &nnz, &a, &asub, &xa);
		break;
	    case 'T':
	    case 't':
		printf("Input a triplet format matrix:\n");
		dreadtriple(&m, &n, &nnz, &a, &asub, &xa);
		break;
	    default:
		printf("Unrecognized format.\n");
		return 0;
	}
    }

    dCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE);
    Astore = A.Store;
    dfill_diag(n, Astore);
    printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
    fflush(stdout);

    if ( !(rhsb = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb[].");
    if ( !(rhsx = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsx[].");
    dCreate_Dense_Matrix(&B, m, nrhs, rhsb, m, SLU_DN, SLU_D, SLU_GE);
    dCreate_Dense_Matrix(&X, m, nrhs, rhsx, m, SLU_DN, SLU_D, SLU_GE);
    xact = doubleMalloc(n * nrhs);
    ldx = n;
    dGenXtrue(n, nrhs, xact, ldx);
    dFillRHS(trans, nrhs, xact, ldx, &A, &B);

    if ( !(etree = intMalloc(n)) ) ABORT("Malloc fails for etree[].");
    if ( !(perm_r = intMalloc(m)) ) ABORT("Malloc fails for perm_r[].");
    if ( !(perm_c = intMalloc(n)) ) ABORT("Malloc fails for perm_c[].");
    if ( !(R = (double *) SUPERLU_MALLOC(A.nrow * sizeof(double))) )
	ABORT("SUPERLU_MALLOC fails for R[].");
    if ( !(C = (double *) SUPERLU_MALLOC(A.ncol * sizeof(double))) )
	ABORT("SUPERLU_MALLOC fails for C[].");

    info = 0;
#ifdef DEBUG
    num_drop_L = 0;
    num_drop_U = 0;
#endif

    /* Initialize the statistics variables. */
    StatInit(&stat);

    /* Compute the incomplete factorization and compute the condition number
       and pivot growth using dgsisx. */
    dgsisx(&options, &A, perm_c, perm_r, etree, equed, R, C, &L, &U, work,
	   lwork, &B, &X, &rpg, &rcond, &mem_usage, &stat, &info);

    Lstore = (SCformat *) L.Store;
    Ustore = (NCformat *) U.Store;
    printf("dgsisx(): info %d\n", info);
    if (info > 0 || rcond < 1e-8 || rpg > 1e8)
	printf("WARNING: This preconditioner might be unstable.\n");

    if ( info == 0 || info == n+1 ) {

	if ( options.PivotGrowth == YES )
	    printf("Recip. pivot growth = %e\n", rpg);
	if ( options.ConditionNumber == YES )
	    printf("Recip. condition number = %e\n", rcond);

    } else if ( info > 0 && lwork == -1 ) {
	printf("** Estimated memory: %d bytes\n", info - n);
    }
    printf("n(A) = %d, nnz(A) = %d\n", n, Astore->nnz);
    printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
    printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
    printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
    printf("Fill ratio: nnz(F)/nnz(A) = %.3f\n",
	    ((double)(Lstore->nnz) + (double)(Ustore->nnz) - (double)n)
	    / (double)Astore->nnz);
    printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
	   mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
    fflush(stdout);

    /* Set the global variables. */
    GLOBAL_A = &A;
    GLOBAL_L = &L;
    GLOBAL_U = &U;
    GLOBAL_STAT = &stat;
    GLOBAL_PERM_C = perm_c;
    GLOBAL_PERM_R = perm_r;

    /* Set the variables used by GMRES. */
    restrt = SUPERLU_MIN(n / 3 + 1, 50);
    maxit = 1000;
    iter = maxit;
    resid = 1e-8;
    if (!(b = doubleMalloc(m))) ABORT("Malloc fails for b[].");
    if (!(x = doubleMalloc(n))) ABORT("Malloc fails for x[].");

    if (info <= n + 1)
    {
	int i_1 = 1;
	double maxferr = 0.0, nrmA, nrmB, res, t;
        double temp;
	extern double dnrm2_(int *, double [], int *);
	extern void daxpy_(int *, double *, double [], int *, double [], int *);

	/* Call GMRES. */
	for (i = 0; i < n; i++) b[i] = rhsb[i];
	for (i = 0; i < n; i++) x[i] = zero;

	t = SuperLU_timer_();

	dfgmr(n, dmatvec_mult, dpsolve, b, x, resid, restrt, &iter, stdout);

	t = SuperLU_timer_() - t;

	/* Output the result. */
	nrmA = dnrm2_(&(Astore->nnz), (double *)((DNformat *)A.Store)->nzval,
		&i_1);
	nrmB = dnrm2_(&m, b, &i_1);
	sp_dgemv("N", -1.0, &A, x, 1, 1.0, b, 1);
	res = dnrm2_(&m, b, &i_1);
	resid = res / nrmB;
	printf("||A||_F = %.1e, ||B||_2 = %.1e, ||B-A*X||_2 = %.1e, "
		"relres = %.1e\n", nrmA, nrmB, res, resid);

	if (iter >= maxit)
	{
	    if (resid >= 1.0) iter = -180;
	    else if (resid > 1e-8) iter = -111;
	}
	printf("iteration: %d\nresidual: %.1e\nGMRES time: %.2f seconds.\n",
		iter, resid, t);

	/* Scale the solution back if equilibration was performed. */
	if (*equed == 'C' || *equed == 'B') 
	    for (i = 0; i < n; i++) x[i] *= C[i];

	for (i = 0; i < m; i++) {
	    maxferr = SUPERLU_MAX(maxferr, fabs(x[i] - xact[i]));
        }
	printf("||X-X_true||_oo = %.1e\n", maxferr);
    }
#ifdef DEBUG
    printf("%d entries in L and %d entries in U dropped.\n",
	    num_drop_L, num_drop_U);
#endif
    fflush(stdout);

    if ( options.PrintStat ) StatPrint(&stat);
    StatFree(&stat);

    SUPERLU_FREE (rhsb);
    SUPERLU_FREE (rhsx);
    SUPERLU_FREE (xact);
    SUPERLU_FREE (etree);
    SUPERLU_FREE (perm_r);
    SUPERLU_FREE (perm_c);
    SUPERLU_FREE (R);
    SUPERLU_FREE (C);
    Destroy_CompCol_Matrix(&A);
    Destroy_SuperMatrix_Store(&B);
    Destroy_SuperMatrix_Store(&X);
    if ( lwork >= 0 ) {
	Destroy_SuperNode_Matrix(&L);
	Destroy_CompCol_Matrix(&U);
    }
    SUPERLU_FREE(b);
    SUPERLU_FREE(x);

#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Exit main()");
#endif

    return 0;
}
Пример #11
0
/* Here is a driver inspired by A. Sheffer's "cow flattener". */
static NLboolean __nlSolve_SUPERLU( NLboolean do_perm) {

    /* OpenNL Context */
    __NLSparseMatrix* M  = &(__nlCurrentContext->M);
    NLfloat* b          = __nlCurrentContext->b;
    NLfloat* x          = __nlCurrentContext->x;

    /* Compressed Row Storage matrix representation */
    NLuint    n      = __nlCurrentContext->n;
    NLuint    nnz    = __nlSparseMatrixNNZ(M); /* Number of Non-Zero coeffs */
    NLint*    xa     = __NL_NEW_ARRAY(NLint, n+1);
    NLfloat* rhs    = __NL_NEW_ARRAY(NLfloat, n);
    NLfloat* a      = __NL_NEW_ARRAY(NLfloat, nnz);
    NLint*    asub   = __NL_NEW_ARRAY(NLint, nnz);

    /* Permutation vector */
    NLint*    perm_r  = __NL_NEW_ARRAY(NLint, n);
    NLint*    perm    = __NL_NEW_ARRAY(NLint, n);

    /* SuperLU variables */
    SuperMatrix A, B; /* System       */
    SuperMatrix L, U; /* Inverse of A */
    NLint info;       /* status code  */
    DNformat *vals = NULL; /* access to result */
    float *rvals  = NULL; /* access to result */

    /* SuperLU options and stats */
    superlu_options_t options;
    SuperLUStat_t     stat;


    /* Temporary variables */
    __NLRowColumn* Ri = NULL;
    NLuint         i,jj,count;
    
    __nl_assert(!(M->storage & __NL_SYMMETRIC));
    __nl_assert(M->storage & __NL_ROWS);
    __nl_assert(M->m == M->n);
    
    
    /*
     * Step 1: convert matrix M into SuperLU compressed column 
     *   representation.
     * -------------------------------------------------------
     */

    count = 0;
    for(i=0; i<n; i++) {
        Ri = &(M->row[i]);
        xa[i] = count;
        for(jj=0; jj<Ri->size; jj++) {
            a[count]    = Ri->coeff[jj].value;
            asub[count] = Ri->coeff[jj].index;
            count++;
        }
    }
    xa[n] = nnz;

    /* Save memory for SuperLU */
    __nlSparseMatrixClear(M);


    /*
     * Rem: symmetric storage does not seem to work with
     * SuperLU ... (->deactivated in main SLS::Solver driver)
     */
    sCreate_CompCol_Matrix(
        &A, n, n, nnz, a, asub, xa, 
        SLU_NR,              /* Row_wise, no supernode */
        SLU_S,               /* floats                */ 
        SLU_GE               /* general storage        */
    );

    /* Step 2: create vector */
    sCreate_Dense_Matrix(
        &B, n, 1, b, n, 
        SLU_DN, /* Fortran-type column-wise storage */
        SLU_S,  /* floats                          */
        SLU_GE  /* general                          */
    );
            

    /* Step 3: get permutation matrix 
     * ------------------------------
     * com_perm: 0 -> no re-ordering
     *           1 -> re-ordering for A^t.A
     *           2 -> re-ordering for A^t+A
     *           3 -> approximate minimum degree ordering
     */
    get_perm_c(do_perm ? 3 : 0, &A, perm);

    /* Step 4: call SuperLU main routine
     * ---------------------------------
     */

    set_default_options(&options);
    options.ColPerm = MY_PERMC;
    StatInit(&stat);

    sgssv(&options, &A, perm, perm_r, &L, &U, &B, &stat, &info);

    /* Step 5: get the solution
     * ------------------------
     * Fortran-type column-wise storage
     */
    vals = (DNformat*)B.Store;
    rvals = (float*)(vals->nzval);
    if(info == 0) {
        for(i = 0; i <  n; i++){
            x[i] = rvals[i];
        }
    }

    /* Step 6: cleanup
     * ---------------
     */

    /*
     *  For these two ones, only the "store" structure
     * needs to be deallocated (the arrays have been allocated
     * by us).
     */
    Destroy_SuperMatrix_Store(&A);
    Destroy_SuperMatrix_Store(&B);

    
    /*
     *   These ones need to be fully deallocated (they have been
     * allocated by SuperLU).
     */
    Destroy_SuperNode_Matrix(&L);
    Destroy_CompCol_Matrix(&U);

    StatFree(&stat);

    __NL_DELETE_ARRAY(xa);
    __NL_DELETE_ARRAY(rhs);
    __NL_DELETE_ARRAY(a);
    __NL_DELETE_ARRAY(asub);
    __NL_DELETE_ARRAY(perm_r);
    __NL_DELETE_ARRAY(perm);

    return (info == 0);
}
Пример #12
0
void
zgssv(SuperMatrix *A, int *perm_c, int *perm_r, SuperMatrix *L,
      SuperMatrix *U, SuperMatrix *B, int *info )
{
/*
 * Purpose
 * =======
 *
 * ZGSSV solves the system of linear equations A*X=B, using the
 * LU factorization from ZGSTRF. 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
 * =========
 *
 * 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_Z; 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.
 *         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 = SLU_NR, column permutation vector of size A->nrow
 *         which describes permutation of columns of transpose(A) 
 *         (rows of A) as described above.
 * 
 * perm_r  (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.
 *
 * 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 = SC, Dtype = SLU_Z, Mtype = 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_Z, Mtype = TRU.
 *
 * B       (input/output) SuperMatrix*
 *         B has types: Stype = SLU_DN, Dtype = SLU_Z, Mtype = SLU_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.
 *   
 */
    double   t1;	/* Temporary time */
    char     refact[1], trans[1];
    DNformat *Bstore;
    SuperMatrix *AA;/* 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 */
    double   diag_pivot_thresh = 1.0;
    double   drop_tol = 0;
    int      panel_size;     /* panel size */
    int      relax;          /* no of columns in a relaxed snodes */
    double   *utime;
    extern SuperLUStat_t SuperLUStat;

    /* Test the input parameters ... */
    *info = 0;
    Bstore = B->Store;
    if ( A->nrow != A->ncol || A->nrow < 0 ||
	 (A->Stype != SLU_NC && A->Stype != SLU_NR) ||
	 A->Dtype != SLU_Z || A->Mtype != SLU_GE )
	*info = -1;
    else if ( B->ncol < 0 || Bstore->lda < SUPERLU_MAX(0, A->nrow) ||
	B->Stype != SLU_DN || B->Dtype != SLU_Z || B->Mtype != SLU_GE )
	*info = -6;
    if ( *info != 0 ) {
	i = -(*info);
	xerbla_("zgssv", &i);
	return;
    }
    
    *refact = 'N';
    *trans = 'N';
    panel_size = sp_ienv(1);
    relax = sp_ienv(2);

    StatInit(panel_size, relax);
    utime = SuperLUStat.utime;
 
    /* Convert A to SLU_NC format when necessary. */
    if ( A->Stype == SLU_NR ) {
	NRformat *Astore = A->Store;
	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
	zCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
			       Astore->nzval, Astore->colind, Astore->rowptr,
			       SLU_NC, A->Dtype, A->Mtype);
	*trans = 'T';
    } else if ( A->Stype == SLU_NC ) AA = A;

    etree = intMalloc(A->ncol);

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

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

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

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

    PrintStat( &SuperLUStat );
    StatFree();

}
Пример #13
0
NLboolean nlFactorize_SUPERLU() {

	/* OpenNL Context */
	NLSparseMatrix* M   = &(nlCurrentContext->M) ;
	NLuint          n   = nlCurrentContext->n ;
	NLuint          nnz = nlSparseMatrixNNZ(M) ; /* Number of Non-Zero coeffs */

	superlu_context* context = (superlu_context*)(nlCurrentContext->direct_solver_context) ;
	if(context == NULL) {
		nlCurrentContext->direct_solver_context = malloc(sizeof(superlu_context)) ;
		context = (superlu_context*)(nlCurrentContext->direct_solver_context) ;
	}

	/* SUPERLU variables */
	NLint info ;
	SuperMatrix A, AC ;

	/* Temporary variables */
	NLRowColumn* Ci = NULL ;
	NLuint       i,j,count ;

	/* Sanity checks */
	nl_assert(!(M->storage & NL_MATRIX_STORE_SYMMETRIC)) ;
	nl_assert(M->storage & NL_MATRIX_STORE_ROWS) ;
	nl_assert(M->m == M->n) ;

	set_default_options(&(context->options)) ;

	switch(nlCurrentContext->solver) {
	case NL_SUPERLU_EXT: {
		context->options.ColPerm = NATURAL ;
	} break ;
	case NL_PERM_SUPERLU_EXT: {
		context->options.ColPerm = COLAMD ;
	} break ;
	case NL_SYMMETRIC_SUPERLU_EXT: {
		context->options.ColPerm = MMD_AT_PLUS_A ;
		context->options.SymmetricMode = YES ;
	} break ;
	default: {
		nl_assert_not_reached ;
	} break ;
	}

	StatInit(&(context->stat)) ;

	/*
	 * Step 1: convert matrix M into SUPERLU compressed column representation
	 * ----------------------------------------------------------------------
	 */

	NLint*    xa   = NL_NEW_ARRAY(NLint, n+1) ;
	NLdouble* a    = NL_NEW_ARRAY(NLdouble, nnz) ;
	NLint*    asub = NL_NEW_ARRAY(NLint, nnz) ;

	count = 0 ;
	for(i = 0; i < n; i++) {
		Ci = &(M->row[i]) ;
		xa[i] = count ;
		for(j = 0; j < Ci->size; j++) {
			a[count]    = Ci->coeff[j].value ;
			asub[count] = Ci->coeff[j].index ;
			count++ ;
		}
	}
	xa[n] = nnz ;

	dCreate_CompCol_Matrix(
		&A, n, n, nnz, a, asub, xa,
		SLU_NR, /* Row wise     */
		SLU_D,  /* doubles         */
		SLU_GE  /* general storage */
	);

	/*
	 * Step 2: factorize matrix
	 * ------------------------
	 */

	context->perm_c = NL_NEW_ARRAY(NLint, n) ;
	context->perm_r = NL_NEW_ARRAY(NLint, n) ;
	NLint* etree    = NL_NEW_ARRAY(NLint, n) ;

	get_perm_c(context->options.ColPerm, &A, context->perm_c) ;
	sp_preorder(&(context->options), &A, context->perm_c, etree, &AC) ;

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

	dgstrf(&(context->options),
		   &AC,
		   relax,
		   panel_size,
		   etree,
		   NULL,
		   0,
		   context->perm_c,
		   context->perm_r,
		   &(context->L),
		   &(context->U),
		   &(context->stat),
		   &info) ;

	/*
	 * Step 3: cleanup
	 * ---------------
	 */

	NL_DELETE_ARRAY(xa) ;
	NL_DELETE_ARRAY(a) ;
	NL_DELETE_ARRAY(asub) ;
	NL_DELETE_ARRAY(etree) ;
	Destroy_SuperMatrix_Store(&A);
	Destroy_CompCol_Permuted(&AC);
	StatFree(&(context->stat));

	return NL_TRUE ;
}
Пример #14
0
NLboolean nlSolve_SUPERLU() {

	/* OpenNL Context */
	NLdouble* b = nlCurrentContext->b ;
	NLdouble* x = nlCurrentContext->x ;
	NLuint    n = nlCurrentContext->n ;

	superlu_context* context = (superlu_context*)(nlCurrentContext->direct_solver_context) ;
	nl_assert(context != NULL) ;

	/* SUPERLU variables */
	SuperMatrix B ;
	DNformat *vals = NULL ; /* access to result */
	double *rvals  = NULL ; /* access to result */

	/* Temporary variables */
	NLuint i ;
	NLint info ;

	StatInit(&(context->stat)) ;

	/*
	 * Step 1: convert right-hand side into SUPERLU representation
	 * -----------------------------------------------------------
	 */

	dCreate_Dense_Matrix(
		&B, n, 1, b, n,
		SLU_DN, /* Fortran-type column-wise storage */
		SLU_D,  /* doubles                          */
		SLU_GE  /* general storage                  */
	);

	/*
	 * Step 2: solve
	 * -------------
	 */

	dgstrs(NOTRANS,
		   &(context->L),
		   &(context->U),
		   context->perm_c,
		   context->perm_r,
		   &B,
		   &(context->stat),
		   &info) ;

	/*
	 * Step 3: get the solution
	 * ------------------------
	 */

	vals = (DNformat*)B.Store;
	rvals = (double*)(vals->nzval);
	for(i = 0; i <  n; i++)
		x[i] = rvals[i];

	/*
	 * Step 4: cleanup
	 * ---------------
	 */

	Destroy_SuperMatrix_Store(&B);
	StatFree(&(context->stat));

	return NL_TRUE ;
}
Пример #15
0
int main(int argc, char *argv[])
{
    SuperMatrix A;
    NCformat *Astore;
    doublecomplex   *a;
    int      *asub, *xa;
    int      *perm_c; /* column permutation vector */
    int      *perm_r; /* row permutations from partial pivoting */
    SuperMatrix L;      /* factor L */
    SCformat *Lstore;
    SuperMatrix U;      /* factor U */
    NCformat *Ustore;
    SuperMatrix B;
    int      nrhs, ldx, info, m, n, nnz;
    doublecomplex   *xact, *rhs;
    mem_usage_t   mem_usage;
    superlu_options_t options;
    SuperLUStat_t stat;
    FILE     *fp = stdin;
    
#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Enter main()");
#endif

    /* Set the default input options:
	options.Fact = DOFACT;
        options.Equil = YES;
    	options.ColPerm = COLAMD;
	options.DiagPivotThresh = 1.0;
    	options.Trans = NOTRANS;
    	options.IterRefine = NOREFINE;
    	options.SymmetricMode = NO;
    	options.PivotGrowth = NO;
    	options.ConditionNumber = NO;
    	options.PrintStat = YES;
     */
    set_default_options(&options);

    /* Now we modify the default options to use the symmetric mode. */
    options.SymmetricMode = YES;
    options.ColPerm = MMD_AT_PLUS_A;
    options.DiagPivotThresh = 0.001;

    /* Read the matrix in Harwell-Boeing format. */
    zreadhb(fp, &m, &n, &nnz, &a, &asub, &xa);

    zCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_Z, SLU_GE);
    Astore = A.Store;
    printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
    
    nrhs   = 1;
    if ( !(rhs = doublecomplexMalloc(m * nrhs)) ) ABORT("Malloc fails for rhs[].");
    zCreate_Dense_Matrix(&B, m, nrhs, rhs, m, SLU_DN, SLU_Z, SLU_GE);
    xact = doublecomplexMalloc(n * nrhs);
    ldx = n;
    zGenXtrue(n, nrhs, xact, ldx);
    zFillRHS(options.Trans, nrhs, xact, ldx, &A, &B);

    if ( !(perm_c = intMalloc(n)) ) ABORT("Malloc fails for perm_c[].");
    if ( !(perm_r = intMalloc(m)) ) ABORT("Malloc fails for perm_r[].");

    /* Initialize the statistics variables. */
    StatInit(&stat);
    
    zgssv(&options, &A, perm_c, perm_r, &L, &U, &B, &stat, &info);
    
    if ( info == 0 ) {

	/* This is how you could access the solution matrix. */
        doublecomplex *sol = (doublecomplex*) ((DNformat*) B.Store)->nzval; 

	 /* Compute the infinity norm of the error. */
	zinf_norm_error(nrhs, &B, xact);

	Lstore = (SCformat *) L.Store;
	Ustore = (NCformat *) U.Store;
    	printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
    	printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
    	printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
    	printf("FILL ratio = %.1f\n", (float)(Lstore->nnz + Ustore->nnz - n)/nnz);
	
	zQuerySpace(&L, &U, &mem_usage);
	printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
	       mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
	
    } else {
	printf("zgssv() error returns INFO= %d\n", info);
	if ( info <= n ) { /* factorization completes */
	    zQuerySpace(&L, &U, &mem_usage);
	    printf("L\\U MB %.3f\ttotal MB needed %.3f\n",
		   mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
	}
    }

    if ( options.PrintStat ) StatPrint(&stat);
    StatFree(&stat);

    SUPERLU_FREE (rhs);
    SUPERLU_FREE (xact);
    SUPERLU_FREE (perm_r);
    SUPERLU_FREE (perm_c);
    Destroy_CompCol_Matrix(&A);
    Destroy_SuperMatrix_Store(&B);
    Destroy_SuperNode_Matrix(&L);
    Destroy_CompCol_Matrix(&U);

#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Exit main()");
#endif
}
Пример #16
0
int main ( )

/******************************************************************************/
/*
  Purpose:

    D_SAMPLE_ST tests the SUPERLU solver with a 5x5 double precision real matrix.

  Discussion:

    The general (GE) representation of the matrix is:

      [ 19  0 21 21  0
        12 21  0  0  0
         0 12 16  0  0 
         0  0  0  5 21
        12 12  0  0 18 ]

    The (0-based) compressed column (CC) representation of this matrix is:

      I  CC   A
     --  --  --
      0   0  19
      1      12
      4      12

      1   3  21
      2      12
      4      12

      0   6  21
      2      16

      0   8  21
      3       5

      3  10  21
      4      18

      *  12   *

    The right hand side B and solution X are

      #   B     X
     --  --  ----------
      0   1  -0.03125
      1   1   0.0654762
      2   1   0.0133929
      3   1   0.0625
      4   1   0.0327381 

  Licensing:

    This code is distributed under the GNU LGPL license. 

  Modified:

    18 July 2014

  Author:

    John Burkardt

  Reference:

    James Demmel, John Gilbert, Xiaoye Li,
    SuperLU Users's Guide.
*/
{
  SuperMatrix A;
  double *acc;
  double *b;
  double *b2;
  SuperMatrix B;
  int *ccc;
  int i;
  int *icc;
  int info;
  int j;
  SuperMatrix L;
  int m;
  int n;
  int nrhs = 1;
  int ncc;
  superlu_options_t options;
  int *perm_c;
  int permc_spec;
  int *perm_r;
  SuperLUStat_t stat;
  SuperMatrix U;

  timestamp ( );
  printf ( "\n" );
  printf ( "D_SAMPLE_ST:\n" );
  printf ( "  C version\n" );
  printf ( "  SUPERLU solves a double precision real linear system.\n" );
  printf ( "  The matrix is read from a Sparse Triplet (ST) file.\n" );
/*
  Read the matrix from a file associated with standard input,
  in sparse triplet (ST) format, into compressed column (CC) format.
*/
  dreadtriple ( &m, &n, &ncc, &acc, &icc, &ccc );
/*
  Print the matrix.
*/
  cc_print ( m, n, ncc, icc, ccc, acc, "  CC Matrix:" );
/*
  Convert the compressed column (CC) matrix into a SuperMatrix A. 
*/
  dCreate_CompCol_Matrix ( &A, m, n, ncc, acc, icc, ccc, SLU_NC, SLU_D, SLU_GE );    
/*
  Create the right-hand side matrix.
*/
  b = ( double * ) malloc ( m * sizeof ( double ) );
  for ( i = 0; i < m; i++ )
  {
    b[i] = 1.0;
  }
  printf ( "\n" );
  printf ( "  Right hand side:\n" );
  printf ( "\n" );
  for ( i = 0; i < m; i++ )
  {
    printf ( "%g\n", b[i] );
  }
/*
  Create Super Right Hand Side.
*/
  dCreate_Dense_Matrix ( &B, m, nrhs, b, m, SLU_DN, SLU_D, SLU_GE );
/*
  Set space for the permutations.
*/
  perm_r = ( int * ) malloc ( m * sizeof ( int ) );
  perm_c = ( int * ) malloc ( n * sizeof ( int ) );
/*
  Set the input options. 
*/
  set_default_options ( &options );
  options.ColPerm = NATURAL;
/*
  Initialize the statistics variables. 
*/
  StatInit ( &stat );
/*
  Solve the linear system. 
*/
  dgssv ( &options, &A, perm_c, perm_r, &L, &U, &B, &stat, &info );
    
  dPrint_CompCol_Matrix ( ( char * ) "A", &A );
  dPrint_CompCol_Matrix ( ( char * ) "U", &U );
  dPrint_SuperNode_Matrix ( ( char * ) "L", &L );
  print_int_vec ( ( char * ) "\nperm_r", m, perm_r );
/*
  By some miracle involving addresses, 
  the solution has been put into the B vector.
*/
  printf ( "\n" );
  printf ( "  Computed solution:\n" );
  printf ( "\n" );
  for ( i = 0; i < m; i++ )
  {
    printf ( "%g\n", b[i] );
  }
/*
  Demonstrate that RHS is really the solution now.
  Multiply it by the matrix.
*/
  b2 = cc_mv ( m, n, ncc, icc, ccc, acc, b );
  printf ( "\n" );
  printf ( "  Product A*X:\n" );
  printf ( "\n" );
  for ( i = 0; i < m; i++ )
  {
    printf ( "%g\n", b2[i] );
  }
/*
  Free memory.
*/
  free ( b );
  free ( b2 );
  free ( perm_c );
  free ( perm_r );

  Destroy_SuperMatrix_Store ( &A );
  Destroy_SuperMatrix_Store ( &B );
  Destroy_SuperNode_Matrix ( &L );
  Destroy_CompCol_Matrix ( &U );
  StatFree ( &stat );
/*
  Terminate.
*/
  printf ( "\n" );
  printf ( "D_SAMPLE_ST:\n" );
  printf ( "  Normal end of execution.\n" );
  printf ( "\n" );
  timestamp ( );

  return 0;
}
Пример #17
0
void
cgssvx(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;
    complex    *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 clangs(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 (!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_C || 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_C || 
		      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_C || X->Mtype != SLU_GE )
		*info = -14;
	}
    }
    if (*info != 0) {
	i = -(*info);
	xerbla_("cgssvx", &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) );
	cCreate_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. */
	cgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
	
	if ( info1 == 0 ) {
	    /* Equilibrate matrix A. */
	    claqgs(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 ( 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) {
                        cs_mult(&Bmat[i+j*ldb], &Bmat[i+j*ldb], R[i]);
	            }
	    }
        } else if ( colequ ) {
	    for (j = 0; j < nrhs; ++j)
	        for (i = 0; i < A->nrow; ++i) {
                    cs_mult(&Bmat[i+j*ldb], &Bmat[i+j*ldb], C[i]);
	        }
        }
    }

    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_();
	cgstrf(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 = cPivotGrowth(*info, AA, perm_c, L, U);
	    }
	    return;
        }

        /* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
        *recip_pivot_growth = cPivotGrowth(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 = clangs(norm, AA);
        cgscon(norm, L, U, anorm, rcond, stat, info);
        utime[RCOND] = SuperLU_timer_() - t0;
    }
    
    if ( nrhs > 0 ) {
        /* 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_();
        cgstrs (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 ) {
            cgsrfs(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) {
                        cs_mult(&Xmat[i+j*ldx], &Xmat[i+j*ldx], C[i]);
	            }
	    }
        } else if ( rowequ ) {
	    for (j = 0; j < nrhs; ++j)
	        for (i = 0; i < A->nrow; ++i) {
                    cs_mult(&Xmat[i+j*ldx], &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 ) {
        cQuerySpace(L, U, mem_usage);
        Destroy_CompCol_Permuted(&AC);
    }
    if ( A->Stype == SLU_NR ) {
	Destroy_SuperMatrix_Store(AA);
	SUPERLU_FREE(AA);
    }

}
Пример #18
0
void
pdgssvx(int nprocs, pdgstrf_options_t *pdgstrf_options, SuperMatrix *A, 
	int *perm_c, int *perm_r, equed_t *equed, double *R, double *C,
	SuperMatrix *L, SuperMatrix *U,
	SuperMatrix *B, SuperMatrix *X, double *recip_pivot_growth, 
	double *rcond, double *ferr, double *berr, 
	superlu_memusage_t *superlu_memusage, int *info)
{
/*
 * -- SuperLU MT routine (version 1.0) --
 * Univ. of California Berkeley, Xerox Palo Alto Research Center,
 * and Lawrence Berkeley National Lab.
 * August 15, 1997
 *
 * Purpose
 * =======
 *
 * pdgssvx() solves the system of linear equations A*X=B or A'*X=B, using
 * the LU factorization from dgstrf(). 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 sp_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 sp_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 pdgstrf(). There is a single thread of
 *         control to call pdgstrf(), and all threads spawned by pdgstrf() 
 *         are terminated before returning from pdgstrf().
 *
 * pdgstrf_options (input) pdgstrf_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 (double)
 *           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 pdgstrf_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 pdgstrf_options->fact = FACTORED or DOFACT, or 
 *         if pdgstrf_options->fact = EQUILIBRATE and equed = NOEQUIL.
 *
 *         On exit, if pdgstrf_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 pdgstrf_options->usepr = NO, perm_r is output argument;
 *         If pdgstrf_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 pdgstrf_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) double*
 *         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) double*
 *         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) double*, 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) double*, 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;
    double    *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;
    double    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 double dlangs(char *, SuperMatrix *);
    extern double dlamch_(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;
    pdgstrf_options->perm_c = perm_c;
    pdgstrf_options->perm_r = perm_r;

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

    /* ------------------------------------------------------------
       Test the input parameters.
       ------------------------------------------------------------*/
    if ( nprocs <= 0 ) *info = -1;
    else if ( (!dofact && !equil && (pdgstrf_options->fact != FACTORED))
	      || (!notran && (pdgstrf_options->trans != TRANS) && 
		 (pdgstrf_options->trans != CONJ))
	      || (pdgstrf_options->refact != YES && 
		  pdgstrf_options->refact != NO)
	      || (pdgstrf_options->usepr != YES &&
		  pdgstrf_options->usepr != NO)
	      || pdgstrf_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_D || A->Mtype != SLU_GE )
	*info = -3;
    else if ((pdgstrf_options->fact == FACTORED) && 
	     !(rowequ || colequ || (*equed == NOEQUIL))) *info = -6;
    else {
	if (rowequ) {
	    rcmin = bignum;
	    rcmax = 0.;
	    for (j = 0; j < A->nrow; ++j) {
		rcmin = MIN(rcmin, R[j]);
		rcmax = MAX(rcmax, R[j]);
	    }
	    if (rcmin <= 0.) *info = -7;
	    else if ( A->nrow > 0)
		rowcnd = MAX(rcmin,smlnum) / MIN(rcmax,bignum);
	    else rowcnd = 1.;
	}
	if (colequ && *info == 0) {
	    rcmin = bignum;
	    rcmax = 0.;
	    for (j = 0; j < A->nrow; ++j) {
		rcmin = MIN(rcmin, C[j]);
		rcmax = MAX(rcmax, C[j]);
	    }
	    if (rcmin <= 0.) *info = -8;
	    else if (A->nrow > 0)
		colcnd = MAX(rcmin,smlnum) / MIN(rcmax,bignum);
	    else colcnd = 1.;
	}
	if (*info == 0) {
	    if ( B->ncol < 0 || Bstore->lda < MAX(0, A->nrow) ||
		      B->Stype != SLU_DN || B->Dtype != SLU_D || 
		      B->Mtype != SLU_GE )
		*info = -11;
	    else if ( X->ncol < 0 || Xstore->lda < MAX(0, A->nrow) ||
		      B->ncol != X->ncol || X->Stype != SLU_DN ||
		      X->Dtype != SLU_D || X->Mtype != SLU_GE )
		*info = -12;
	}
    }
    if (*info != 0) {
	i = -(*info);
	xerbla_("dgssvx", &i);
	return;
    }
    
    
    /* ------------------------------------------------------------
       Allocate storage and initialize statistics variables. 
       ------------------------------------------------------------*/
    panel_size = pdgstrf_options->panel_size;
    relax = pdgstrf_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) );
	dCreate_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 = pdgstrf_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. */
	dgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
	
	if ( info1 == 0 ) {
	    /* Equilibrate matrix A. */
	    dlaqgs(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, pdgstrf_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_();
	pdgstrf(pdgstrf_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 ( pdgstrf_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 = dPivotGrowth(*info, AA, perm_c, L, U);
	}
    } else {

	/* ------------------------------------------------------------
	   Compute the reciprocal pivot growth factor *recip_pivot_growth.
	   ------------------------------------------------------------*/
	*recip_pivot_growth = dPivotGrowth(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 = dlangs(norm, AA);
	dgscon(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_();
	dgstrs(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_();
	dgsrfs(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 < dlamch_("E") ) *info = A->ncol + 1;
	
    }

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

    /* ------------------------------------------------------------
       Deallocate storage after factorization.
       ------------------------------------------------------------*/
    if ( pdgstrf_options->refact == NO ) {
        SUPERLU_FREE(pdgstrf_options->etree);
        SUPERLU_FREE(pdgstrf_options->colcnt_h);
	SUPERLU_FREE(pdgstrf_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.
       ------------------------------------------------------------*/
    PrintStat(&Gstat);
    StatFree(&Gstat);
}
Пример #19
0
void
dgssvx(char *fact, char *trans, char *refact,
       SuperMatrix *A, factor_param_t *factor_params, int *perm_c,
       int *perm_r, int *etree, char *equed, double *R, double *C,
       SuperMatrix *L, SuperMatrix *U, void *work, int lwork,
       SuperMatrix *B, SuperMatrix *X, double *recip_pivot_growth, 
       double *rcond, double *ferr, double *berr, 
       mem_usage_t *mem_usage, int *info )
{
/*
 * Purpose
 * =======
 *
 * DGSSVX solves the system of linear equations A*X=B or A'*X=B, using
 * the LU factorization from dgstrf(). 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 = 'E', scaling factors are computed to equilibrate the
 *           system:
 *             trans = 'N':  diag(R)*A*diag(C)     *inv(diag(C))*X = diag(R)*B
 *             trans = 'T': (diag(R)*A*diag(C))**T *inv(diag(R))*X = diag(C)*B
 *             trans = 'C': (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='N')
 *           or diag(C)*B (if trans = 'T' or 'C').
 *
 *      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 sp_preorder.c.
 *
 *      1.3. If fact = 'N' or 'E', the LU decomposition is used to factor the
 *           matrix A (after equilibration if fact = 'E') 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 = 'N') or diag(R) (if trans = 'T' or 'C') 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 transpose of A:
 *
 *      2.1. If fact = 'E', scaling factors are computed to equilibrate the
 *           system:
 *             trans = 'N':  diag(R)*A'*diag(C)     *inv(diag(C))*X = diag(R)*B
 *             trans = 'T': (diag(R)*A'*diag(C))**T *inv(diag(R))*X = diag(C)*B
 *             trans = 'C': (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='N') or diag(C)*B (if trans = 'T' or 'C').
 *
 *      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 sp_preorder.c.
 *
 *      2.3. If fact = 'N' or 'E', the LU decomposition is used to factor the
 *           transpose(A) (after equilibration if fact = 'E') 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 = 'N') or diag(R) (if trans = 'T' or 'C') so
 *           that it solves the original system before equilibration.
 *
 *   See supermatrix.h for the definition of 'SuperMatrix' structure.
 *
 * Arguments
 * =========
 *
 * fact    (input) char*
 *         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.
 *         = 'F': On entry, L, U, perm_r and perm_c contain the factored
 *                form of A. If equed is not 'N', the matrix A has been
 *                equilibrated with scaling factors R and C.
 *                A, L, U, perm_r are not modified.
 *         = 'N': The matrix A will be factored, and the factors will be
 *                stored in L and U.
 *         = 'E': The matrix A will be equilibrated if necessary, then
 *                factored into L and U.
 *
 * trans   (input) char*
 *         Specifies the form of the system of equations:
 *         = 'N': A * X = B        (No transpose)
 *         = 'T': A**T * X = B     (Transpose)
 *         = 'C': A**H * X = B     (Transpose)
 *
 * refact  (input) char*
 *         Specifies whether we want to re-factor the matrix.
 *         = 'N': Factor the matrix A.
 *         = 'Y': Matrix A was factored before, now we want to re-factor
 *                matrix A with perm_r and etree as inputs. Use
 *                the same storage for the L\U factors previously allocated,
 *                expand it if necessary. User should insure to use the same
 *                memory model.  In this case, perm_r may be modified due to
 *                different pivoting determined by diagonal threshold.
 *         If fact = 'F', then refact is not accessed.
 *
 * A       (input/output) SuperMatrix*
 *         Matrix A in A*X=B, of dimension (A->nrow, A->ncol). The number
 *         of the linear equations is A->nrow. Currently, the type of A can be:
 *         Stype = NC or NR, Dtype = _D, Mtype = GE. In the future,
 *         more general A can be handled.
 *
 *         On entry, If fact = 'F' and equed is not 'N', then A must have
 *         been equilibrated by the scaling factors in R and/or C.  
 *         A is not modified if fact = 'F' or 'N', or if fact = 'E' and 
 *         equed = 'N' on exit.
 *
 *         On exit, if fact = 'E' and equed is not 'N', A is scaled as follows:
 *         If A->Stype = NC:
 *           equed = 'R':  A := diag(R) * A
 *           equed = 'C':  A := A * diag(C)
 *           equed = 'B':  A := diag(R) * A * diag(C).
 *         If A->Stype = NR:
 *           equed = 'R':  transpose(A) := diag(R) * transpose(A)
 *           equed = 'C':  transpose(A) := transpose(A) * diag(C)
 *           equed = 'B':  transpose(A) := diag(R) * transpose(A) * diag(C).
 *
 * factor_params (input) factor_param_t*
 *         The structure defines the input scalar parameters, consisting of
 *         the following fields. If factor_params = NULL, the default
 *         values are used for all the fields; otherwise, the values
 *         are given by the user.
 *         - panel_size (int): Panel size. A panel consists of at most
 *             panel_size consecutive columns. If panel_size = -1, use 
 *             default value 8.
 *         - 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.
 *             If relax = -1, use default value 8.
 *         - diag_pivot_thresh (double): Diagonal pivoting threshold.
 *             At step j of the Gaussian elimination, if
 *                 abs(A_jj) >= diag_pivot_thresh * (max_(i>=j) abs(A_ij)),
 *             then use A_jj as pivot. 0 <= diag_pivot_thresh <= 1.
 *             If diag_pivot_thresh = -1, use default value 1.0,
 *             which corresponds to standard partial pivoting.
 *         - drop_tol (double): Drop tolerance threshold. (NOT IMPLEMENTED)
 *             At step j of the Gaussian elimination, if
 *                 abs(A_ij)/(max_i abs(A_ij)) < drop_tol,
 *             then drop entry A_ij. 0 <= drop_tol <= 1.
 *             If drop_tol = -1, use default value 0.0, which corresponds to
 *             standard Gaussian elimination.
 *
 * 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 transpose(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 refact is not 'Y', perm_r is output argument;
 *         If refact = 'Y', 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.
 * 
 * etree   (input/output) int*,  dimension (A->ncol)
 *         Elimination tree of Pc'*A'*A*Pc.
 *         If fact is not 'F' and refact = 'Y', etree is an input argument,
 *         otherwise it is an output argument.
 *         Note: etree is a vector of parent pointers for a forest whose
 *         vertices are the integers 0 to A->ncol-1; etree[root]==A->ncol.
 *
 * equed   (input/output) char*
 *         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).
 *         If fact = 'F', 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 = 'R' or 'B', A (if A->Stype = NC) or transpose(A) (if
 *             A->Stype = NR) is multiplied on the left by diag(R).
 *         If equed = 'N' or 'C', R is not accessed.
 *         If fact = 'F', R is an input argument; otherwise, R is output.
 *         If fact = 'F' and equed = 'R' or 'B', 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 = 'C' or 'B', A (if A->Stype = NC) or transpose(A) (if 
 *             A->Stype = NR) is multiplied on the right by diag(C).
 *         If equed = 'N' or 'R', C is not accessed.
 *         If fact = 'F', C is an input argument; otherwise, C is output.
 *         If fact = 'F' and equed = 'C' or 'B', 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 = SC, 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 = NC, Dtype = _D, Mtype = TRU.
 *
 * work    (workspace/output) void*, size (lwork) (in bytes)
 *         User supplied workspace, should be large enough
 *         to hold data structures for factors L and U.
 *         On exit, if fact is not 'F', L and U point to this array.
 *
 * lwork   (input) int
 *         Specifies the size of work array in bytes.
 *         = 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
 *               mem_usage->total_needed; no other side effects.
 *
 *         See argument 'mem_usage' for memory usage statistics.
 *
 * B       (input/output) SuperMatrix*
 *         B has types: Stype = DN, Dtype = _D, Mtype = GE.
 *         On entry, the right hand side matrix.
 *         On exit,
 *            if equed = 'N', B is not modified; otherwise
 *            if A->Stype = NC:
 *               if trans = 'N' and equed = 'R' or 'B', B is overwritten by
 *                  diag(R)*B;
 *               if trans = 'T' or 'C' and equed = 'C' of 'B', B is
 *                  overwritten by diag(C)*B;
 *            if A->Stype = NR:
 *               if trans = 'N' and equed = 'C' or 'B', B is overwritten by
 *                  diag(C)*B;
 *               if trans = 'T' or 'C' and equed = 'R' of 'B', 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 'N', and the solution to the equilibrated
 *         system is inv(diag(C))*X if trans = 'N' and equed = 'C' or 'B',
 *         or inv(diag(R))*X if trans = 'T' or 'C' and equed = 'R' or 'B'.
 *
 * recip_pivot_growth (output) double*
 *         The reciprocal pivot growth factor max_j( norm(A_j)/norm(U_j) ).
 *         The infinity norm is used. If recip_pivot_growth is much less
 *         than 1, the stability of the LU factorization could be poor.
 *
 * rcond   (output) double*
 *         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) double*, 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) double*, 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).
 *
 * mem_usage (output) mem_usage_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.
 *
 */

    DNformat  *Bstore, *Xstore;
    double    *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, nofact, notran, rowequ;
    char      trant[1], norm[1];
    int       i, j, info1;
    double    amax, anorm, bignum, smlnum, colcnd, rowcnd, rcmax, rcmin;
    int       relax, panel_size;
    double    diag_pivot_thresh, drop_tol;
    double    t0;      /* temporary time */
    double    *utime;
    extern SuperLUStat_t SuperLUStat;

    /* External functions */
    extern double dlangs(char *, SuperMatrix *);
    extern double dlamch_(char *);

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

#if 0
printf("dgssvx: fact=%c, trans=%c, refact=%c, equed=%c\n",
       *fact, *trans, *refact, *equed);
#endif
    
    *info = 0;
    nofact = lsame_(fact, "N");
    equil = lsame_(fact, "E");
    notran = lsame_(trans, "N");
    if (nofact || equil) {
	*(unsigned char *)equed = 'N';
	rowequ = FALSE;
	colequ = FALSE;
    } else {
	rowequ = lsame_(equed, "R") || lsame_(equed, "B");
	colequ = lsame_(equed, "C") || lsame_(equed, "B");
	smlnum = dlamch_("Safe minimum");
	bignum = 1. / smlnum;
    }

    /* Test the input parameters */
    if (!nofact && !equil && !lsame_(fact, "F")) *info = -1;
    else if (!notran && !lsame_(trans, "T") && !lsame_(trans, "C")) *info = -2;
    else if ( !(lsame_(refact,"Y") || lsame_(refact, "N")) ) *info = -3;
    else if ( A->nrow != A->ncol || A->nrow < 0 ||
	      (A->Stype != NC && A->Stype != NR) ||
	      A->Dtype != _D || A->Mtype != GE )
	*info = -4;
    else if (lsame_(fact, "F") && !(rowequ || colequ || lsame_(equed, "N")))
	*info = -9;
    else {
	if (rowequ) {
	    rcmin = bignum;
	    rcmax = 0.;
	    for (j = 0; j < A->nrow; ++j) {
		rcmin = MIN(rcmin, R[j]);
		rcmax = MAX(rcmax, R[j]);
	    }
	    if (rcmin <= 0.) *info = -10;
	    else if ( A->nrow > 0)
		rowcnd = MAX(rcmin,smlnum) / MIN(rcmax,bignum);
	    else rowcnd = 1.;
	}
	if (colequ && *info == 0) {
	    rcmin = bignum;
	    rcmax = 0.;
	    for (j = 0; j < A->nrow; ++j) {
		rcmin = MIN(rcmin, C[j]);
		rcmax = MAX(rcmax, C[j]);
	    }
	    if (rcmin <= 0.) *info = -11;
	    else if (A->nrow > 0)
		colcnd = MAX(rcmin,smlnum) / MIN(rcmax,bignum);
	    else colcnd = 1.;
	}
	if (*info == 0) {
	    if ( lwork < -1 ) *info = -15;
	    else if ( B->ncol < 0 || Bstore->lda < MAX(0, A->nrow) ||
		      B->Stype != DN || B->Dtype != _D || 
		      B->Mtype != GE )
		*info = -16;
	    else if ( X->ncol < 0 || Xstore->lda < MAX(0, A->nrow) ||
		      B->ncol != X->ncol || X->Stype != DN ||
		      X->Dtype != _D || X->Mtype != GE )
		*info = -17;
	}
    }
    if (*info != 0) {
	i = -(*info);
	xerbla_("dgssvx", &i);
	return;
    }
    
    /* Default values for factor_params */
    panel_size = sp_ienv(1);
    relax      = sp_ienv(2);
    diag_pivot_thresh = 1.0;
    drop_tol   = 0.0;
    if ( factor_params != NULL ) {
	if ( factor_params->panel_size != -1 )
	    panel_size = factor_params->panel_size;
	if ( factor_params->relax != -1 ) relax = factor_params->relax;
	if ( factor_params->diag_pivot_thresh != -1 )
	    diag_pivot_thresh = factor_params->diag_pivot_thresh;
	if ( factor_params->drop_tol != -1 )
	    drop_tol = factor_params->drop_tol;
    }

    StatInit(panel_size, relax);
    utime = SuperLUStat.utime;
    
    /* Convert A to NC format when necessary. */
    if ( A->Stype == NR ) {
	NRformat *Astore = A->Store;
	AA = (SuperMatrix *) SUPERLU_MALLOC( sizeof(SuperMatrix) );
	dCreate_CompCol_Matrix(AA, A->ncol, A->nrow, Astore->nnz, 
			       Astore->nzval, Astore->colind, Astore->rowptr,
			       NC, A->Dtype, A->Mtype);
	if ( notran ) { /* Reverse the transpose argument. */
	    *trant = 'T';
	    notran = 0;
	} else {
	    *trant = 'N';
	    notran = 1;
	}
    } else { /* A->Stype == NC */
	*trant = *trans;
	AA = A;
    }

    if ( equil ) {
	t0 = SuperLU_timer_();
	/* Compute row and column scalings to equilibrate the matrix A. */
	dgsequ(AA, R, C, &rowcnd, &colcnd, &amax, &info1);
	
	if ( info1 == 0 ) {
	    /* Equilibrate matrix A. */
	    dlaqgs(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;
    }

    /* 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];
	    }
    }

    if ( nofact || equil ) {
	
	t0 = SuperLU_timer_();
	sp_preorder(refact, 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_();
	dgstrf(refact, &AC, diag_pivot_thresh, drop_tol, relax, panel_size,
	       etree, work, lwork, perm_r, perm_c, L, U, info);
	utime[FACT] = SuperLU_timer_() - t0;
	
	if ( lwork == -1 ) {
	    mem_usage->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 = dPivotGrowth(*info, AA, perm_c, L, U);
	}
	return;
    }

    /* Compute the reciprocal pivot growth factor *recip_pivot_growth. */
    *recip_pivot_growth = dPivotGrowth(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 = dlangs(norm, AA);
    dgscon(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_();
    dgstrs (trant, L, U, perm_r, perm_c, X, 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_();
    dgsrfs(trant, AA, L, U, perm_r, perm_c, equed, R, C, B,
	      X, ferr, berr, 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 < dlamch_("E") ) *info = A->ncol + 1;

    dQuerySpace(L, U, panel_size, mem_usage);

    if ( nofact || equil ) Destroy_CompCol_Permuted(&AC);
    if ( A->Stype == NR ) {
	Destroy_SuperMatrix_Store(AA);
	SUPERLU_FREE(AA);
    }

    PrintStat( &SuperLUStat );
    StatFree();
}
Пример #20
0
int main ( int argc, char *argv[] )

/**********************************************************************/
/*
  Purpose:

    SUPER_LU_S2 solves a symmetric sparse system read from a file.

  Discussion:

    The sparse matrix is stored in a file using the Harwell-Boeing
    sparse matrix format.  The file should be assigned to the standard
    input of this program.  For instance, if the matrix is stored
    in the file "g10_rua.txt", the execution command might be:

      super_lu_s2 < g10_rua.txt

  Modified:

    25 April 2004

  Reference:

    James Demmel, John Gilbert, Xiaoye Li,
    SuperLU Users's Guide,
    Sections 1 and 2.

  Local parameters:

    SuperMatrix L, the computed L factor.

    int *perm_c, the column permutation vector.

    int *perm_r, the row permutations from partial pivoting.

    SuperMatrix U, the computed U factor.
*/
{
  SuperMatrix A;
  NCformat *Astore;
  float *a;
  int *asub;
  SuperMatrix B;
  int info;
  SuperMatrix L;
  int ldx;
  SCformat *Lstore;
  int m;
  mem_usage_t mem_usage;
  int n;
  int nnz;
  int nrhs;
  superlu_options_t options;
  int *perm_c;
  int *perm_r;
  float *rhs;
  float *sol;
  SuperLUStat_t stat;
  SuperMatrix U;
  NCformat *Ustore;
  int *xa;
  float *xact;
/*
  Say hello.
*/
  printf ( "\n" );
  printf ( "SUPER_LU_S2:\n" );
  printf ( "  Read a symmetric sparse matrix A from standard input,\n");
  printf ( "  stored in Harwell-Boeing Sparse Matrix format.\n" );
  printf ( "\n" );
  printf ( "  Solve a linear system A * X = B.\n" );
/* 
  Set the default input options:
  options.Fact = DOFACT;
  options.Equil = YES;
  options.ColPerm = COLAMD;
  options.DiagPivotThresh = 1.0;
  options.Trans = NOTRANS;
  options.IterRefine = NOREFINE;
  options.SymmetricMode = NO;
  options.PivotGrowth = NO;
  options.ConditionNumber = NO;
  options.PrintStat = YES;
*/
  set_default_options ( &options );
/* 
  Now we modify the default options to use the symmetric mode. 
*/
  options.SymmetricMode = YES;
  options.ColPerm = MMD_AT_PLUS_A;
  options.DiagPivotThresh = 0.001;
/* 
  Read the matrix in Harwell-Boeing format. 
*/
  sreadhb ( &m, &n, &nnz, &a, &asub, &xa );
/*
  Create storage for a compressed column matrix.
*/
  sCreate_CompCol_Matrix ( &A, m, n, nnz, a, asub, xa, SLU_NC, SLU_S, SLU_GE );
  Astore = A.Store;

  printf ( "\n" );
  printf ( "  Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz );
/*
  Set up the right hand side.
*/  
  nrhs = 1;
  rhs = floatMalloc ( m * nrhs );
  if ( !rhs ) 
  {
    ABORT ( " Malloc fails for rhs[]." );
  }

  sCreate_Dense_Matrix ( &B, m, nrhs, rhs, m, SLU_DN, SLU_S, SLU_GE );
  xact = floatMalloc ( n * nrhs );
  if ( !xact ) 
  {
    ABORT ( " Malloc fails for rhs[]." );
  }
  ldx = n;
  sGenXtrue ( n, nrhs, xact, ldx );
  sFillRHS ( options.Trans, nrhs, xact, ldx, &A, &B );

  perm_c = intMalloc ( n );
  if ( !perm_c ) 
  {
    ABORT ( "Malloc fails for perm_c[]." );
  }

  perm_r = intMalloc ( m );
  if ( !perm_r )
  {
    ABORT ( "Malloc fails for perm_r[]." );
  }
/* 
  Initialize the statistics variables. 
*/
  StatInit ( &stat );
/*
  Call SGSSV to factor the matrix and solve the linear system.
*/
  sgssv ( &options, &A, perm_c, perm_r, &L, &U, &B, &stat, &info );
    
  if ( info == 0 )
  {
/* 
  To conveniently access the solution matrix, you need to get a pointer to it. 
*/
    sol = (float*) ((DNformat*) B.Store)->nzval; 

/* 
  Compute the infinity norm of the error. 
*/
    sinf_norm_error ( nrhs, &B, xact );

    Lstore = (SCformat *) L.Store;
    Ustore = (NCformat *) U.Store;

    printf ( "\n" );
    printf ( "  Number of nonzeros in factor L = %d\n", Lstore->nnz );
    printf ( "  Number of nonzeros in factor U = %d\n", Ustore->nnz );
    printf ( "  Number of nonzeros in L+U = %d\n", 
      Lstore->nnz + Ustore->nnz - n );
	
    sQuerySpace ( &L, &U, &mem_usage );

    printf ( "\n" );
    printf ( "  L\\U MB %.3f\ttotal MB needed %.3f\texpansions %d\n",
      mem_usage.for_lu/1e6, mem_usage.total_needed/1e6,
      mem_usage.expansions);
  } 
  else
  {
    printf ( "\n" );
    printf ( "  SGSSV error returns INFO= %d\n", info );

    if ( info <= n ) 
    {
      sQuerySpace ( &L, &U, &mem_usage );

      printf ( "\n" );
      printf ("  L\\U MB %.3f\ttotal MB needed %.3f\texpansions %d\n",
        mem_usage.for_lu/1e6, mem_usage.total_needed/1e6,
        mem_usage.expansions );
    }
  }

  if ( options.PrintStat ) 
  {
    StatPrint ( &stat );
  }
  StatFree ( &stat );
/*
  Free the memory.
*/
  SUPERLU_FREE ( rhs );
  SUPERLU_FREE ( xact );
  SUPERLU_FREE ( perm_r );
  SUPERLU_FREE ( perm_c );
  Destroy_CompCol_Matrix ( &A );
  Destroy_SuperMatrix_Store ( &B );
  Destroy_SuperNode_Matrix ( &L );
  Destroy_CompCol_Matrix ( &U );
/*
  Say goodbye.
*/
  printf ( "\n" );
  printf ( "SUPER_LU_S2:\n" );
  printf ( "  Normal end of execution.\n");

  return 0;
}