static void* slm_clone(void* context)
{
  slm_t* mat = context;
  slm_t* clone = polymec_malloc(sizeof(slm_t));
  clone->sparsity = adj_graph_clone(mat->sparsity);
  clone->A = supermatrix_new(clone->sparsity);
  int nnz = ((NCformat*)clone->A->Store)->nnz;
  real_t* Aij = ((NCformat*)clone->A->Store)->nzval;
  real_t* Bij = ((NCformat*)mat->A->Store)->nzval;
  memcpy(Aij, Bij, sizeof(real_t) * nnz);

  clone->N = mat->N;
  clone->rhs_data = polymec_malloc(sizeof(double) * clone->N);
  memcpy(clone->rhs_data, mat->rhs_data, sizeof(double) * clone->N);
  dCreate_Dense_Matrix(&clone->rhs, clone->N, 1, clone->rhs_data, clone->N, SLU_DN, SLU_D, SLU_GE);
  clone->X_data = polymec_malloc(sizeof(double) * clone->N);
  memcpy(clone->X_data, mat->X_data, sizeof(double) * clone->N);
  dCreate_Dense_Matrix(&clone->X, clone->N, 1, clone->X_data, clone->N, SLU_DN, SLU_D, SLU_GE);
  clone->R = polymec_malloc(sizeof(double) * clone->N);
  memcpy(clone->R, mat->R, sizeof(double) * clone->N);
  clone->C = polymec_malloc(sizeof(double) * clone->N);
  memcpy(clone->C, mat->C, sizeof(double) * clone->N);
  StatInit(&clone->stat);

  clone->cperm = NULL;
  clone->rperm = NULL;
  clone->options = mat->options;
  clone->options.Fact = DOFACT;
  clone->etree = NULL;

  return clone;
}
Beispiel #2
0
void RKWidget::setSize ( const size_t value )
{
    int add = value%nblock;
    size_t newval = value + add;
    if ( newval == N_ ) return;
    dirty = true;
    if ( N_ != 0 ) {
        if(nStage != 0) delete[] b_k;

        SUPERLU_FREE (rhsb);
        SUPERLU_FREE (rhsx);
        SUPERLU_FREE (etree);
        SUPERLU_FREE (perm_r);
        SUPERLU_FREE (perm_c);
        SUPERLU_FREE (R);
        SUPERLU_FREE (C);
        SUPERLU_FREE (ferr);
        SUPERLU_FREE (berr);

        if(aexist) {
            // ??? Destroy_CompCol_Matrix(&A);
            //delete[] a;
            //delete[] xa;
            //delete[] asub;
        }
        Destroy_SuperMatrix_Store(&B);
        Destroy_SuperMatrix_Store(&X);
        if ( lwork == 0 && !dirty) {
            Destroy_SuperNode_Matrix(&L);
            Destroy_CompCol_Matrix(&Up);
        } else if ( lwork > 0 ) {
            SUPERLU_FREE(work);
        }
        aexist= false;
        dirty = true;
    }
    if(nStage != 0) b_k = new double[value*nStage];

    if ( !(rhsb = doubleMalloc(value)) ) ABORT("Malloc fails for rhsb[].");
    if ( !(rhsx = doubleMalloc(value)) ) ABORT("Malloc fails for rhsx[].");
    dCreate_Dense_Matrix(&B, value, 1, rhsb, value, SLU_DN, SLU_D, SLU_GE);
    dCreate_Dense_Matrix(&X, value, 1, rhsx, value, SLU_DN, SLU_D, SLU_GE);

    if ( !(etree = intMalloc(value)) ) ABORT("Malloc fails for etree[].");
    if ( !(perm_r = intMalloc(value)) ) ABORT("Malloc fails for perm_r[].");
    if ( !(perm_c = intMalloc(value)) ) ABORT("Malloc fails for perm_c[].");
    if ( !(R = (double *) SUPERLU_MALLOC(value * sizeof(double))) )
        ABORT("SUPERLU_MALLOC fails for R[].");
    if ( !(C = (double *) SUPERLU_MALLOC(value * sizeof(double))) )
        ABORT("SUPERLU_MALLOC fails for C[].");
    if ( !(ferr = (double *) SUPERLU_MALLOC( sizeof(double))) )
        ABORT("SUPERLU_MALLOC fails for ferr[].");
    if ( !(berr = (double *) SUPERLU_MALLOC( sizeof(double))) )
        ABORT("SUPERLU_MALLOC fails for berr[].");
    resize(value);
}
local_matrix_t* sparse_local_matrix_new(adj_graph_t* sparsity)
{
  slm_t* mat = polymec_malloc(sizeof(slm_t));
  mat->sparsity = adj_graph_clone(sparsity); // MINE!
  mat->ilu_params = NULL;
  mat->A = supermatrix_new(sparsity);

  // Solver data.
  mat->N = adj_graph_num_vertices(sparsity);
  mat->rhs_data = polymec_malloc(sizeof(double) * mat->N);
  dCreate_Dense_Matrix(&mat->rhs, mat->N, 1, mat->rhs_data, mat->N, SLU_DN, SLU_D, SLU_GE);
  mat->X_data = polymec_malloc(sizeof(double) * mat->N);
  dCreate_Dense_Matrix(&mat->X, mat->N, 1, mat->X_data, mat->N, SLU_DN, SLU_D, SLU_GE);
  mat->R = polymec_malloc(sizeof(double) * mat->N);
  mat->C = polymec_malloc(sizeof(double) * mat->N);
  StatInit(&mat->stat);
  mat->cperm = NULL;
  mat->rperm = NULL;
  mat->etree = polymec_malloc(sizeof(int) * mat->N);
  set_default_options(&mat->options);
  mat->options.Equil = NO;
//  mat->options.ColPerm = NATURAL;
  mat->options.Fact = DOFACT;
#ifndef NDEBUG
  mat->options.PivotGrowth = YES;
  mat->options.ConditionNumber = YES;
#endif

  char name[1024];
  snprintf(name, 1024, "Sparse local matrix (N = %d)", mat->N);
  local_matrix_vtable vtable = {.clone = slm_clone,
                                .dtor = slm_dtor,
                                .zero = slm_zero,
                                .num_columns = slm_num_columns,
                                .get_columns = slm_get_columns,
                                .add_identity = slm_add_identity,
                                .add_column_vector = slm_add_column_vector,
                                .add_row_vector = slm_add_row_vector,
                                .solve = slm_solve,
                                .fprintf = slm_fprintf,
                                .value = slm_value,
                                .set_value = slm_set_value,
                                .get_diag = slm_get_diag,
                                .matvec = slm_matvec,
                                .add_matrix = slm_add_matrix,
                                .norm = slm_norm};
  return local_matrix_new(name, mat, vtable, mat->N);
}
void tlin::allocD(SuperMatrix *&A, int rows, int cols)
{
	A = (SuperMatrix *)SUPERLU_MALLOC(sizeof(SuperMatrix));

	double *values = doubleMalloc(rows * cols * sizeof(double));
	dCreate_Dense_Matrix(A, rows, cols, values, rows, SLU_DN, SLU_D, SLU_GE);
}
int HYPRE_ParCSR_SuperLUSolve(HYPRE_Solver solver, HYPRE_ParCSRMatrix A,
                              HYPRE_ParVector b, HYPRE_ParVector x )
{
#ifdef HAVE_SUPERLU
   int    nrows, i, info;
   double *bData, *xData;
   SuperMatrix B;
   SuperLUStat_t slu_stat;
   trans_t       trans;
   HYPRE_SuperLU *sluPtr = (HYPRE_SuperLU *) solver;

   /* ---------------------------------------------------------------- */
   /* make sure setup has been called                                  */
   /* ---------------------------------------------------------------- */

   assert ( sluPtr != NULL );
   if ( ! (sluPtr->factorized_) )
   {
      printf("HYPRE_ParCSR_SuperLUSolve ERROR - not factorized yet.\n");
      return -1;
   }

   /* ---------------------------------------------------------------- */
   /* fetch right hand side and solution vector                        */
   /* ---------------------------------------------------------------- */

   xData = hypre_VectorData(hypre_ParVectorLocalVector((hypre_ParVector *)x));
   bData = hypre_VectorData(hypre_ParVectorLocalVector((hypre_ParVector *)b));
   nrows = hypre_ParVectorGlobalSize((hypre_ParVector *)x); 
   for (i = 0; i < nrows; i++) xData[i] = bData[i];

   /* ---------------------------------------------------------------- */
   /* solve                                                            */
   /* ---------------------------------------------------------------- */

   dCreate_Dense_Matrix(&B, nrows, 1, bData, nrows, SLU_DN, SLU_D,SLU_GE);

   /* -------------------------------------------------------------
    * solve the problem
    * -----------------------------------------------------------*/

   trans = NOTRANS;
   StatInit(&slu_stat);
   dgstrs (trans, &(sluPtr->SLU_Lmat), &(sluPtr->SLU_Umat), 
           sluPtr->permC_, sluPtr->permR_, &B, &slu_stat, &info);
   Destroy_SuperMatrix_Store(&B);
   StatFree(&slu_stat);
   return 0;
#else
   printf("HYPRE_ParCSR_SuperLUSolve ERROR - SuperLU not enabled.\n");
   *solver = (HYPRE_Solver) NULL;
   return -1;
#endif
}
Beispiel #6
0
int main ( int argc, char *argv[] )

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

    SUPER_LU_D0 runs a small 5 by 5 example of the use of SUPER_LU.

  Modified:

    23 April 2004

  Reference:

    James Demmel, John Gilbert, Xiaoye Li,
    SuperLU Users's Guide,
    Sections 1 and 2.
*/
{
  double *a;
  SuperMatrix A;
  int *asub;
  SuperMatrix B;
  int i;
  int info;
  SuperMatrix L;
  int m;
  int n;
  int nnz;
  int nrhs;
  superlu_options_t options;
  int *perm_c;
  int *perm_r;
  int permc_spec;
  double *rhs;
  double sol[5];
  SuperLUStat_t stat;
  SuperMatrix U;
  int *xa;
/*
  Say hello.
*/
  printf ( "\n" );
  printf ( "SUPER_LU_D0:\n" );
  printf ( "  Simple 5 by 5 example of SUPER_LU solver.\n" );
/* 
  Initialize parameters. 
*/
  m = 5;
  n = 5;
  nnz = 12;
/* 
  Set aside space for the arrays. 
*/
  a = doubleMalloc ( nnz );
  if ( !a ) 
  {
    ABORT ( "Malloc fails for a[]." );
  }

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

  xa = intMalloc ( n+1 );
  if ( !xa ) 
  { 
    ABORT ( "Malloc fails for xa[]." );
  }
/* 
  Initialize matrix A. 
*/
  a[0] = 19.0; 
  a[1] = 12.0; 
  a[2] = 12.0; 
  a[3] = 21.0; 
  a[4] = 12.0; 
  a[5] = 12.0;
  a[6] = 21.0; 
  a[7] = 16.0; 
  a[8] = 21.0; 
  a[9] =  5.0; 
  a[10]= 21.0; 
  a[11]= 18.0;

  asub[0] = 0; 
  asub[1] = 1; 
  asub[2] = 4; 
  asub[3] = 1;
  asub[4] = 2; 
  asub[5] = 4; 
  asub[6] = 0; 
  asub[7] = 2;
  asub[8] = 0; 
  asub[9] = 3; 
  asub[10]= 3; 
  asub[11]= 4;

  xa[0] = 0; 
  xa[1] = 3; 
  xa[2] = 6; 
  xa[3] = 8; 
  xa[4] = 10; 
  xa[5] = 12;

  sol[0] = -0.031250000;
  sol[1] =  0.065476190;
  sol[2] =  0.013392857;
  sol[3] =  0.062500000;
  sol[4] =  0.032738095;
/* 
  Create matrix A in the format expected by SuperLU. 
*/
  dCreate_CompCol_Matrix ( &A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE );
/* 
  Create the right-hand side matrix B. 
*/
  nrhs = 1;
  rhs = doubleMalloc ( m * nrhs );
  if ( !rhs ) 
  {
    ABORT("Malloc fails for rhs[].");
  }

  for ( i = 0; i < m; i++ ) 
  {
    rhs[i] = 1.0;
  }

  dCreate_Dense_Matrix ( &B, m, nrhs, rhs, m, SLU_DN, SLU_D, SLU_GE );
/* 
  Set up the arrays for the permutations. 
*/
  perm_r = intMalloc ( m );
  if ( !perm_r ) 
  {
    ABORT ( "Malloc fails for perm_r[]." );
  }

  perm_c = intMalloc ( n );
  if ( !perm_c ) 
  {
    ABORT ( "Malloc fails for perm_c[]." );
  }
/* 
  Set the default input options, and then adjust some of them.
*/
  set_default_options ( &options );
  options.ColPerm = NATURAL;
/* 
  Initialize the statistics variables. 
*/
  StatInit ( &stat );
/*
  Factor the matrix and solve the linear system.
*/
  dgssv ( &options, &A, perm_c, perm_r, &L, &U, &B, &stat, &info );
/*
  Print some of the results.
*/
  dPrint_CompCol_Matrix ( "Matrix A", &A );
  dPrint_SuperNode_Matrix ( "Factor L", &L );
  dPrint_CompCol_Matrix ( "Factor U", &U );
  dPrint_Dense_Matrix ( "Solution X", &B );

  printf ( "\n" );
  printf ( "  The exact solution:\n" );
  printf ( "\n" );
  for ( i = 0; i < n; i++ )
  {
    printf ( "%d  %f\n", i, sol[i] );
  }

  printf ( "\n" );
  print_int_vec ( "perm_r", m, perm_r );
/* 
  De-allocate storage.
*/
  SUPERLU_FREE ( rhs );
  SUPERLU_FREE ( perm_r );
  SUPERLU_FREE ( perm_c );
  Destroy_CompCol_Matrix ( &A );
  Destroy_SuperMatrix_Store ( &B );
  Destroy_SuperNode_Matrix ( &L );
  Destroy_CompCol_Matrix ( &U );
  StatFree ( &stat );

  printf ( "\n" );
  printf ( "SUPER_LU_D0:\n" );
  printf ( "  Normal end of execution.\n" );

  return 0;
}
Beispiel #7
0
main(int argc, char *argv[])
{
/*
 * Purpose
 * =======
 *
 * The driver program DLINSOLX2.
 *
 * This example illustrates how to use DGSSVX to solve systems repeatedly
 * with the same sparsity pattern of matrix A.
 * In this case, the column permutation vector perm_c is computed once.
 * The following data structures will be reused in the subsequent call to
 * DGSSVX: perm_c, etree
 * 
 */
    char           equed[1];
    yes_no_t       equil;
    trans_t        trans;
    SuperMatrix    A, A1, L, U;
    SuperMatrix    B, B1, X;
    NCformat       *Astore;
    NCformat       *Ustore;
    SCformat       *Lstore;
    double         *a, *a1;
    int            *asub, *xa, *asub1, *xa1;
    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, j, m, n, nnz;
    double         *rhsb, *rhsb1, *rhsx, *xact;
    double         *R, *C;
    double         *ferr, *berr;
    double         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 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;

    if ( lwork > 0 ) {
	work = SUPERLU_MALLOC(lwork);
	if ( !work ) {
	    ABORT("DLINSOLX: cannot allocate work[]");
	}
    }

    /* Read matrix A from a file in Harwell-Boeing format.*/
    dreadhb(&m, &n, &nnz, &a, &asub, &xa);
    if ( !(a1 = doubleMalloc(nnz)) ) ABORT("Malloc fails for a1[].");
    if ( !(asub1 = intMalloc(nnz)) ) ABORT("Malloc fails for asub1[].");
    if ( !(xa1 = intMalloc(n+1)) ) ABORT("Malloc fails for xa1[].");
    for (i = 0; i < nnz; ++i) {
        a1[i] = a[i];
	asub1[i] = asub[i];
    }
    for (i = 0; i < n+1; ++i) xa1[i] = xa[i];
    
    dCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE);
    Astore = A.Store;
    printf("Dimension %dx%d; # nonzeros %d\n", A.nrow, A.ncol, Astore->nnz);
    
    if ( !(rhsb = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb[].");
    if ( !(rhsb1 = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhsb1[].");
    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);
    for (j = 0; j < nrhs; ++j)
        for (i = 0; i < m; ++i) rhsb1[i+j*m] = rhsb[i+j*m];
    
    if ( !(perm_c = intMalloc(n)) ) ABORT("Malloc fails for perm_c[].");
    if ( !(perm_r = intMalloc(m)) ) ABORT("Malloc fails for perm_r[].");
    if ( !(etree = intMalloc(n)) ) ABORT("Malloc fails for etree[].");
    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);
    
    /* ------------------------------------------------------------
       WE SOLVE THE LINEAR SYSTEM FOR THE FIRST TIME: AX = B
       ------------------------------------------------------------*/
    dgssvx(&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("First system: dgssvx() returns info %d\n", info);

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

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

	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);
	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);
    Destroy_CompCol_Matrix(&A);
    Destroy_Dense_Matrix(&B);
    if ( lwork >= 0 ) { /* Deallocate storage associated with L and U. */
        Destroy_SuperNode_Matrix(&L);
        Destroy_CompCol_Matrix(&U);
    }

    /* ------------------------------------------------------------
       NOW WE SOLVE ANOTHER LINEAR SYSTEM: A1*X = B1
       ONLY THE SPARSITY PATTERN OF A1 IS THE SAME AS THAT OF A.
       ------------------------------------------------------------*/
    options.Fact = SamePattern;
    StatInit(&stat); /* Initialize the statistics variables. */

    dCreate_CompCol_Matrix(&A1, m, n, nnz, a1, asub1, xa1,
                           SLU_NC, SLU_D, SLU_GE);
    dCreate_Dense_Matrix(&B1, m, nrhs, rhsb1, m, SLU_DN, SLU_D, SLU_GE);

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

    printf("\nSecond system: dgssvx() returns info %d\n", info);

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

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

	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("L\\U MB %.3f\ttotal MB needed %.3f\n",
	       mem_usage.for_lu/1e6, mem_usage.total_needed/1e6);
	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 (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(&A1);
    Destroy_Dense_Matrix(&B1);
    Destroy_Dense_Matrix(&X);
    if ( lwork >= 0 ) {
        Destroy_SuperNode_Matrix(&L);
        Destroy_CompCol_Matrix(&U);
    }

#if ( DEBUGlevel>=1 )
    CHECK_MALLOC("Exit main()");
#endif
}
	static void
	Create_Dense_Matrix (SuperMatrix *p1, int p2, int p3, double *p4, int p5,
	                     Stype_t p6, Dtype_t p7, Mtype_t p8) {
		dCreate_Dense_Matrix(p1, p2, p3, p4, p5, p6, p7, p8);
	}
Beispiel #9
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);
    }
}
void tlin::createD(SuperMatrix &A, int rows, int cols)
{
	double *values = doubleMalloc(rows * cols * sizeof(double));
	dCreate_Dense_Matrix(&A, rows, cols, values, rows, SLU_DN, SLU_D, SLU_GE);
}
Beispiel #11
0
 void SuperLUSolver<double>::create_dense_matrix(SuperMatrix *X, int m, int n, SuperLuType<double>::Scalar *x,
   int ldx, Stype_t stype, Dtype_t dtype, Mtype_t mtype)
 {
   dCreate_Dense_Matrix(X, m, n, (double*)x, ldx, stype, dtype, mtype);
 }
Beispiel #12
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;
}
Beispiel #13
0
int main(int argc, char *argv[])
{
/* 
 * Purpose
 * =======
 *
 * DDRIVE is the main test program for the DOUBLE linear 
 * equation driver routines DGSSV and DGSSVX.
 * 
 * The program is invoked by a shell script file -- dtest.csh.
 * The output from the tests are written into a file -- dtest.out.
 *
 * =====================================================================
 */
    double         *a, *a_save;
    int            *asub, *asub_save;
    int            *xa, *xa_save;
    SuperMatrix  A, B, X, L, U;
    SuperMatrix  ASAV, AC;
    GlobalLU_t   Glu; /* Not needed on return. */
    mem_usage_t    mem_usage;
    int            *perm_r; /* row permutation from partial pivoting */
    int            *perm_c, *pc_save; /* column permutation */
    int            *etree;
    double  zero = 0.0;
    double         *R, *C;
    double         *ferr, *berr;
    double         *rwork;
    double	   *wwork;
    void           *work;
    int            info, lwork, nrhs, panel_size, relax;
    int            m, n, nnz;
    double         *xact;
    double         *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;
    double         *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];
    FILE           *fp;

    /* 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 dgst01(int, int, SuperMatrix *, SuperMatrix *, 
		      SuperMatrix *, int *, int *, double *);
    extern int dgst02(trans_t, int, int, int, SuperMatrix *, double *,
                      int, double *, int, double *resid);
    extern int dgst04(int, int, double *, int, 
                      double *, int, double rcond, double *resid);
    extern int dgst07(trans_t, int, int, SuperMatrix *, double *, int,
                         double *, int, double *, int, 
                         double *, double *, double *);
    extern int dlatb4_slu(char *, int *, int *, int *, char *, int *, int *, 
	               double *, int *, double *, char *);
    extern int dlatms_slu(int *, int *, char *, int *, char *, double *d,
                       int *, double *, double *, int *, int *,
                       char *, double *, int *, double *, int *);
    extern int sp_dconvert(int, int, double *, int, int, int,
	                   double *a, int *, int *, int *);


    /* Executable statements */

    strcpy(path, "DGE");
    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, &fp);
    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 = SLU_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 = doubleCalloc(lda * n);
	dallocateA(n, nnz, &a, &asub, &xa);
    } else {
	/* Read a sparse matrix */
	fimat = nimat = 0;
	dreadhb(fp, &m, &n, &nnz, &a, &asub, &xa);
    }

    dallocateA(n, nnz, &a_save, &asub_save, &xa_save);
    rhsb = doubleMalloc(m * nrhs);
    bsav = doubleMalloc(m * nrhs);
    solx = doubleMalloc(n * nrhs);
    ldb  = m;
    ldx  = n;
    dCreate_Dense_Matrix(&B, m, nrhs, rhsb, ldb, SLU_DN, SLU_D, SLU_GE);
    dCreate_Dense_Matrix(&X, n, nrhs, solx, ldx, SLU_DN, SLU_D, SLU_GE);
    xact = doubleMalloc(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   = doubleCalloc( 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 DLATB4 and generate a test matrix
	       with DLATMS.  */
	    dlatb4_slu(path, &imat, &n, &n, sym, &kl, &ku, &anorm, &mode,
		    &cndnum, dist);

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

	    if ( info ) {
		printf(FMT3, "DLATMS", 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_dconvert(n, n, Afull, lda, kl, ku, a, asub, xa, &nnz);

	} else {
	    izero = 0;
	    zerot = 0;
	}
	
	dCreate_CompCol_Matrix(&A, m, n, nnz, a, asub, xa, SLU_NC, SLU_D, SLU_GE);

	/* Save a copy of matrix A in ASAV */
	dCreate_CompCol_Matrix(&ASAV, m, n, nnz, a_save, asub_save, xa_save,
			      SLU_NC, SLU_D, SLU_GE);
	dCopy_CompCol_Matrix(&A, &ASAV);
	
	/* Form exact solution. */
	dGenXtrue(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. */
		    dCopy_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.    */
			    dgsequ(&A, R, C, &rowcnd, &colcnd, &amax, &info);

			    /* Force equilibration. */
			    if ( !info && n > 0 ) {
				if ( strncmp(equed, "R", 1)==0 ) {
				    rowcnd = 0.;
				    colcnd = 1.;
				} else if ( strncmp(equed, "C", 1)==0 ) {
				    rowcnd = 1.;
				    colcnd = 0.;
				} else if ( strncmp(equed, "B", 1)==0 ) {
				    rowcnd = 0.;
				    colcnd = 0.;
				}
			    }
			
			    /* Equilibrate the matrix. */
			    dlaqgs(&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. */
			dgstrf(&options, &AC, relax, panel_size,
                               etree, work, lwork, perm_c, perm_r, &L, &U,
                               &Glu, &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. */
			dCopy_CompCol_Matrix(&ASAV, &A);
			
 			/* Set the right hand side. */
			dFillRHS(trans, nrhs, xact, ldx, &A, &B);
			dCopy_Dense_Matrix(m, nrhs, rhsb, ldb, bsav, ldb);

			/*----------------
			 * Test dgssv
			 *----------------*/
			if ( options.Fact == DOFACT && itran == 0) {
                            /* Not yet factored, and untransposed */
	
			    dCopy_Dense_Matrix(m, nrhs, rhsb, ldb, solx, ldx);
			    dgssv(&options, &A, perm_c, perm_r, &L, &U, &X,
                                  &stat, &info);
			    
			    if ( info && info != izero ) {
                                printf(FMT3, "dgssv",
				       info, izero, n, nrhs, imat, nfail);
			    } else {
                                /* Reconstruct matrix from factors and
	                           compute residual. */
                                dgst01(m, n, &A, &L, &U, perm_c, perm_r,
                                         &result[0]);
				nt = 1;
				if ( izero == 0 ) {
				    /* Compute residual of the computed
				       solution. */
				    dCopy_Dense_Matrix(m, nrhs, rhsb, ldb,
						       wwork, ldb);
				    dgst02(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, "dgssv", 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 dgssv */
    
			/*----------------
			 * Test dgssvx
			 *----------------*/
    
			/* Equilibrate the matrix if fact = FACTORED and
			   equed = 'R', 'C', or 'B'.   */
			if ( options.Fact == FACTORED &&
			     (equil || iequed) && n > 0 ) {
			    dlaqgs(&A, R, C, rowcnd, colcnd, amax, equed);
			}
			
			/* Solve the system and compute the condition number
			   and error bounds using dgssvx.      */
			dgssvx(&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);

			if ( info && info != izero ) {
			    printf(FMT3, "dgssvx",
				   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. */
                                dgst01(m, n, &A, &L, &U, perm_c, perm_r,
                                         &result[0]);
				k1 = 0;
			    } else {
			   	k1 = 1;
			    }

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

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

				/* Check the error bounds from iterative
				   refinement. */
				dgst07(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, "dgssvx",
					       options.Fact, trans, *equed,
					       n, imat, i, result[i]);
					++nfail;
				    }
				}
				nrun += NTESTS;
			    } /* if .. info == 0 */
			} /* else .. end of testing dgssvx */

		    } /* 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
        Destroy_SuperMatrix_Store(&A);
        Destroy_SuperMatrix_Store(&ASAV);
        StatFree(&stat);

    } /* for imat ... */

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

    if ( strcmp(matrix_type, "LA") == 0 ) SUPERLU_FREE (Afull);
    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);
#if 0
    Destroy_CompCol_Matrix(&A);
    Destroy_CompCol_Matrix(&ASAV);
#else
    SUPERLU_FREE(a); SUPERLU_FREE(asub); SUPERLU_FREE(xa);
    SUPERLU_FREE(a_save); SUPERLU_FREE(asub_save); SUPERLU_FREE(xa_save);
#endif
    if ( lwork > 0 ) {
	SUPERLU_FREE (work);
	Destroy_SuperMatrix_Store(&L);
	Destroy_SuperMatrix_Store(&U);
    }

    return 0;
}
Beispiel #14
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;
}
Beispiel #15
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 ;
}
Beispiel #16
0
main(int argc, char *argv[])
{
    SuperMatrix A;
    NCformat *Astore;
    double   *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;
    double   *xact, *rhs;
    mem_usage_t   mem_usage;
    superlu_options_t options;
    SuperLUStat_t stat;

#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;

#if 1
    /* 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;
        }
    }
#else
    /* Read the matrix in Harwell-Boeing format. */
    dreadhb(&m, &n, &nnz, &a, &asub, &xa);
#endif

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

    nrhs   = 1;
    if ( !(rhs = doubleMalloc(m * nrhs)) ) ABORT("Malloc fails for rhs[].");
    dCreate_Dense_Matrix(&B, m, nrhs, rhs, m, SLU_DN, SLU_D, SLU_GE);
    xact = doubleMalloc(n * nrhs);
    ldx = n;
    dGenXtrue(n, nrhs, xact, ldx);
    dFillRHS(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);

    dgssv(&options, &A, perm_c, perm_r, &L, &U, &B, &stat, &info);

    if ( info == 0 ) {

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

         /* Compute the infinity norm of the error. */
        dinf_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);

        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("dgssv() 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);
        }
    }

    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
}
Beispiel #17
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;
}
void tlin::createD(SuperMatrix &A, int rows, int cols, int lda, double *values)
{
	dCreate_Dense_Matrix(&A, rows, cols, values, lda, SLU_DN, SLU_D, SLU_GE);
}
Beispiel #19
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;
}
void tlin::allocD(SuperMatrix *&A, int rows, int cols, int lda, double *values)
{
	A = (SuperMatrix *)SUPERLU_MALLOC(sizeof(SuperMatrix));
	dCreate_Dense_Matrix(A, rows, cols, values, lda, SLU_DN, SLU_D, SLU_GE);
}
Beispiel #21
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);
}
Beispiel #22
0
    bool SuperLUSolver::Solve(SparseMatrixType& rA, VectorType& rX, VectorType& rB)
    {
        //std::cout << "matrix size in solver:  " << rA.size1() << std::endl;
        //std::cout << "RHS size in solver SLU: " << rB.size() << std::endl;

//               typedef ublas::compressed_matrix<double, ublas::row_major, 0,
//                 ublas::unbounded_array<int>, ublas::unbounded_array<double> > cm_t;

	    //make a copy of the RHS
	    VectorType rC = rB;

        superlu_options_t options;
        SuperLUStat_t stat;

        /* 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);
        options.IterRefine = SLU_DOUBLE;
// 		options.ColPerm = MMD_AT_PLUS_A;

        //Fill the SuperLU matrices
        SuperMatrix Aslu, B, L, U;

        //create a copy of the matrix
        int *index1_vector = new (std::nothrow) int[rA.index1_data().size()];
        int *index2_vector = new (std::nothrow) int[rA.index2_data().size()];
// 		double *values_vector = new (std::nothrow) double[rA.value_data().size()];

        for( int unsigned i = 0; i < rA.index1_data().size(); i++ )
            index1_vector[i] = (int)rA.index1_data()[i];

        for( unsigned int i = 0; i < rA.index2_data().size(); i++ )
            index2_vector[i] = (int)rA.index2_data()[i];

        /*		for( unsigned int i = 0; i < rA.value_data().size(); i++ )
        		    values_vector[i] = (double)rA.value_data()[i];*/

        //create a copy of the rhs vector (it will be overwritten with the solution)
        /*		double *b_vector = new (std::nothrow) double[rB.size()];
        		for( unsigned int i = 0; i < rB.size(); i++ )
        		    b_vector[i] = rB[i];*/
        /*
        		dCreate_CompCol_Matrix (&Aslu, rA.size1(), rA.size2(),
        					       rA.nnz(),
        					      values_vector,
        					      index2_vector,
         					      index1_vector,
        					      SLU_NR, SLU_D, SLU_GE
        					      );*/

        //works also with dCreate_CompCol_Matrix
        dCreate_CompRow_Matrix (&Aslu, rA.size1(), rA.size2(),
                                rA.nnz(),
                                rA.value_data().begin(),
                                index2_vector, //can not avoid a copy as ublas uses unsigned int internally
                                index1_vector, //can not avoid a copy as ublas uses unsigned int internally
                                SLU_NR, SLU_D, SLU_GE
                               );

        dCreate_Dense_Matrix (&B, rB.size(), 1,&rB[0],rB.size(),SLU_DN, SLU_D, SLU_GE);

        //allocate memory for permutation arrays
        int* perm_c;
        int* perm_r;
        if ( !(perm_c = intMalloc(rA.size1())) ) ABORT("Malloc fails for perm_c[].");
        if ( !(perm_r = intMalloc(rA.size2())) ) ABORT("Malloc fails for perm_r[].");


        //initialize container for statistical data
        StatInit(&stat);

        //call solver routine
        int info;
        dgssv(&options, &Aslu, perm_c, perm_r, &L, &U, &B, &stat, &info);

        //print output
        if (options.PrintStat) {
        StatPrint(&stat);
        }

        //resubstitution of results
        #pragma omp parallel for
        for(int i=0; i<static_cast<int>(rB.size()); i++ )
            rX[i] = rB[i]; // B(i,0);

	    //recover the RHS
	    rB=rC;

        //deallocate memory used
        StatFree(&stat);
        SUPERLU_FREE (perm_r);
        SUPERLU_FREE (perm_c);
        Destroy_SuperMatrix_Store(&Aslu); //note that by using the "store" function we will take care of deallocation ourselves
        Destroy_SuperMatrix_Store(&B);
        Destroy_SuperNode_Matrix(&L);
        Destroy_CompCol_Matrix(&U);

        delete [] index1_vector;
        delete [] index2_vector;
// 		delete [] b_vector;

        //CHECK WITH VALGRIND IF THIS IS NEEDED ...or if it is done by the lines above
        //deallocate tempory storage used for the matrix
//                 if(b_vector!=NULL) delete [] index1_vector;
// //   		if(b_vector!=NULL) delete [] index2_vector;
//   		if(b_vector!=NULL) delete [] values_vector;
// 		if(b_vector!=NULL) delete [] b_vector;

        return true;
    }
Beispiel #23
0
EXTERN_C_END
  

/*MC
  MATSOLVERSUPERLU = "superlu" - A solver package providing solvers LU and ILU for sequential matrices 
  via the external package SuperLU.

  Use ./configure --download-superlu to have PETSc installed with SuperLU

  Options Database Keys:
+ -mat_superlu_equil <FALSE>            - Equil (None)
. -mat_superlu_colperm <COLAMD>         - (choose one of) NATURAL MMD_ATA MMD_AT_PLUS_A COLAMD
. -mat_superlu_iterrefine <NOREFINE>    - (choose one of) NOREFINE SINGLE DOUBLE EXTRA
. -mat_superlu_symmetricmode: <FALSE>   - SymmetricMode (None)
. -mat_superlu_diagpivotthresh <1>      - DiagPivotThresh (None)
. -mat_superlu_pivotgrowth <FALSE>      - PivotGrowth (None)
. -mat_superlu_conditionnumber <FALSE>  - ConditionNumber (None)
. -mat_superlu_rowperm <NOROWPERM>      - (choose one of) NOROWPERM LargeDiag
. -mat_superlu_replacetinypivot <FALSE> - ReplaceTinyPivot (None)
. -mat_superlu_printstat <FALSE>        - PrintStat (None)
. -mat_superlu_lwork <0>                - size of work array in bytes used by factorization (None)
. -mat_superlu_ilu_droptol <0>          - ILU_DropTol (None)
. -mat_superlu_ilu_filltol <0>          - ILU_FillTol (None)
. -mat_superlu_ilu_fillfactor <0>       - ILU_FillFactor (None)
. -mat_superlu_ilu_droprull <0>         - ILU_DropRule (None)
. -mat_superlu_ilu_norm <0>             - ILU_Norm (None)
- -mat_superlu_ilu_milu <0>             - ILU_MILU (None)

   Notes: Do not confuse this with MATSOLVERSUPERLU_DIST which is for parallel sparse solves

   Level: beginner

.seealso: PCLU, PCILU, MATSOLVERSUPERLU_DIST, MATSOLVERMUMPS, MATSOLVERSPOOLES, PCFactorSetMatSolverPackage(), MatSolverPackage
M*/

EXTERN_C_BEGIN
#undef __FUNCT__  
#define __FUNCT__ "MatGetFactor_seqaij_superlu"
PetscErrorCode MatGetFactor_seqaij_superlu(Mat A,MatFactorType ftype,Mat *F)
{
  Mat            B;
  Mat_SuperLU    *lu;
  PetscErrorCode ierr;
  PetscInt       indx,m=A->rmap->n,n=A->cmap->n;  
  PetscBool      flg;
  const char     *colperm[]={"NATURAL","MMD_ATA","MMD_AT_PLUS_A","COLAMD"}; /* MY_PERMC - not supported by the petsc interface yet */
  const char     *iterrefine[]={"NOREFINE", "SINGLE", "DOUBLE", "EXTRA"};
  const char     *rowperm[]={"NOROWPERM", "LargeDiag"}; /* MY_PERMC - not supported by the petsc interface yet */

  PetscFunctionBegin;
  ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr);
  ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,PETSC_DETERMINE,PETSC_DETERMINE);CHKERRQ(ierr);
  ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr);
  ierr = MatSeqAIJSetPreallocation(B,0,PETSC_NULL);CHKERRQ(ierr);

  if (ftype == MAT_FACTOR_LU || ftype == MAT_FACTOR_ILU){
    B->ops->lufactorsymbolic  = MatLUFactorSymbolic_SuperLU;
    B->ops->ilufactorsymbolic = MatLUFactorSymbolic_SuperLU; 
  } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Factor type not supported");

  B->ops->destroy          = MatDestroy_SuperLU;
  B->ops->view             = MatView_SuperLU;
  B->factortype            = ftype; 
  B->assembled             = PETSC_TRUE;  /* required by -ksp_view */
  B->preallocated          = PETSC_TRUE;
  
  ierr = PetscNewLog(B,Mat_SuperLU,&lu);CHKERRQ(ierr);
  
  if (ftype == MAT_FACTOR_LU){
    set_default_options(&lu->options);
    /* Comments from SuperLU_4.0/SRC/dgssvx.c:
      "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 options->Trans=NOTRANS) or diag(C)*B (if options->Trans = TRANS or CONJ)."
     We set 'options.Equil = NO' as default because additional space is needed for it.
    */
    lu->options.Equil = NO;
  } else if (ftype == MAT_FACTOR_ILU){
    /* Set the default input options of ilu: */
    ilu_set_default_options(&lu->options);
  }
  lu->options.PrintStat = NO;
  
  /* Initialize the statistics variables. */
  StatInit(&lu->stat);
  lu->lwork = 0;   /* allocate space internally by system malloc */

  ierr = PetscOptionsBegin(((PetscObject)A)->comm,((PetscObject)A)->prefix,"SuperLU Options","Mat");CHKERRQ(ierr);
    ierr = PetscOptionsBool("-mat_superlu_equil","Equil","None",(PetscBool)lu->options.Equil,(PetscBool*)&lu->options.Equil,0);CHKERRQ(ierr);
    ierr = PetscOptionsEList("-mat_superlu_colperm","ColPerm","None",colperm,4,colperm[3],&indx,&flg);CHKERRQ(ierr);
    if (flg) {lu->options.ColPerm = (colperm_t)indx;}
    ierr = PetscOptionsEList("-mat_superlu_iterrefine","IterRefine","None",iterrefine,4,iterrefine[0],&indx,&flg);CHKERRQ(ierr);
    if (flg) { lu->options.IterRefine = (IterRefine_t)indx;}
    ierr = PetscOptionsBool("-mat_superlu_symmetricmode","SymmetricMode","None",(PetscBool)lu->options.SymmetricMode,&flg,0);CHKERRQ(ierr);
    if (flg) lu->options.SymmetricMode = YES; 
    ierr = PetscOptionsReal("-mat_superlu_diagpivotthresh","DiagPivotThresh","None",lu->options.DiagPivotThresh,&lu->options.DiagPivotThresh,PETSC_NULL);CHKERRQ(ierr);
    ierr = PetscOptionsBool("-mat_superlu_pivotgrowth","PivotGrowth","None",(PetscBool)lu->options.PivotGrowth,&flg,0);CHKERRQ(ierr);
    if (flg) lu->options.PivotGrowth = YES;
    ierr = PetscOptionsBool("-mat_superlu_conditionnumber","ConditionNumber","None",(PetscBool)lu->options.ConditionNumber,&flg,0);CHKERRQ(ierr);
    if (flg) lu->options.ConditionNumber = YES;
    ierr = PetscOptionsEList("-mat_superlu_rowperm","rowperm","None",rowperm,2,rowperm[lu->options.RowPerm],&indx,&flg);CHKERRQ(ierr);
    if (flg) {lu->options.RowPerm = (rowperm_t)indx;}
    ierr = PetscOptionsBool("-mat_superlu_replacetinypivot","ReplaceTinyPivot","None",(PetscBool)lu->options.ReplaceTinyPivot,&flg,0);CHKERRQ(ierr);
    if (flg) lu->options.ReplaceTinyPivot = YES; 
    ierr = PetscOptionsBool("-mat_superlu_printstat","PrintStat","None",(PetscBool)lu->options.PrintStat,&flg,0);CHKERRQ(ierr);
    if (flg) lu->options.PrintStat = YES; 
    ierr = PetscOptionsInt("-mat_superlu_lwork","size of work array in bytes used by factorization","None",lu->lwork,&lu->lwork,PETSC_NULL);CHKERRQ(ierr); 
    if (lu->lwork > 0 ){
      ierr = PetscMalloc(lu->lwork,&lu->work);CHKERRQ(ierr); 
    } else if (lu->lwork != 0 && lu->lwork != -1){
      ierr = PetscPrintf(PETSC_COMM_SELF,"   Warning: lwork %D is not supported by SUPERLU. The default lwork=0 is used.\n",lu->lwork);
      lu->lwork = 0;
    }
    /* ilu options */
    ierr = PetscOptionsReal("-mat_superlu_ilu_droptol","ILU_DropTol","None",lu->options.ILU_DropTol,&lu->options.ILU_DropTol,PETSC_NULL);CHKERRQ(ierr);
    ierr = PetscOptionsReal("-mat_superlu_ilu_filltol","ILU_FillTol","None",lu->options.ILU_FillTol,&lu->options.ILU_FillTol,PETSC_NULL);CHKERRQ(ierr);
    ierr = PetscOptionsReal("-mat_superlu_ilu_fillfactor","ILU_FillFactor","None",lu->options.ILU_FillFactor,&lu->options.ILU_FillFactor,PETSC_NULL);CHKERRQ(ierr);
    ierr = PetscOptionsInt("-mat_superlu_ilu_droprull","ILU_DropRule","None",lu->options.ILU_DropRule,&lu->options.ILU_DropRule,PETSC_NULL);CHKERRQ(ierr);
    ierr = PetscOptionsInt("-mat_superlu_ilu_norm","ILU_Norm","None",lu->options.ILU_Norm,&indx,&flg);CHKERRQ(ierr);
    if (flg){
      lu->options.ILU_Norm = (norm_t)indx;
    }
    ierr = PetscOptionsInt("-mat_superlu_ilu_milu","ILU_MILU","None",lu->options.ILU_MILU,&indx,&flg);CHKERRQ(ierr);
    if (flg){
      lu->options.ILU_MILU = (milu_t)indx;
    }
  PetscOptionsEnd();
  if (lu->options.Equil == YES) {
    /* superlu overwrites input matrix and rhs when Equil is used, thus create A_dup to keep user's A unchanged */
    ierr = MatDuplicate_SeqAIJ(A,MAT_COPY_VALUES,&lu->A_dup);CHKERRQ(ierr); 
  }

  /* Allocate spaces (notice sizes are for the transpose) */
  ierr = PetscMalloc(m*sizeof(PetscInt),&lu->etree);CHKERRQ(ierr);
  ierr = PetscMalloc(n*sizeof(PetscInt),&lu->perm_r);CHKERRQ(ierr);
  ierr = PetscMalloc(m*sizeof(PetscInt),&lu->perm_c);CHKERRQ(ierr);
  ierr = PetscMalloc(n*sizeof(PetscScalar),&lu->R);CHKERRQ(ierr);
  ierr = PetscMalloc(m*sizeof(PetscScalar),&lu->C);CHKERRQ(ierr);
 
  /* create rhs and solution x without allocate space for .Store */
#if defined(PETSC_USE_COMPLEX)
  zCreate_Dense_Matrix(&lu->B, m, 1, PETSC_NULL, m, SLU_DN, SLU_Z, SLU_GE);
  zCreate_Dense_Matrix(&lu->X, m, 1, PETSC_NULL, m, SLU_DN, SLU_Z, SLU_GE);
#else
  dCreate_Dense_Matrix(&lu->B, m, 1, PETSC_NULL, m, SLU_DN, SLU_D, SLU_GE);
  dCreate_Dense_Matrix(&lu->X, m, 1, PETSC_NULL, m, SLU_DN, SLU_D, SLU_GE);
#endif

#ifdef SUPERLU2
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatCreateNull","MatCreateNull_SuperLU",(void(*)(void))MatCreateNull_SuperLU);CHKERRQ(ierr);
#endif
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatFactorGetSolverPackage_C","MatFactorGetSolverPackage_seqaij_superlu",MatFactorGetSolverPackage_seqaij_superlu);CHKERRQ(ierr);
  ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSuperluSetILUDropTol_C","MatSuperluSetILUDropTol_SuperLU",MatSuperluSetILUDropTol_SuperLU);CHKERRQ(ierr);
  B->spptr = lu;
  *F = B;
  PetscFunctionReturn(0);
}