xref: /petsc/src/mat/impls/aij/seq/superlu/superlu.c (revision 75af56d4b99cf21fbbeb8b3a463108682dd46af8)
1 /*$Id: superlu.c,v 1.10 2001/08/15 15:56:50 bsmith Exp $*/
2 
3 /*
4         Provides an interface to the SuperLU 3.0 sparse solver
5 */
6 
7 #include "src/mat/impls/aij/seq/aij.h"
8 
9 EXTERN_C_BEGIN
10 #if defined(PETSC_USE_COMPLEX)
11 #include "zsp_defs.h"
12 #else
13 #include "dsp_defs.h"
14 #endif
15 #include "util.h"
16 EXTERN_C_END
17 
18 typedef struct {
19   SuperMatrix       A,L,U,B,X;
20   superlu_options_t options;
21   int               *perm_c; /* column permutation vector */
22   int               *perm_r; /* row permutations from partial pivoting */
23   int               *etree;
24   double            *R, *C;
25   char              equed[1];
26   int               lwork;
27   void              *work;
28   double            rpg, rcond;
29   mem_usage_t       mem_usage;
30   MatStructure      flg;
31   /*
32   SuperMatrix  A,B,AC,L,U;
33   int          *perm_r,*perm_c,ispec,relax,panel_size;
34   double       pivot_threshold;
35   NCformat     *store;
36   MatStructure flg;
37   PetscTruth   SuperluMatOdering;
38   */
39 
40   /* A few function pointers for inheritance */
41   int (*MatDuplicate)(Mat,MatDuplicateOption,Mat*);
42   int (*MatView)(Mat,PetscViewer);
43   int (*MatAssemblyEnd)(Mat,MatAssemblyType);
44   int (*MatLUFactorSymbolic)(Mat,IS,IS,MatFactorInfo*,Mat*);
45   int (*MatDestroy)(Mat);
46 
47   /* Flag to clean up (non-global) SuperLU objects during Destroy */
48   PetscTruth CleanUpSuperLU;
49 } Mat_SuperLU;
50 
51 
52 EXTERN int MatFactorInfo_SuperLU(Mat,PetscViewer);
53 EXTERN int MatLUFactorSymbolic_SuperLU(Mat,IS,IS,MatFactorInfo*,Mat*);
54 
55 EXTERN_C_BEGIN
56 EXTERN int MatConvert_SuperLU_SeqAIJ(Mat,MatType,Mat*);
57 EXTERN int MatConvert_SeqAIJ_SuperLU(Mat,MatType,Mat*);
58 EXTERN_C_END
59 
60 #undef __FUNCT__
61 #define __FUNCT__ "MatDestroy_SuperLU"
62 int MatDestroy_SuperLU(Mat A)
63 {
64   int         ierr;
65   Mat_SuperLU *lu = (Mat_SuperLU*)A->spptr;
66 
67   PetscFunctionBegin;
68   if (lu->CleanUpSuperLU) { /* Free the SuperLU datastructures */
69     /* Destroy_CompCol_Matrix(&lu->A);  */  /* hangs inside memory.c! */
70     Destroy_SuperMatrix_Store(&lu->A);
71     Destroy_SuperMatrix_Store(&lu->B);
72     Destroy_SuperMatrix_Store(&lu->X);
73     SUPERLU_FREE (lu->etree);
74     SUPERLU_FREE (lu->perm_r);
75     SUPERLU_FREE (lu->perm_c);
76     SUPERLU_FREE (lu->R);
77     SUPERLU_FREE (lu->C);
78     if ( lu->lwork >= 0 ) {
79       Destroy_SuperNode_Matrix(&lu->L);
80       Destroy_CompCol_Matrix(&lu->U);
81     }
82   }
83   ierr = MatConvert_SuperLU_SeqAIJ(A,MATSEQAIJ,&A);CHKERRQ(ierr);
84   ierr = (*A->ops->destroy)(A);CHKERRQ(ierr);
85   PetscFunctionReturn(0);
86 }
87 
88 #undef __FUNCT__
89 #define __FUNCT__ "MatView_SuperLU"
90 int MatView_SuperLU(Mat A,PetscViewer viewer)
91 {
92   int               ierr;
93   PetscTruth        isascii;
94   PetscViewerFormat format;
95   Mat_SuperLU       *lu=(Mat_SuperLU*)(A->spptr);
96 
97   PetscFunctionBegin;
98   ierr = (*lu->MatView)(A,viewer);CHKERRQ(ierr);
99 
100   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
101   if (isascii) {
102     ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
103     if (format == PETSC_VIEWER_ASCII_FACTOR_INFO) {
104       ierr = MatFactorInfo_SuperLU(A,viewer);CHKERRQ(ierr);
105     }
106   }
107   PetscFunctionReturn(0);
108 }
109 
110 #undef __FUNCT__
111 #define __FUNCT__ "MatAssemblyEnd_SuperLU"
112 int MatAssemblyEnd_SuperLU(Mat A,MatAssemblyType mode) {
113   int         ierr;
114   Mat_SuperLU *lu=(Mat_SuperLU*)(A->spptr);
115 
116   PetscFunctionBegin;
117   ierr = (*lu->MatAssemblyEnd)(A,mode);CHKERRQ(ierr);
118 
119   lu->MatLUFactorSymbolic  = A->ops->lufactorsymbolic;
120   A->ops->lufactorsymbolic = MatLUFactorSymbolic_SuperLU;
121   PetscFunctionReturn(0);
122 }
123 
124 /* This function was written for SuperLU 2.0 by Matthew Knepley. Not tested for SuperLU 3.0! */
125 #ifdef SuperLU2
126 #include "src/mat/impls/dense/seq/dense.h"
127 #undef __FUNCT__
128 #define __FUNCT__ "MatCreateNull_SuperLU"
129 int MatCreateNull_SuperLU(Mat A,Mat *nullMat)
130 {
131   Mat_SuperLU   *lu = (Mat_SuperLU*)A->spptr;
132   int           numRows = A->m,numCols = A->n;
133   SCformat      *Lstore;
134   int           numNullCols,size;
135   SuperLUStat_t stat;
136 #if defined(PETSC_USE_COMPLEX)
137   doublecomplex *nullVals,*workVals;
138 #else
139   PetscScalar   *nullVals,*workVals;
140 #endif
141   int           row,newRow,col,newCol,block,b,ierr;
142 
143   PetscFunctionBegin;
144   PetscValidHeaderSpecific(A,MAT_COOKIE);
145   PetscValidPointer(nullMat);
146   if (!A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Unfactored matrix");
147   numNullCols = numCols - numRows;
148   if (numNullCols < 0) SETERRQ(PETSC_ERR_ARG_WRONG,"Function only applies to underdetermined problems");
149   /* Create the null matrix */
150   ierr = MatCreateSeqDense(A->comm,numRows,numNullCols,PETSC_NULL,nullMat);CHKERRQ(ierr);
151   if (numNullCols == 0) {
152     ierr = MatAssemblyBegin(*nullMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
153     ierr = MatAssemblyEnd(*nullMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
154     PetscFunctionReturn(0);
155   }
156 #if defined(PETSC_USE_COMPLEX)
157   nullVals = (doublecomplex*)((Mat_SeqDense*)(*nullMat)->data)->v;
158 #else
159   nullVals = ((Mat_SeqDense*)(*nullMat)->data)->v;
160 #endif
161   /* Copy in the columns */
162   Lstore = (SCformat*)lu->L.Store;
163   for(block = 0; block <= Lstore->nsuper; block++) {
164     newRow = Lstore->sup_to_col[block];
165     size   = Lstore->sup_to_col[block+1] - Lstore->sup_to_col[block];
166     for(col = Lstore->rowind_colptr[newRow]; col < Lstore->rowind_colptr[newRow+1]; col++) {
167       newCol = Lstore->rowind[col];
168       if (newCol >= numRows) {
169         for(b = 0; b < size; b++)
170 #if defined(PETSC_USE_COMPLEX)
171           nullVals[(newCol-numRows)*numRows+newRow+b] = ((doublecomplex*)Lstore->nzval)[Lstore->nzval_colptr[newRow+b]+col];
172 #else
173           nullVals[(newCol-numRows)*numRows+newRow+b] = ((double*)Lstore->nzval)[Lstore->nzval_colptr[newRow+b]+col];
174 #endif
175       }
176     }
177   }
178   /* Permute rhs to form P^T_c B */
179   ierr = PetscMalloc(numRows*sizeof(double),&workVals);CHKERRQ(ierr);
180   for(b = 0; b < numNullCols; b++) {
181     for(row = 0; row < numRows; row++) workVals[lu->perm_c[row]] = nullVals[b*numRows+row];
182     for(row = 0; row < numRows; row++) nullVals[b*numRows+row]   = workVals[row];
183   }
184   /* Backward solve the upper triangle A x = b */
185   for(b = 0; b < numNullCols; b++) {
186 #if defined(PETSC_USE_COMPLEX)
187     sp_ztrsv("L","T","U",&lu->L,&lu->U,&nullVals[b*numRows],&stat,&ierr);
188 #else
189     sp_dtrsv("L","T","U",&lu->L,&lu->U,&nullVals[b*numRows],&stat,&ierr);
190 #endif
191     if (ierr < 0)
192       SETERRQ1(PETSC_ERR_ARG_WRONG,"The argument %d was invalid",-ierr);
193   }
194   ierr = PetscFree(workVals);CHKERRQ(ierr);
195 
196   ierr = MatAssemblyBegin(*nullMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
197   ierr = MatAssemblyEnd(*nullMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
198   PetscFunctionReturn(0);
199 }
200 #endif
201 
202 #undef __FUNCT__
203 #define __FUNCT__ "MatSolve_SuperLU"
204 int MatSolve_SuperLU(Mat A,Vec b,Vec x)
205 {
206   Mat_SuperLU   *lu = (Mat_SuperLU*)A->spptr;
207   PetscScalar   *barray,*xarray;
208   int           m,n,ierr,lwork,info,i;
209   SuperLUStat_t stat;
210   double        ferr,berr,*rhsb,*rhsx;
211 
212   PetscFunctionBegin;
213   /* rhs vector */
214   lu->B.ncol = 1;   /* Set the number of right-hand side */
215   ierr = VecGetArray(b,&barray);CHKERRQ(ierr);
216   ((DNformat*)lu->B.Store)->nzval = barray;
217 
218   /* solution vector */
219   ierr = VecGetArray(x,&xarray);CHKERRQ(ierr);
220   ((DNformat*)lu->X.Store)->nzval = xarray;
221 
222   /* Initialize the statistics variables. */
223   StatInit(&stat);
224 
225   lu->options.Fact  = FACTORED; /* Indicate the factored form of A is supplied. */
226   lu->options.Trans = TRANS;
227   dgssvx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
228            &lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond, &ferr, &berr,
229            &lu->mem_usage, &stat, &info);
230 
231   ierr = VecRestoreArray(b,&barray);CHKERRQ(ierr);
232   ierr = VecRestoreArray(x,&xarray);CHKERRQ(ierr);
233 
234   if ( info == 0 || info == lu->A.ncol+1 ) {
235     if ( lu->options.IterRefine ) {
236       printf("Iterative Refinement:\n");
237       printf("%8s%8s%16s%16s\n", "rhs", "Steps", "FERR", "BERR");
238       for (i = 0; i < 1; ++i)
239         printf("%8d%8d%16e%16e\n", i+1, stat.RefineSteps, ferr, berr);
240     }
241     fflush(stdout);
242   } else if ( info > 0 && lu->lwork == -1 ) {
243     printf("** Estimated memory: %d bytes\n", info - n);
244   }
245 
246   if ( lu->options.PrintStat ) StatPrint(&stat);
247   StatFree(&stat);
248   PetscFunctionReturn(0);
249 }
250 
251 #undef __FUNCT__
252 #define __FUNCT__ "MatLUFactorNumeric_SuperLU"
253 int MatLUFactorNumeric_SuperLU(Mat A,Mat *F)
254 {
255   Mat_SeqAIJ    *aa = (Mat_SeqAIJ*)(A)->data;
256   Mat_SuperLU   *lu = (Mat_SuperLU*)(*F)->spptr;
257   int           ierr,info;
258   PetscTruth    flag;
259   SuperLUStat_t stat;
260   double        ferr, berr;
261 
262   PetscFunctionBegin;
263   if (lu->flg == DIFFERENT_NONZERO_PATTERN){ /* first numeric factorization */
264     /* Set SuperLU options */
265     /* the default values for options argument:
266 	options.Fact = DOFACT;
267         options.Equil = YES;
268     	options.ColPerm = COLAMD;
269 	options.DiagPivotThresh = 1.0;
270     	options.Trans = NOTRANS;
271     	options.IterRefine = NOREFINE;
272     	options.SymmetricMode = NO;
273     	options.PivotGrowth = NO;
274     	options.ConditionNumber = NO;
275     	options.PrintStat = YES;
276     */
277     set_default_options(&lu->options);
278     lu->options.Equil = NO;  /* equilibration causes error in solve */
279   } else { /* successing numerical factorization */
280     /* Ref: ~SuperLU_3.0/EXAMPLE/dlinsolx2.c */
281     Destroy_SuperMatrix_Store(&lu->A);
282     if ( lu->lwork >= 0 ) { /* Deallocate storage associated with L and U. */
283       Destroy_SuperNode_Matrix(&lu->L);
284       Destroy_CompCol_Matrix(&lu->U);
285       lu->options.Fact = SamePattern;
286     }
287   }
288 
289   /* Create the SuperMatrix for lu->A=A^T:
290        Since SuperLU likes column-oriented matrices,we pass it the transpose,
291        and then solve A^T X = B in MatSolve(). */
292 #if defined(PETSC_USE_COMPLEX)
293   zCreate_CompCol_Matrix(&lu->A,A->n,A->m,aa->nz,aa->a,aa->j,aa->i,
294                            SLU_NC,SLU_Z,SLU_GE);
295 #else
296   dCreate_CompCol_Matrix(&lu->A,A->n,A->m,aa->nz,aa->a,aa->j,aa->i,
297                            SLU_NC,SLU_D,SLU_GE);
298 #endif
299 
300   /* Initialize the statistics variables. */
301   StatInit(&stat);
302 
303   lu->lwork = 0;   /* allocate space internally by system malloc */
304   lu->B.ncol = 0;  /* Indicate not to solve the system */
305   dgssvx(&lu->options, &lu->A, lu->perm_c, lu->perm_r, lu->etree, lu->equed, lu->R, lu->C,
306            &lu->L, &lu->U, lu->work, lu->lwork, &lu->B, &lu->X, &lu->rpg, &lu->rcond, &ferr, &berr,
307            &lu->mem_usage, &stat, &info);
308 
309   if ( info == 0 || info == lu->A.ncol+1 ) {
310     if ( lu->options.PivotGrowth ) printf("Recip. pivot growth = %e\n", lu->rpg);
311     if ( lu->options.ConditionNumber )
312       printf("Recip. condition number = %e\n", lu->rcond);
313         /*
314           NCformat       *Ustore;
315           SCformat       *Lstore;
316         Lstore = (SCformat *) lu->L.Store;
317         Ustore = (NCformat *) lu->U.Store;
318 	printf("No of nonzeros in factor L = %d\n", Lstore->nnz);
319     	printf("No of nonzeros in factor U = %d\n", Ustore->nnz);
320     	printf("No of nonzeros in L+U = %d\n", Lstore->nnz + Ustore->nnz - n);
321 	printf("L\\U MB %.3f\ttotal MB needed %.3f\texpansions %d\n",
322 	       mem_usage.for_lu/1e6, mem_usage.total_needed/1e6,
323 	       mem_usage.expansions);
324         */
325     fflush(stdout);
326 
327   } else if ( info > 0 && lu->lwork == -1 ) {
328     printf("** Estimated memory: %d bytes\n", info - lu->A.ncol);
329   }
330 
331   if ( lu->options.PrintStat ) StatPrint(&stat);
332   StatFree(&stat);
333 
334   lu->flg = SAME_NONZERO_PATTERN;
335   PetscFunctionReturn(0);
336 
337 #ifdef OLD
338   /* Set SuperLU options */
339   lu->relax      = sp_ienv(2);
340   lu->panel_size = sp_ienv(1);
341   /* We have to initialize global data or SuperLU crashes (sucky design) */
342   if (!StatInitCalled) {
343     StatInit(lu->panel_size,lu->relax);
344   }
345   StatInitCalled++;
346 
347   ierr = PetscOptionsBegin(A->comm,A->prefix,"SuperLU Options","Mat");CHKERRQ(ierr);
348   /* use SuperLU mat ordeing */
349   ierr = PetscOptionsInt("-mat_superlu_ordering","SuperLU ordering type (one of 0, 1, 2, 3)\n   0: natural ordering;\n   1: MMD applied to A'*A;\n   2: MMD applied to A'+A;\n   3: COLAMD, approximate minimum degree column ordering","None",lu->ispec,&lu->ispec,&flag);CHKERRQ(ierr);
350   if (flag) {
351     get_perm_c(lu->ispec, &lu->A, lu->perm_c);
352     lu->SuperluMatOdering = PETSC_TRUE;
353   }
354   PetscOptionsEnd();
355 
356   /* Create the elimination tree */
357   ierr = PetscMalloc(A->n*sizeof(int),&etree);CHKERRQ(ierr);
358   sp_preorder("N",&lu->A,lu->perm_c,etree,&lu->AC);
359   /* Factor the matrix */
360 #if defined(PETSC_USE_COMPLEX)
361   zgstrf("N",&lu->AC,lu->pivot_threshold,0.0,lu->relax,lu->panel_size,etree,PETSC_NULL,0,lu->perm_r,lu->perm_c,&lu->L,&lu->U,&ierr);
362 #else
363   dgstrf("N",&lu->AC,lu->pivot_threshold,0.0,lu->relax,lu->panel_size,etree,PETSC_NULL,0,lu->perm_r,lu->perm_c,&lu->L,&lu->U,&ierr);
364 #endif
365   if (ierr < 0) {
366     SETERRQ1(PETSC_ERR_ARG_WRONG,"The diagonal element of row %d was invalid",-ierr);
367   } else if (ierr > 0) {
368     if (ierr <= A->m) {
369       SETERRQ1(PETSC_ERR_ARG_WRONG,"The diagonal element %d of U is exactly zero",ierr);
370     } else {
371       SETERRQ1(PETSC_ERR_ARG_WRONG,"Memory allocation failure after %d bytes were allocated",ierr-A->m);
372     }
373   }
374 
375   /* Cleanup */
376   ierr = PetscFree(etree);CHKERRQ(ierr);
377 #endif /* OLD */
378 
379 
380 }
381 
382 /*
383    Note the r permutation is ignored
384 */
385 #undef __FUNCT__
386 #define __FUNCT__ "MatLUFactorSymbolic_SuperLU"
387 int MatLUFactorSymbolic_SuperLU(Mat A,IS r,IS c,MatFactorInfo *info,Mat *F)
388 {
389   Mat          B;
390   Mat_SuperLU  *lu;
391   int          ierr,m=A->m,n=A->n;     /* *ca; */
392 
393   PetscFunctionBegin;
394 
395   ierr = MatCreate(A->comm,A->m,A->n,PETSC_DETERMINE,PETSC_DETERMINE,&B);CHKERRQ(ierr);
396   ierr = MatSetType(B,MATSUPERLU);CHKERRQ(ierr);
397   ierr = MatSeqAIJSetPreallocation(B,0,PETSC_NULL);CHKERRQ(ierr);
398 
399   B->ops->lufactornumeric = MatLUFactorNumeric_SuperLU;
400   B->ops->solve           = MatSolve_SuperLU;
401   B->factor               = FACTOR_LU;
402   B->assembled            = PETSC_TRUE;  /* required by -sles_view */
403 
404   lu = (Mat_SuperLU*)(B->spptr);
405 #ifdef SUPERLU2
406   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatCreateNull","MatCreateNull_SuperLU",
407                                     (void(*)(void))MatCreateNull_SuperLU);CHKERRQ(ierr);
408 #endif
409 #ifdef OLD
410   /* Allocate the work arrays required by SuperLU (notice sizes are for the transpose) */
411   ierr = PetscMalloc(A->n*sizeof(int),&lu->perm_r);CHKERRQ(ierr);
412   ierr = PetscMalloc(A->m*sizeof(int),&lu->perm_c);CHKERRQ(ierr);
413 
414   /* use PETSc mat ordering */
415   ierr = ISGetIndices(c,&ca);CHKERRQ(ierr);
416   ierr = PetscMemcpy(lu->perm_c,ca,A->m*sizeof(int));CHKERRQ(ierr);
417   ierr = ISRestoreIndices(c,&ca);CHKERRQ(ierr);
418   lu->SuperluMatOdering = PETSC_FALSE;
419 
420   lu->pivot_threshold = info->dtcol;
421   PetscLogObjectMemory(B,(A->m+A->n)*sizeof(int)+sizeof(Mat_SuperLU));
422 #endif
423   /* Allocate spaces (notice sizes are for the transpose) */
424   int            *perm_c; /* column permutation vector */
425   int            *perm_r; /* row permutations from partial pivoting */
426   if ( !(lu->etree = intMalloc(m)) ) ABORT("Malloc fails for etree[].");
427   if ( !(lu->perm_r = intMalloc(n)) ) ABORT("Malloc fails for perm_r[].");
428   if ( !(lu->perm_c = intMalloc(m)) ) ABORT("Malloc fails for perm_c[].");
429   if ( !(lu->R = (double *) SUPERLU_MALLOC(n * sizeof(double))) )
430     ABORT("SUPERLU_MALLOC fails for R[].");
431   if ( !(lu->C = (double *) SUPERLU_MALLOC(m * sizeof(double))) )
432     ABORT("SUPERLU_MALLOC fails for C[].");
433 
434   /* create rhs and solution x without allocate space for Store */
435   dCreate_Dense_Matrix(&lu->B, m, 1, PETSC_NULL, m, SLU_DN, SLU_D, SLU_GE);
436   dCreate_Dense_Matrix(&lu->X, m, 1, PETSC_NULL, m, SLU_DN, SLU_D, SLU_GE);
437 
438   lu->flg            = DIFFERENT_NONZERO_PATTERN;
439   lu->CleanUpSuperLU = PETSC_TRUE;
440 
441   *F = B;
442   PetscFunctionReturn(0);
443 }
444 
445 /* used by -sles_view */
446 #undef __FUNCT__
447 #define __FUNCT__ "MatFactorInfo_SuperLU"
448 int MatFactorInfo_SuperLU(Mat A,PetscViewer viewer)
449 {
450   Mat_SuperLU *lu= (Mat_SuperLU*)A->spptr;
451   int         ierr;
452 
453   PetscFunctionBegin;
454   ierr = PetscViewerASCIIPrintf(viewer,"SuperLU run parameters:\n");CHKERRQ(ierr);
455 #ifdef OLD
456   if(lu->SuperluMatOdering) {
457     ierr = PetscViewerASCIIPrintf(viewer,"  SuperLU mat ordering: %d\n",lu->ispec);CHKERRQ(ierr);
458   }
459 #endif
460   PetscFunctionReturn(0);
461 }
462 
463 #undef __FUNCT__
464 #define __FUNCT__ "MatDuplicate_SuperLU"
465 int MatDuplicate_SuperLU(Mat A, MatDuplicateOption op, Mat *M) {
466   int         ierr;
467   Mat_SuperLU *lu=(Mat_SuperLU *)A->spptr;
468 
469   PetscFunctionBegin;
470   ierr = (*lu->MatDuplicate)(A,op,M);CHKERRQ(ierr);
471   ierr = MatConvert_SeqAIJ_SuperLU(*M,MATSUPERLU,M);CHKERRQ(ierr);
472   ierr = PetscMemcpy((*M)->spptr,lu,sizeof(Mat_SuperLU));CHKERRQ(ierr);
473   PetscFunctionReturn(0);
474 }
475 
476 EXTERN_C_BEGIN
477 #undef __FUNCT__
478 #define __FUNCT__ "MatConvert_SuperLU_SeqAIJ"
479 int MatConvert_SuperLU_SeqAIJ(Mat A,MatType type,Mat *newmat) {
480   /* This routine is only called to convert an unfactored PETSc-SuperLU matrix */
481   /* to its base PETSc type, so we will ignore 'MatType type'. */
482   int                  ierr;
483   Mat                  B=*newmat;
484   Mat_SuperLU   *lu=(Mat_SuperLU *)A->spptr;
485 
486   PetscFunctionBegin;
487   if (B != A) {
488     ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
489   }
490   /* Reset the original function pointers */
491   B->ops->duplicate        = lu->MatDuplicate;
492   B->ops->view             = lu->MatView;
493   B->ops->assemblyend      = lu->MatAssemblyEnd;
494   B->ops->lufactorsymbolic = lu->MatLUFactorSymbolic;
495   B->ops->destroy          = lu->MatDestroy;
496   /* lu is only a function pointer stash unless we've factored the matrix, which we haven't! */
497   ierr = PetscFree(lu);CHKERRQ(ierr);
498   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQAIJ);CHKERRQ(ierr);
499   *newmat = B;
500   PetscFunctionReturn(0);
501 }
502 EXTERN_C_END
503 
504 EXTERN_C_BEGIN
505 #undef __FUNCT__
506 #define __FUNCT__ "MatConvert_SeqAIJ_SuperLU"
507 int MatConvert_SeqAIJ_SuperLU(Mat A,MatType type,Mat *newmat) {
508   /* This routine is only called to convert to MATSUPERLU */
509   /* from MATSEQAIJ, so we will ignore 'MatType type'. */
510   int         ierr;
511   Mat         B=*newmat;
512   Mat_SuperLU *lu;
513 
514   PetscFunctionBegin;
515   if (B != A) {
516     ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
517   }
518 
519   ierr = PetscNew(Mat_SuperLU,&lu);CHKERRQ(ierr);
520   lu->MatDuplicate         = A->ops->duplicate;
521   lu->MatView              = A->ops->view;
522   lu->MatAssemblyEnd       = A->ops->assemblyend;
523   lu->MatLUFactorSymbolic  = A->ops->lufactorsymbolic;
524   lu->MatDestroy           = A->ops->destroy;
525   lu->CleanUpSuperLU       = PETSC_FALSE;
526 
527   B->spptr                 = (void*)lu;
528   B->ops->duplicate        = MatDuplicate_SuperLU;
529   B->ops->view             = MatView_SuperLU;
530   B->ops->assemblyend      = MatAssemblyEnd_SuperLU;
531   B->ops->lufactorsymbolic = MatLUFactorSymbolic_SuperLU;
532   B->ops->destroy          = MatDestroy_SuperLU;
533 
534   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqaij_superlu_C",
535                                            "MatConvert_SeqAIJ_SuperLU",MatConvert_SeqAIJ_SuperLU);CHKERRQ(ierr);
536   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_superlu_seqaij_C",
537                                            "MatConvert_SuperLU_SeqAIJ",MatConvert_SuperLU_SeqAIJ);CHKERRQ(ierr);
538   PetscLogInfo(0,"Using SuperLU for SeqAIJ LU factorization and solves.");
539   ierr = PetscObjectChangeTypeName((PetscObject)B,MATSUPERLU);CHKERRQ(ierr);
540   *newmat = B;
541   PetscFunctionReturn(0);
542 }
543 EXTERN_C_END
544 
545 /*MC
546   MATSUPERLU - MATSUPERLU = "superlu" - A matrix type providing direct solvers (LU) for sequential matrices
547   via the external package SuperLU.
548 
549   If SuperLU is installed (see the manual for
550   instructions on how to declare the existence of external packages),
551   a matrix type can be constructed which invokes SuperLU solvers.
552   After calling MatCreate(...,A), simply call MatSetType(A,MATSUPERLU).
553   This matrix type is only supported for double precision real.
554 
555   This matrix inherits from MATSEQAIJ.  As a result, MatSeqAIJSetPreallocation is
556   supported for this matrix type.  One can also call MatConvert for an inplace conversion to or from
557   the MATSEQAIJ type without data copy.
558 
559   Options Database Keys:
560 + -mat_type superlu - sets the matrix type to "superlu" during a call to MatSetFromOptions()
561 - -mat_superlu_ordering <0,1,2,3> - 0: natural ordering,
562                                     1: MMD applied to A'*A,
563                                     2: MMD applied to A'+A,
564                                     3: COLAMD, approximate minimum degree column ordering
565 
566    Level: beginner
567 
568 .seealso: PCLU
569 M*/
570 
571 EXTERN_C_BEGIN
572 #undef __FUNCT__
573 #define __FUNCT__ "MatCreate_SuperLU"
574 int MatCreate_SuperLU(Mat A) {
575   int ierr;
576 
577   PetscFunctionBegin;
578   /* Change type name before calling MatSetType to force proper construction of SeqAIJ and SUPERLU types */
579   ierr = PetscObjectChangeTypeName((PetscObject)A,MATSUPERLU);CHKERRQ(ierr);
580   ierr = MatSetType(A,MATSEQAIJ);CHKERRQ(ierr);
581   ierr = MatConvert_SeqAIJ_SuperLU(A,MATSUPERLU,&A);CHKERRQ(ierr);
582   PetscFunctionReturn(0);
583 }
584 EXTERN_C_END
585