xref: /petsc/src/mat/impls/aij/mpi/mumps/mumps.c (revision 927faaad4e7a9177b263c19fc2f4e1f9dae8f67a)
1 
2 /*
3     Provides an interface to the MUMPS sparse solver
4 */
5 
6 #include <../src/mat/impls/aij/mpi/mpiaij.h> /*I  "petscmat.h"  I*/
7 #include <../src/mat/impls/sbaij/mpi/mpisbaij.h>
8 #include <petscblaslapack.h>
9 
10 EXTERN_C_BEGIN
11 #if defined(PETSC_USE_COMPLEX)
12 #if defined(PETSC_USE_REAL_SINGLE)
13 #include <cmumps_c.h>
14 #else
15 #include <zmumps_c.h>
16 #endif
17 #else
18 #if defined(PETSC_USE_REAL_SINGLE)
19 #include <smumps_c.h>
20 #else
21 #include <dmumps_c.h>
22 #endif
23 #endif
24 EXTERN_C_END
25 #define JOB_INIT -1
26 #define JOB_FACTSYMBOLIC 1
27 #define JOB_FACTNUMERIC 2
28 #define JOB_SOLVE 3
29 #define JOB_END -2
30 
31 /* calls to MUMPS */
32 #if defined(PETSC_USE_COMPLEX)
33 #if defined(PETSC_USE_REAL_SINGLE)
34 #define PetscMUMPS_c cmumps_c
35 #else
36 #define PetscMUMPS_c zmumps_c
37 #endif
38 #else
39 #if defined(PETSC_USE_REAL_SINGLE)
40 #define PetscMUMPS_c smumps_c
41 #else
42 #define PetscMUMPS_c dmumps_c
43 #endif
44 #endif
45 
46 /* declare MumpsScalar */
47 #if defined(PETSC_USE_COMPLEX)
48 #if defined(PETSC_USE_REAL_SINGLE)
49 #define MumpsScalar mumps_complex
50 #else
51 #define MumpsScalar mumps_double_complex
52 #endif
53 #else
54 #define MumpsScalar PetscScalar
55 #endif
56 
57 /* macros s.t. indices match MUMPS documentation */
58 #define ICNTL(I) icntl[(I)-1]
59 #define CNTL(I) cntl[(I)-1]
60 #define INFOG(I) infog[(I)-1]
61 #define INFO(I) info[(I)-1]
62 #define RINFOG(I) rinfog[(I)-1]
63 #define RINFO(I) rinfo[(I)-1]
64 
65 typedef struct {
66 #if defined(PETSC_USE_COMPLEX)
67 #if defined(PETSC_USE_REAL_SINGLE)
68   CMUMPS_STRUC_C id;
69 #else
70   ZMUMPS_STRUC_C id;
71 #endif
72 #else
73 #if defined(PETSC_USE_REAL_SINGLE)
74   SMUMPS_STRUC_C id;
75 #else
76   DMUMPS_STRUC_C id;
77 #endif
78 #endif
79 
80   MatStructure matstruc;
81   PetscMPIInt  myid,size;
82   PetscInt     *irn,*jcn,nz,sym;
83   PetscScalar  *val;
84   MPI_Comm     comm_mumps;
85   PetscBool    isAIJ;
86   PetscInt     ICNTL9_pre;           /* check if ICNTL(9) is changed from previous MatSolve */
87   VecScatter   scat_rhs, scat_sol;   /* used by MatSolve() */
88   Vec          b_seq,x_seq;
89   PetscInt     ninfo,*info;          /* display INFO */
90   PetscInt     sizeredrhs;
91   PetscInt     *schur_pivots;
92   PetscInt     schur_B_lwork;
93   PetscScalar  *schur_work;
94   PetscScalar  *schur_sol;
95   PetscInt     schur_sizesol;
96   PetscBool    schur_factored;
97   PetscBool    schur_inverted;
98 
99   PetscErrorCode (*Destroy)(Mat);
100   PetscErrorCode (*ConvertToTriples)(Mat, int, MatReuse, int*, int**, int**, PetscScalar**);
101 } Mat_MUMPS;
102 
103 extern PetscErrorCode MatDuplicate_MUMPS(Mat,MatDuplicateOption,Mat*);
104 
105 #undef __FUNCT__
106 #define __FUNCT__ "MatMumpsResetSchur_Private"
107 static PetscErrorCode MatMumpsResetSchur_Private(Mat_MUMPS* mumps)
108 {
109   PetscErrorCode ierr;
110 
111   PetscFunctionBegin;
112   ierr = PetscFree2(mumps->id.listvar_schur,mumps->id.schur);CHKERRQ(ierr);
113   ierr = PetscFree(mumps->id.redrhs);CHKERRQ(ierr);
114   ierr = PetscFree(mumps->schur_sol);CHKERRQ(ierr);
115   ierr = PetscFree(mumps->schur_pivots);CHKERRQ(ierr);
116   ierr = PetscFree(mumps->schur_work);CHKERRQ(ierr);
117   mumps->id.size_schur = 0;
118   mumps->id.ICNTL(19) = 0;
119   PetscFunctionReturn(0);
120 }
121 
122 #undef __FUNCT__
123 #define __FUNCT__ "MatMumpsFactorSchur_Private"
124 static PetscErrorCode MatMumpsFactorSchur_Private(Mat_MUMPS* mumps)
125 {
126   PetscBLASInt   B_N,B_ierr,B_slda;
127   PetscErrorCode ierr;
128 
129   PetscFunctionBegin;
130   if (mumps->schur_factored) {
131     PetscFunctionReturn(0);
132   }
133   ierr = PetscBLASIntCast(mumps->id.size_schur,&B_N);CHKERRQ(ierr);
134   ierr = PetscBLASIntCast(mumps->id.schur_lld,&B_slda);CHKERRQ(ierr);
135   if (!mumps->sym) { /* MUMPS always return a full Schur matrix */
136     if (!mumps->schur_pivots) {
137       ierr = PetscMalloc1(B_N,&mumps->schur_pivots);CHKERRQ(ierr);
138     }
139     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
140     PetscStackCallBLAS("LAPACKgetrf",LAPACKgetrf_(&B_N,&B_N,(PetscScalar*)mumps->id.schur,&B_slda,mumps->schur_pivots,&B_ierr));
141     ierr = PetscFPTrapPop();CHKERRQ(ierr);
142     if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GETRF Lapack routine %d",(int)B_ierr);
143   } else { /* either full or lower-triangular (not packed) */
144     char ord[2];
145     if (mumps->id.ICNTL(19) == 2 || mumps->id.ICNTL(19) == 3) { /* lower triangular stored by columns or full matrix */
146       sprintf(ord,"L");
147     } else { /* ICNTL(19) == 1 lower triangular stored by rows */
148       sprintf(ord,"U");
149     }
150     if (mumps->id.sym == 2) {
151       if (!mumps->schur_pivots) {
152         PetscScalar  lwork;
153 
154         ierr = PetscMalloc1(B_N,&mumps->schur_pivots);CHKERRQ(ierr);
155         mumps->schur_B_lwork=-1;
156         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
157         PetscStackCallBLAS("LAPACKsytrf",LAPACKsytrf_(ord,&B_N,(PetscScalar*)mumps->id.schur,&B_slda,mumps->schur_pivots,&lwork,&mumps->schur_B_lwork,&B_ierr));
158         ierr = PetscFPTrapPop();CHKERRQ(ierr);
159         if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYTRF Lapack routine %d",(int)B_ierr);
160         ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&mumps->schur_B_lwork);CHKERRQ(ierr);
161         ierr = PetscMalloc1(mumps->schur_B_lwork,&mumps->schur_work);CHKERRQ(ierr);
162       }
163       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
164       PetscStackCallBLAS("LAPACKsytrf",LAPACKsytrf_(ord,&B_N,(PetscScalar*)mumps->id.schur,&B_slda,mumps->schur_pivots,mumps->schur_work,&mumps->schur_B_lwork,&B_ierr));
165       ierr = PetscFPTrapPop();CHKERRQ(ierr);
166       if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYTRF Lapack routine %d",(int)B_ierr);
167     } else {
168       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
169       PetscStackCallBLAS("LAPACKpotrf",LAPACKpotrf_(ord,&B_N,(PetscScalar*)mumps->id.schur,&B_slda,&B_ierr));
170       ierr = PetscFPTrapPop();CHKERRQ(ierr);
171       if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in POTRF Lapack routine %d",(int)B_ierr);
172     }
173   }
174   mumps->schur_factored = PETSC_TRUE;
175   PetscFunctionReturn(0);
176 }
177 
178 #undef __FUNCT__
179 #define __FUNCT__ "MatMumpsInvertSchur_Private"
180 static PetscErrorCode MatMumpsInvertSchur_Private(Mat_MUMPS* mumps)
181 {
182   PetscBLASInt   B_N,B_ierr,B_slda;
183   PetscErrorCode ierr;
184 
185   PetscFunctionBegin;
186   ierr = MatMumpsFactorSchur_Private(mumps);CHKERRQ(ierr);
187   ierr = PetscBLASIntCast(mumps->id.size_schur,&B_N);CHKERRQ(ierr);
188   ierr = PetscBLASIntCast(mumps->id.schur_lld,&B_slda);CHKERRQ(ierr);
189   if (!mumps->sym) { /* MUMPS always return a full Schur matrix */
190     if (!mumps->schur_work) {
191       PetscScalar lwork;
192 
193       mumps->schur_B_lwork = -1;
194       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
195       PetscStackCallBLAS("LAPACKgetri",LAPACKgetri_(&B_N,(PetscScalar*)mumps->id.schur,&B_N,mumps->schur_pivots,&lwork,&mumps->schur_B_lwork,&B_ierr));
196       ierr = PetscFPTrapPop();CHKERRQ(ierr);
197       if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GETRI Lapack routine %d",(int)B_ierr);
198       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&mumps->schur_B_lwork);CHKERRQ(ierr);
199       ierr = PetscMalloc1(mumps->schur_B_lwork,&mumps->schur_work);CHKERRQ(ierr);
200     }
201     ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
202     PetscStackCallBLAS("LAPACKgetri",LAPACKgetri_(&B_N,(PetscScalar*)mumps->id.schur,&B_N,mumps->schur_pivots,mumps->schur_work,&mumps->schur_B_lwork,&B_ierr));
203     ierr = PetscFPTrapPop();CHKERRQ(ierr);
204     if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GETRI Lapack routine %d",(int)B_ierr);
205   } else { /* either full or lower-triangular (not packed) */
206     char ord[2];
207     if (mumps->id.ICNTL(19) == 2 || mumps->id.ICNTL(19) == 3) { /* lower triangular stored by columns or full matrix */
208       sprintf(ord,"L");
209     } else { /* ICNTL(19) == 1 lower triangular stored by rows */
210       sprintf(ord,"U");
211     }
212     if (mumps->id.sym == 2) {
213       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
214       PetscStackCallBLAS("LAPACKsytri",LAPACKsytri_(ord,&B_N,(PetscScalar*)mumps->id.schur,&B_N,mumps->schur_pivots,mumps->schur_work,&B_ierr));
215       ierr = PetscFPTrapPop();CHKERRQ(ierr);
216       if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYTRI Lapack routine %d",(int)B_ierr);
217     } else {
218       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
219       PetscStackCallBLAS("LAPACKpotri",LAPACKpotri_(ord,&B_N,(PetscScalar*)mumps->id.schur,&B_N,&B_ierr));
220       ierr = PetscFPTrapPop();CHKERRQ(ierr);
221       if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in POTRI Lapack routine %d",(int)B_ierr);
222     }
223   }
224   mumps->schur_inverted = PETSC_TRUE;
225   PetscFunctionReturn(0);
226 }
227 
228 #undef __FUNCT__
229 #define __FUNCT__ "MatMumpsSolveSchur_Private"
230 static PetscErrorCode MatMumpsSolveSchur_Private(Mat_MUMPS* mumps, PetscBool sol_in_redrhs)
231 {
232   PetscBLASInt   B_N,B_Nrhs,B_ierr,B_slda,B_rlda;
233   PetscScalar    one=1.,zero=0.;
234   PetscErrorCode ierr;
235 
236   PetscFunctionBegin;
237   ierr = MatMumpsFactorSchur_Private(mumps);CHKERRQ(ierr);
238   ierr = PetscBLASIntCast(mumps->id.size_schur,&B_N);CHKERRQ(ierr);
239   ierr = PetscBLASIntCast(mumps->id.schur_lld,&B_slda);CHKERRQ(ierr);
240   ierr = PetscBLASIntCast(mumps->id.nrhs,&B_Nrhs);CHKERRQ(ierr);
241   ierr = PetscBLASIntCast(mumps->id.lredrhs,&B_rlda);CHKERRQ(ierr);
242   if (mumps->schur_inverted) {
243     PetscInt sizesol = B_Nrhs*B_N;
244     if (!mumps->schur_sol || sizesol > mumps->schur_sizesol) {
245       ierr = PetscFree(mumps->schur_sol);CHKERRQ(ierr);
246       ierr = PetscMalloc1(sizesol,&mumps->schur_sol);CHKERRQ(ierr);
247       mumps->schur_sizesol = sizesol;
248     }
249     if (!mumps->sym) {
250       char type[2];
251       if (mumps->id.ICNTL(19) == 1) { /* stored by rows */
252         if (!mumps->id.ICNTL(9)) { /* transpose solve */
253           sprintf(type,"N");
254         } else {
255           sprintf(type,"T");
256         }
257       } else { /* stored by columns */
258         if (!mumps->id.ICNTL(9)) { /* transpose solve */
259           sprintf(type,"T");
260         } else {
261           sprintf(type,"N");
262         }
263       }
264       PetscStackCallBLAS("BLASgemm",BLASgemm_(type,"N",&B_N,&B_Nrhs,&B_N,&one,(PetscScalar*)mumps->id.schur,&B_slda,(PetscScalar*)mumps->id.redrhs,&B_rlda,&zero,mumps->schur_sol,&B_rlda));
265     } else {
266       char ord[2];
267       if (mumps->id.ICNTL(19) == 2 || mumps->id.ICNTL(19) == 3) { /* lower triangular stored by columns or full matrix */
268         sprintf(ord,"L");
269       } else { /* ICNTL(19) == 1 lower triangular stored by rows */
270         sprintf(ord,"U");
271       }
272       PetscStackCallBLAS("BLASsymm",BLASsymm_("L",ord,&B_N,&B_Nrhs,&one,(PetscScalar*)mumps->id.schur,&B_slda,(PetscScalar*)mumps->id.redrhs,&B_rlda,&zero,mumps->schur_sol,&B_rlda));
273     }
274     if (sol_in_redrhs) {
275       ierr = PetscMemcpy(mumps->id.redrhs,mumps->schur_sol,sizesol*sizeof(PetscScalar));CHKERRQ(ierr);
276     }
277   } else { /* Schur complement has not been inverted */
278     MumpsScalar *orhs=NULL;
279 
280     if (!sol_in_redrhs) {
281       PetscInt sizesol = B_Nrhs*B_N;
282       if (!mumps->schur_sol || sizesol > mumps->schur_sizesol) {
283         ierr = PetscFree(mumps->schur_sol);CHKERRQ(ierr);
284         ierr = PetscMalloc1(sizesol,&mumps->schur_sol);CHKERRQ(ierr);
285         mumps->schur_sizesol = sizesol;
286       }
287       orhs = mumps->id.redrhs;
288       ierr = PetscMemcpy(mumps->schur_sol,mumps->id.redrhs,sizesol*sizeof(PetscScalar));CHKERRQ(ierr);
289       mumps->id.redrhs = (MumpsScalar*)mumps->schur_sol;
290     }
291     if (!mumps->sym) { /* MUMPS always return a full Schur matrix */
292       char type[2];
293       if (mumps->id.ICNTL(19) == 1) { /* stored by rows */
294         if (!mumps->id.ICNTL(9)) { /* transpose solve */
295           sprintf(type,"N");
296         } else {
297           sprintf(type,"T");
298         }
299       } else { /* stored by columns */
300         if (!mumps->id.ICNTL(9)) { /* transpose solve */
301           sprintf(type,"T");
302         } else {
303           sprintf(type,"N");
304         }
305       }
306       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
307       PetscStackCallBLAS("LAPACKgetrs",LAPACKgetrs_(type,&B_N,&B_Nrhs,(PetscScalar*)mumps->id.schur,&B_slda,mumps->schur_pivots,(PetscScalar*)mumps->id.redrhs,&B_rlda,&B_ierr));
308       ierr = PetscFPTrapPop();CHKERRQ(ierr);
309       if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GETRS Lapack routine %d",(int)B_ierr);
310     } else { /* either full or lower-triangular (not packed) */
311       char ord[2];
312       if (mumps->id.ICNTL(19) == 2 || mumps->id.ICNTL(19) == 3) { /* lower triangular stored by columns or full matrix */
313         sprintf(ord,"L");
314       } else { /* ICNTL(19) == 1 lower triangular stored by rows */
315         sprintf(ord,"U");
316       }
317       if (mumps->id.sym == 2) {
318         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
319         PetscStackCallBLAS("LAPACKsytrs",LAPACKsytrs_(ord,&B_N,&B_Nrhs,(PetscScalar*)mumps->id.schur,&B_slda,mumps->schur_pivots,(PetscScalar*)mumps->id.redrhs,&B_rlda,&B_ierr));
320         ierr = PetscFPTrapPop();CHKERRQ(ierr);
321         if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYTRS Lapack routine %d",(int)B_ierr);
322       } else {
323         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
324         PetscStackCallBLAS("LAPACKpotrs",LAPACKpotrs_(ord,&B_N,&B_Nrhs,(PetscScalar*)mumps->id.schur,&B_slda,(PetscScalar*)mumps->id.redrhs,&B_rlda,&B_ierr));
325         ierr = PetscFPTrapPop();CHKERRQ(ierr);
326         if (B_ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in POTRS Lapack routine %d",(int)B_ierr);
327       }
328     }
329     if (!sol_in_redrhs) {
330       mumps->id.redrhs = orhs;
331     }
332   }
333   PetscFunctionReturn(0);
334 }
335 
336 #undef __FUNCT__
337 #define __FUNCT__ "MatMumpsHandleSchur_Private"
338 static PetscErrorCode MatMumpsHandleSchur_Private(Mat_MUMPS* mumps, PetscBool expansion)
339 {
340   PetscErrorCode ierr;
341 
342   PetscFunctionBegin;
343   if (!mumps->id.ICNTL(19)) { /* do nothing when Schur complement has not been computed */
344     PetscFunctionReturn(0);
345   }
346   if (!expansion) { /* prepare for the condensation step */
347     PetscInt sizeredrhs = mumps->id.nrhs*mumps->id.size_schur;
348     /* allocate MUMPS internal array to store reduced right-hand sides */
349     if (!mumps->id.redrhs || sizeredrhs > mumps->sizeredrhs) {
350       ierr = PetscFree(mumps->id.redrhs);CHKERRQ(ierr);
351       mumps->id.lredrhs = mumps->id.size_schur;
352       ierr = PetscMalloc1(mumps->id.nrhs*mumps->id.lredrhs,&mumps->id.redrhs);CHKERRQ(ierr);
353       mumps->sizeredrhs = mumps->id.nrhs*mumps->id.lredrhs;
354     }
355     mumps->id.ICNTL(26) = 1; /* condensation phase */
356   } else { /* prepare for the expansion step */
357     /* solve Schur complement (this has to be done by the MUMPS user, so basically us) */
358     ierr = MatMumpsSolveSchur_Private(mumps,PETSC_TRUE);CHKERRQ(ierr);
359     mumps->id.ICNTL(26) = 2; /* expansion phase */
360     PetscMUMPS_c(&mumps->id);
361     if (mumps->id.INFOG(1) < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in solve phase: INFOG(1)=%d\n",mumps->id.INFOG(1));
362     /* restore defaults */
363     mumps->id.ICNTL(26) = -1;
364   }
365   PetscFunctionReturn(0);
366 }
367 
368 /*
369   MatConvertToTriples_A_B - convert Petsc matrix to triples: row[nz], col[nz], val[nz]
370 
371   input:
372     A       - matrix in aij,baij or sbaij (bs=1) format
373     shift   - 0: C style output triple; 1: Fortran style output triple.
374     reuse   - MAT_INITIAL_MATRIX: spaces are allocated and values are set for the triple
375               MAT_REUSE_MATRIX:   only the values in v array are updated
376   output:
377     nnz     - dim of r, c, and v (number of local nonzero entries of A)
378     r, c, v - row and col index, matrix values (matrix triples)
379 
380   The returned values r, c, and sometimes v are obtained in a single PetscMalloc(). Then in MatDestroy_MUMPS() it is
381   freed with PetscFree((mumps->irn);  This is not ideal code, the fact that v is ONLY sometimes part of mumps->irn means
382   that the PetscMalloc() cannot easily be replaced with a PetscMalloc3().
383 
384  */
385 
386 #undef __FUNCT__
387 #define __FUNCT__ "MatConvertToTriples_seqaij_seqaij"
388 PetscErrorCode MatConvertToTriples_seqaij_seqaij(Mat A,int shift,MatReuse reuse,int *nnz,int **r, int **c, PetscScalar **v)
389 {
390   const PetscInt *ai,*aj,*ajj,M=A->rmap->n;
391   PetscInt       nz,rnz,i,j;
392   PetscErrorCode ierr;
393   PetscInt       *row,*col;
394   Mat_SeqAIJ     *aa=(Mat_SeqAIJ*)A->data;
395 
396   PetscFunctionBegin;
397   *v=aa->a;
398   if (reuse == MAT_INITIAL_MATRIX) {
399     nz   = aa->nz;
400     ai   = aa->i;
401     aj   = aa->j;
402     *nnz = nz;
403     ierr = PetscMalloc1(2*nz, &row);CHKERRQ(ierr);
404     col  = row + nz;
405 
406     nz = 0;
407     for (i=0; i<M; i++) {
408       rnz = ai[i+1] - ai[i];
409       ajj = aj + ai[i];
410       for (j=0; j<rnz; j++) {
411         row[nz] = i+shift; col[nz++] = ajj[j] + shift;
412       }
413     }
414     *r = row; *c = col;
415   }
416   PetscFunctionReturn(0);
417 }
418 
419 #undef __FUNCT__
420 #define __FUNCT__ "MatConvertToTriples_seqbaij_seqaij"
421 PetscErrorCode MatConvertToTriples_seqbaij_seqaij(Mat A,int shift,MatReuse reuse,int *nnz,int **r, int **c, PetscScalar **v)
422 {
423   Mat_SeqBAIJ    *aa=(Mat_SeqBAIJ*)A->data;
424   const PetscInt *ai,*aj,*ajj,bs2 = aa->bs2;
425   PetscInt       bs,M,nz,idx=0,rnz,i,j,k,m;
426   PetscErrorCode ierr;
427   PetscInt       *row,*col;
428 
429   PetscFunctionBegin;
430   ierr = MatGetBlockSize(A,&bs);CHKERRQ(ierr);
431   M = A->rmap->N/bs;
432   *v = aa->a;
433   if (reuse == MAT_INITIAL_MATRIX) {
434     ai   = aa->i; aj = aa->j;
435     nz   = bs2*aa->nz;
436     *nnz = nz;
437     ierr = PetscMalloc1(2*nz, &row);CHKERRQ(ierr);
438     col  = row + nz;
439 
440     for (i=0; i<M; i++) {
441       ajj = aj + ai[i];
442       rnz = ai[i+1] - ai[i];
443       for (k=0; k<rnz; k++) {
444         for (j=0; j<bs; j++) {
445           for (m=0; m<bs; m++) {
446             row[idx]   = i*bs + m + shift;
447             col[idx++] = bs*(ajj[k]) + j + shift;
448           }
449         }
450       }
451     }
452     *r = row; *c = col;
453   }
454   PetscFunctionReturn(0);
455 }
456 
457 #undef __FUNCT__
458 #define __FUNCT__ "MatConvertToTriples_seqsbaij_seqsbaij"
459 PetscErrorCode MatConvertToTriples_seqsbaij_seqsbaij(Mat A,int shift,MatReuse reuse,int *nnz,int **r, int **c, PetscScalar **v)
460 {
461   const PetscInt *ai, *aj,*ajj,M=A->rmap->n;
462   PetscInt       nz,rnz,i,j;
463   PetscErrorCode ierr;
464   PetscInt       *row,*col;
465   Mat_SeqSBAIJ   *aa=(Mat_SeqSBAIJ*)A->data;
466 
467   PetscFunctionBegin;
468   *v = aa->a;
469   if (reuse == MAT_INITIAL_MATRIX) {
470     nz   = aa->nz;
471     ai   = aa->i;
472     aj   = aa->j;
473     *v   = aa->a;
474     *nnz = nz;
475     ierr = PetscMalloc1(2*nz, &row);CHKERRQ(ierr);
476     col  = row + nz;
477 
478     nz = 0;
479     for (i=0; i<M; i++) {
480       rnz = ai[i+1] - ai[i];
481       ajj = aj + ai[i];
482       for (j=0; j<rnz; j++) {
483         row[nz] = i+shift; col[nz++] = ajj[j] + shift;
484       }
485     }
486     *r = row; *c = col;
487   }
488   PetscFunctionReturn(0);
489 }
490 
491 #undef __FUNCT__
492 #define __FUNCT__ "MatConvertToTriples_seqaij_seqsbaij"
493 PetscErrorCode MatConvertToTriples_seqaij_seqsbaij(Mat A,int shift,MatReuse reuse,int *nnz,int **r, int **c, PetscScalar **v)
494 {
495   const PetscInt    *ai,*aj,*ajj,*adiag,M=A->rmap->n;
496   PetscInt          nz,rnz,i,j;
497   const PetscScalar *av,*v1;
498   PetscScalar       *val;
499   PetscErrorCode    ierr;
500   PetscInt          *row,*col;
501   Mat_SeqAIJ        *aa=(Mat_SeqAIJ*)A->data;
502 
503   PetscFunctionBegin;
504   ai   =aa->i; aj=aa->j;av=aa->a;
505   adiag=aa->diag;
506   if (reuse == MAT_INITIAL_MATRIX) {
507     /* count nz in the uppper triangular part of A */
508     nz = 0;
509     for (i=0; i<M; i++) nz += ai[i+1] - adiag[i];
510     *nnz = nz;
511 
512     ierr = PetscMalloc((2*nz*sizeof(PetscInt)+nz*sizeof(PetscScalar)), &row);CHKERRQ(ierr);
513     col  = row + nz;
514     val  = (PetscScalar*)(col + nz);
515 
516     nz = 0;
517     for (i=0; i<M; i++) {
518       rnz = ai[i+1] - adiag[i];
519       ajj = aj + adiag[i];
520       v1  = av + adiag[i];
521       for (j=0; j<rnz; j++) {
522         row[nz] = i+shift; col[nz] = ajj[j] + shift; val[nz++] = v1[j];
523       }
524     }
525     *r = row; *c = col; *v = val;
526   } else {
527     nz = 0; val = *v;
528     for (i=0; i <M; i++) {
529       rnz = ai[i+1] - adiag[i];
530       ajj = aj + adiag[i];
531       v1  = av + adiag[i];
532       for (j=0; j<rnz; j++) {
533         val[nz++] = v1[j];
534       }
535     }
536   }
537   PetscFunctionReturn(0);
538 }
539 
540 #undef __FUNCT__
541 #define __FUNCT__ "MatConvertToTriples_mpisbaij_mpisbaij"
542 PetscErrorCode MatConvertToTriples_mpisbaij_mpisbaij(Mat A,int shift,MatReuse reuse,int *nnz,int **r, int **c, PetscScalar **v)
543 {
544   const PetscInt    *ai, *aj, *bi, *bj,*garray,m=A->rmap->n,*ajj,*bjj;
545   PetscErrorCode    ierr;
546   PetscInt          rstart,nz,i,j,jj,irow,countA,countB;
547   PetscInt          *row,*col;
548   const PetscScalar *av, *bv,*v1,*v2;
549   PetscScalar       *val;
550   Mat_MPISBAIJ      *mat = (Mat_MPISBAIJ*)A->data;
551   Mat_SeqSBAIJ      *aa  = (Mat_SeqSBAIJ*)(mat->A)->data;
552   Mat_SeqBAIJ       *bb  = (Mat_SeqBAIJ*)(mat->B)->data;
553 
554   PetscFunctionBegin;
555   ai=aa->i; aj=aa->j; bi=bb->i; bj=bb->j; rstart= A->rmap->rstart;
556   av=aa->a; bv=bb->a;
557 
558   garray = mat->garray;
559 
560   if (reuse == MAT_INITIAL_MATRIX) {
561     nz   = aa->nz + bb->nz;
562     *nnz = nz;
563     ierr = PetscMalloc((2*nz*sizeof(PetscInt)+nz*sizeof(PetscScalar)), &row);CHKERRQ(ierr);
564     col  = row + nz;
565     val  = (PetscScalar*)(col + nz);
566 
567     *r = row; *c = col; *v = val;
568   } else {
569     row = *r; col = *c; val = *v;
570   }
571 
572   jj = 0; irow = rstart;
573   for (i=0; i<m; i++) {
574     ajj    = aj + ai[i];                 /* ptr to the beginning of this row */
575     countA = ai[i+1] - ai[i];
576     countB = bi[i+1] - bi[i];
577     bjj    = bj + bi[i];
578     v1     = av + ai[i];
579     v2     = bv + bi[i];
580 
581     /* A-part */
582     for (j=0; j<countA; j++) {
583       if (reuse == MAT_INITIAL_MATRIX) {
584         row[jj] = irow + shift; col[jj] = rstart + ajj[j] + shift;
585       }
586       val[jj++] = v1[j];
587     }
588 
589     /* B-part */
590     for (j=0; j < countB; j++) {
591       if (reuse == MAT_INITIAL_MATRIX) {
592         row[jj] = irow + shift; col[jj] = garray[bjj[j]] + shift;
593       }
594       val[jj++] = v2[j];
595     }
596     irow++;
597   }
598   PetscFunctionReturn(0);
599 }
600 
601 #undef __FUNCT__
602 #define __FUNCT__ "MatConvertToTriples_mpiaij_mpiaij"
603 PetscErrorCode MatConvertToTriples_mpiaij_mpiaij(Mat A,int shift,MatReuse reuse,int *nnz,int **r, int **c, PetscScalar **v)
604 {
605   const PetscInt    *ai, *aj, *bi, *bj,*garray,m=A->rmap->n,*ajj,*bjj;
606   PetscErrorCode    ierr;
607   PetscInt          rstart,nz,i,j,jj,irow,countA,countB;
608   PetscInt          *row,*col;
609   const PetscScalar *av, *bv,*v1,*v2;
610   PetscScalar       *val;
611   Mat_MPIAIJ        *mat = (Mat_MPIAIJ*)A->data;
612   Mat_SeqAIJ        *aa  = (Mat_SeqAIJ*)(mat->A)->data;
613   Mat_SeqAIJ        *bb  = (Mat_SeqAIJ*)(mat->B)->data;
614 
615   PetscFunctionBegin;
616   ai=aa->i; aj=aa->j; bi=bb->i; bj=bb->j; rstart= A->rmap->rstart;
617   av=aa->a; bv=bb->a;
618 
619   garray = mat->garray;
620 
621   if (reuse == MAT_INITIAL_MATRIX) {
622     nz   = aa->nz + bb->nz;
623     *nnz = nz;
624     ierr = PetscMalloc((2*nz*sizeof(PetscInt)+nz*sizeof(PetscScalar)), &row);CHKERRQ(ierr);
625     col  = row + nz;
626     val  = (PetscScalar*)(col + nz);
627 
628     *r = row; *c = col; *v = val;
629   } else {
630     row = *r; col = *c; val = *v;
631   }
632 
633   jj = 0; irow = rstart;
634   for (i=0; i<m; i++) {
635     ajj    = aj + ai[i];                 /* ptr to the beginning of this row */
636     countA = ai[i+1] - ai[i];
637     countB = bi[i+1] - bi[i];
638     bjj    = bj + bi[i];
639     v1     = av + ai[i];
640     v2     = bv + bi[i];
641 
642     /* A-part */
643     for (j=0; j<countA; j++) {
644       if (reuse == MAT_INITIAL_MATRIX) {
645         row[jj] = irow + shift; col[jj] = rstart + ajj[j] + shift;
646       }
647       val[jj++] = v1[j];
648     }
649 
650     /* B-part */
651     for (j=0; j < countB; j++) {
652       if (reuse == MAT_INITIAL_MATRIX) {
653         row[jj] = irow + shift; col[jj] = garray[bjj[j]] + shift;
654       }
655       val[jj++] = v2[j];
656     }
657     irow++;
658   }
659   PetscFunctionReturn(0);
660 }
661 
662 #undef __FUNCT__
663 #define __FUNCT__ "MatConvertToTriples_mpibaij_mpiaij"
664 PetscErrorCode MatConvertToTriples_mpibaij_mpiaij(Mat A,int shift,MatReuse reuse,int *nnz,int **r, int **c, PetscScalar **v)
665 {
666   Mat_MPIBAIJ       *mat    = (Mat_MPIBAIJ*)A->data;
667   Mat_SeqBAIJ       *aa     = (Mat_SeqBAIJ*)(mat->A)->data;
668   Mat_SeqBAIJ       *bb     = (Mat_SeqBAIJ*)(mat->B)->data;
669   const PetscInt    *ai     = aa->i, *bi = bb->i, *aj = aa->j, *bj = bb->j,*ajj, *bjj;
670   const PetscInt    *garray = mat->garray,mbs=mat->mbs,rstart=A->rmap->rstart;
671   const PetscInt    bs2=mat->bs2;
672   PetscErrorCode    ierr;
673   PetscInt          bs,nz,i,j,k,n,jj,irow,countA,countB,idx;
674   PetscInt          *row,*col;
675   const PetscScalar *av=aa->a, *bv=bb->a,*v1,*v2;
676   PetscScalar       *val;
677 
678   PetscFunctionBegin;
679   ierr = MatGetBlockSize(A,&bs);CHKERRQ(ierr);
680   if (reuse == MAT_INITIAL_MATRIX) {
681     nz   = bs2*(aa->nz + bb->nz);
682     *nnz = nz;
683     ierr = PetscMalloc((2*nz*sizeof(PetscInt)+nz*sizeof(PetscScalar)), &row);CHKERRQ(ierr);
684     col  = row + nz;
685     val  = (PetscScalar*)(col + nz);
686 
687     *r = row; *c = col; *v = val;
688   } else {
689     row = *r; col = *c; val = *v;
690   }
691 
692   jj = 0; irow = rstart;
693   for (i=0; i<mbs; i++) {
694     countA = ai[i+1] - ai[i];
695     countB = bi[i+1] - bi[i];
696     ajj    = aj + ai[i];
697     bjj    = bj + bi[i];
698     v1     = av + bs2*ai[i];
699     v2     = bv + bs2*bi[i];
700 
701     idx = 0;
702     /* A-part */
703     for (k=0; k<countA; k++) {
704       for (j=0; j<bs; j++) {
705         for (n=0; n<bs; n++) {
706           if (reuse == MAT_INITIAL_MATRIX) {
707             row[jj] = irow + n + shift;
708             col[jj] = rstart + bs*ajj[k] + j + shift;
709           }
710           val[jj++] = v1[idx++];
711         }
712       }
713     }
714 
715     idx = 0;
716     /* B-part */
717     for (k=0; k<countB; k++) {
718       for (j=0; j<bs; j++) {
719         for (n=0; n<bs; n++) {
720           if (reuse == MAT_INITIAL_MATRIX) {
721             row[jj] = irow + n + shift;
722             col[jj] = bs*garray[bjj[k]] + j + shift;
723           }
724           val[jj++] = v2[idx++];
725         }
726       }
727     }
728     irow += bs;
729   }
730   PetscFunctionReturn(0);
731 }
732 
733 #undef __FUNCT__
734 #define __FUNCT__ "MatConvertToTriples_mpiaij_mpisbaij"
735 PetscErrorCode MatConvertToTriples_mpiaij_mpisbaij(Mat A,int shift,MatReuse reuse,int *nnz,int **r, int **c, PetscScalar **v)
736 {
737   const PetscInt    *ai, *aj,*adiag, *bi, *bj,*garray,m=A->rmap->n,*ajj,*bjj;
738   PetscErrorCode    ierr;
739   PetscInt          rstart,nz,nza,nzb,i,j,jj,irow,countA,countB;
740   PetscInt          *row,*col;
741   const PetscScalar *av, *bv,*v1,*v2;
742   PetscScalar       *val;
743   Mat_MPIAIJ        *mat =  (Mat_MPIAIJ*)A->data;
744   Mat_SeqAIJ        *aa  =(Mat_SeqAIJ*)(mat->A)->data;
745   Mat_SeqAIJ        *bb  =(Mat_SeqAIJ*)(mat->B)->data;
746 
747   PetscFunctionBegin;
748   ai=aa->i; aj=aa->j; adiag=aa->diag;
749   bi=bb->i; bj=bb->j; garray = mat->garray;
750   av=aa->a; bv=bb->a;
751 
752   rstart = A->rmap->rstart;
753 
754   if (reuse == MAT_INITIAL_MATRIX) {
755     nza = 0;    /* num of upper triangular entries in mat->A, including diagonals */
756     nzb = 0;    /* num of upper triangular entries in mat->B */
757     for (i=0; i<m; i++) {
758       nza   += (ai[i+1] - adiag[i]);
759       countB = bi[i+1] - bi[i];
760       bjj    = bj + bi[i];
761       for (j=0; j<countB; j++) {
762         if (garray[bjj[j]] > rstart) nzb++;
763       }
764     }
765 
766     nz   = nza + nzb; /* total nz of upper triangular part of mat */
767     *nnz = nz;
768     ierr = PetscMalloc((2*nz*sizeof(PetscInt)+nz*sizeof(PetscScalar)), &row);CHKERRQ(ierr);
769     col  = row + nz;
770     val  = (PetscScalar*)(col + nz);
771 
772     *r = row; *c = col; *v = val;
773   } else {
774     row = *r; col = *c; val = *v;
775   }
776 
777   jj = 0; irow = rstart;
778   for (i=0; i<m; i++) {
779     ajj    = aj + adiag[i];                 /* ptr to the beginning of the diagonal of this row */
780     v1     = av + adiag[i];
781     countA = ai[i+1] - adiag[i];
782     countB = bi[i+1] - bi[i];
783     bjj    = bj + bi[i];
784     v2     = bv + bi[i];
785 
786     /* A-part */
787     for (j=0; j<countA; j++) {
788       if (reuse == MAT_INITIAL_MATRIX) {
789         row[jj] = irow + shift; col[jj] = rstart + ajj[j] + shift;
790       }
791       val[jj++] = v1[j];
792     }
793 
794     /* B-part */
795     for (j=0; j < countB; j++) {
796       if (garray[bjj[j]] > rstart) {
797         if (reuse == MAT_INITIAL_MATRIX) {
798           row[jj] = irow + shift; col[jj] = garray[bjj[j]] + shift;
799         }
800         val[jj++] = v2[j];
801       }
802     }
803     irow++;
804   }
805   PetscFunctionReturn(0);
806 }
807 
808 #undef __FUNCT__
809 #define __FUNCT__ "MatGetDiagonal_MUMPS"
810 PetscErrorCode MatGetDiagonal_MUMPS(Mat A,Vec v)
811 {
812   PetscFunctionBegin;
813   SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_SUP,"Mat type: MUMPS factor");
814   PetscFunctionReturn(0);
815 }
816 
817 #undef __FUNCT__
818 #define __FUNCT__ "MatDestroy_MUMPS"
819 PetscErrorCode MatDestroy_MUMPS(Mat A)
820 {
821   Mat_MUMPS      *mumps=(Mat_MUMPS*)A->spptr;
822   PetscErrorCode ierr;
823 
824   PetscFunctionBegin;
825   ierr = PetscFree2(mumps->id.sol_loc,mumps->id.isol_loc);CHKERRQ(ierr);
826   ierr = VecScatterDestroy(&mumps->scat_rhs);CHKERRQ(ierr);
827   ierr = VecScatterDestroy(&mumps->scat_sol);CHKERRQ(ierr);
828   ierr = VecDestroy(&mumps->b_seq);CHKERRQ(ierr);
829   ierr = VecDestroy(&mumps->x_seq);CHKERRQ(ierr);
830   ierr = PetscFree(mumps->id.perm_in);CHKERRQ(ierr);
831   ierr = PetscFree(mumps->irn);CHKERRQ(ierr);
832   ierr = PetscFree(mumps->info);CHKERRQ(ierr);
833   ierr = MatMumpsResetSchur_Private(mumps);CHKERRQ(ierr);
834   mumps->id.job = JOB_END;
835   PetscMUMPS_c(&mumps->id);
836   ierr = MPI_Comm_free(&mumps->comm_mumps);CHKERRQ(ierr);
837   if (mumps->Destroy) {
838     ierr = (mumps->Destroy)(A);CHKERRQ(ierr);
839   }
840   ierr = PetscFree(A->spptr);CHKERRQ(ierr);
841 
842   /* clear composed functions */
843   ierr = PetscObjectComposeFunction((PetscObject)A,"MatFactorGetSolverPackage_C",NULL);CHKERRQ(ierr);
844   ierr = PetscObjectComposeFunction((PetscObject)A,"MatFactorSetSchurIS_C",NULL);CHKERRQ(ierr);
845   ierr = PetscObjectComposeFunction((PetscObject)A,"MatFactorInvertSchurComplement_C",NULL);CHKERRQ(ierr);
846   ierr = PetscObjectComposeFunction((PetscObject)A,"MatFactorCreateSchurComplement_C",NULL);CHKERRQ(ierr);
847   ierr = PetscObjectComposeFunction((PetscObject)A,"MatFactorGetSchurComplement_C",NULL);CHKERRQ(ierr);
848   ierr = PetscObjectComposeFunction((PetscObject)A,"MatFactorSolveSchurComplement_C",NULL);CHKERRQ(ierr);
849   ierr = PetscObjectComposeFunction((PetscObject)A,"MatFactorSolveSchurComplementTranspose_C",NULL);CHKERRQ(ierr);
850   ierr = PetscObjectComposeFunction((PetscObject)A,"MatMumpsSetIcntl_C",NULL);CHKERRQ(ierr);
851   ierr = PetscObjectComposeFunction((PetscObject)A,"MatMumpsGetIcntl_C",NULL);CHKERRQ(ierr);
852   ierr = PetscObjectComposeFunction((PetscObject)A,"MatMumpsSetCntl_C",NULL);CHKERRQ(ierr);
853   ierr = PetscObjectComposeFunction((PetscObject)A,"MatMumpsGetCntl_C",NULL);CHKERRQ(ierr);
854   ierr = PetscObjectComposeFunction((PetscObject)A,"MatMumpsGetInfo_C",NULL);CHKERRQ(ierr);
855   ierr = PetscObjectComposeFunction((PetscObject)A,"MatMumpsGetInfog_C",NULL);CHKERRQ(ierr);
856   ierr = PetscObjectComposeFunction((PetscObject)A,"MatMumpsGetRinfo_C",NULL);CHKERRQ(ierr);
857   ierr = PetscObjectComposeFunction((PetscObject)A,"MatMumpsGetRinfog_C",NULL);CHKERRQ(ierr);
858   PetscFunctionReturn(0);
859 }
860 
861 #undef __FUNCT__
862 #define __FUNCT__ "MatSolve_MUMPS"
863 PetscErrorCode MatSolve_MUMPS(Mat A,Vec b,Vec x)
864 {
865   Mat_MUMPS        *mumps=(Mat_MUMPS*)A->spptr;
866   PetscScalar      *array;
867   Vec              b_seq;
868   IS               is_iden,is_petsc;
869   PetscErrorCode   ierr;
870   PetscInt         i;
871   PetscBool        second_solve = PETSC_FALSE;
872   static PetscBool cite1 = PETSC_FALSE,cite2 = PETSC_FALSE;
873 
874   PetscFunctionBegin;
875   ierr = PetscCitationsRegister("@article{MUMPS01,\n  author = {P.~R. Amestoy and I.~S. Duff and J.-Y. L'Excellent and J. Koster},\n  title = {A fully asynchronous multifrontal solver using distributed dynamic scheduling},\n  journal = {SIAM Journal on Matrix Analysis and Applications},\n  volume = {23},\n  number = {1},\n  pages = {15--41},\n  year = {2001}\n}\n",&cite1);CHKERRQ(ierr);
876   ierr = PetscCitationsRegister("@article{MUMPS02,\n  author = {P.~R. Amestoy and A. Guermouche and J.-Y. L'Excellent and S. Pralet},\n  title = {Hybrid scheduling for the parallel solution of linear systems},\n  journal = {Parallel Computing},\n  volume = {32},\n  number = {2},\n  pages = {136--156},\n  year = {2006}\n}\n",&cite2);CHKERRQ(ierr);
877 
878   if (mumps->id.INFOG(1) == -6 || mumps->id.INFOG(1) == -10) {
879     ierr = PetscInfo2(A,"MatSolve is called with singular matrix factor, INFOG(1)=%d, INFO(2)=%d\n",mumps->id.INFOG(1),mumps->id.INFO(2));CHKERRQ(ierr);
880     ierr = VecSetInf(x);CHKERRQ(ierr);
881     PetscFunctionReturn(0);
882   }
883 
884   mumps->id.nrhs = 1;
885   b_seq          = mumps->b_seq;
886   if (mumps->size > 1) {
887     /* MUMPS only supports centralized rhs. Scatter b into a seqential rhs vector */
888     ierr = VecScatterBegin(mumps->scat_rhs,b,b_seq,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
889     ierr = VecScatterEnd(mumps->scat_rhs,b,b_seq,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
890     if (!mumps->myid) {ierr = VecGetArray(b_seq,&array);CHKERRQ(ierr);}
891   } else {  /* size == 1 */
892     ierr = VecCopy(b,x);CHKERRQ(ierr);
893     ierr = VecGetArray(x,&array);CHKERRQ(ierr);
894   }
895   if (!mumps->myid) { /* define rhs on the host */
896     mumps->id.nrhs = 1;
897     mumps->id.rhs = (MumpsScalar*)array;
898   }
899 
900   /*
901      handle condensation step of Schur complement (if any)
902      We set by default ICNTL(26) == -1 when Schur indices have been provided by the user.
903      According to MUMPS (5.0.0) manual, any value should be harmful during the factorization phase
904      Unless the user provides a valid value for ICNTL(26), MatSolve and MatMatSolve routines solve the full system.
905      This requires an extra call to PetscMUMPS_c and the computation of the factors for S
906   */
907   if (mumps->id.ICNTL(26) < 0 || mumps->id.ICNTL(26) > 2) {
908     second_solve = PETSC_TRUE;
909     ierr = MatMumpsHandleSchur_Private(mumps,PETSC_FALSE);CHKERRQ(ierr);
910   }
911   /* solve phase */
912   /*-------------*/
913   mumps->id.job = JOB_SOLVE;
914   PetscMUMPS_c(&mumps->id);
915   if (mumps->id.INFOG(1) < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in solve phase: INFOG(1)=%d\n",mumps->id.INFOG(1));
916 
917   /* handle expansion step of Schur complement (if any) */
918   if (second_solve) {
919     ierr = MatMumpsHandleSchur_Private(mumps,PETSC_TRUE);CHKERRQ(ierr);
920   }
921 
922   if (mumps->size > 1) { /* convert mumps distributed solution to petsc mpi x */
923     if (mumps->scat_sol && mumps->ICNTL9_pre != mumps->id.ICNTL(9)) {
924       /* when id.ICNTL(9) changes, the contents of lsol_loc may change (not its size, lsol_loc), recreates scat_sol */
925       ierr = VecScatterDestroy(&mumps->scat_sol);CHKERRQ(ierr);
926     }
927     if (!mumps->scat_sol) { /* create scatter scat_sol */
928       ierr = ISCreateStride(PETSC_COMM_SELF,mumps->id.lsol_loc,0,1,&is_iden);CHKERRQ(ierr); /* from */
929       for (i=0; i<mumps->id.lsol_loc; i++) {
930         mumps->id.isol_loc[i] -= 1; /* change Fortran style to C style */
931       }
932       ierr = ISCreateGeneral(PETSC_COMM_SELF,mumps->id.lsol_loc,mumps->id.isol_loc,PETSC_COPY_VALUES,&is_petsc);CHKERRQ(ierr);  /* to */
933       ierr = VecScatterCreate(mumps->x_seq,is_iden,x,is_petsc,&mumps->scat_sol);CHKERRQ(ierr);
934       ierr = ISDestroy(&is_iden);CHKERRQ(ierr);
935       ierr = ISDestroy(&is_petsc);CHKERRQ(ierr);
936 
937       mumps->ICNTL9_pre = mumps->id.ICNTL(9); /* save current value of id.ICNTL(9) */
938     }
939 
940     ierr = VecScatterBegin(mumps->scat_sol,mumps->x_seq,x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
941     ierr = VecScatterEnd(mumps->scat_sol,mumps->x_seq,x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
942   }
943   PetscFunctionReturn(0);
944 }
945 
946 #undef __FUNCT__
947 #define __FUNCT__ "MatSolveTranspose_MUMPS"
948 PetscErrorCode MatSolveTranspose_MUMPS(Mat A,Vec b,Vec x)
949 {
950   Mat_MUMPS      *mumps=(Mat_MUMPS*)A->spptr;
951   PetscErrorCode ierr;
952 
953   PetscFunctionBegin;
954   mumps->id.ICNTL(9) = 0;
955   ierr = MatSolve_MUMPS(A,b,x);CHKERRQ(ierr);
956   mumps->id.ICNTL(9) = 1;
957   PetscFunctionReturn(0);
958 }
959 
960 #undef __FUNCT__
961 #define __FUNCT__ "MatMatSolve_MUMPS"
962 PetscErrorCode MatMatSolve_MUMPS(Mat A,Mat B,Mat X)
963 {
964   PetscErrorCode ierr;
965   PetscBool      flg;
966   Mat_MUMPS      *mumps=(Mat_MUMPS*)A->spptr;
967   PetscInt       i,nrhs,M;
968   PetscScalar    *array,*bray;
969 
970   PetscFunctionBegin;
971   ierr = PetscObjectTypeCompareAny((PetscObject)B,&flg,MATSEQDENSE,MATMPIDENSE,NULL);CHKERRQ(ierr);
972   if (!flg) SETERRQ(PetscObjectComm((PetscObject)B),PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix");
973   ierr = PetscObjectTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,NULL);CHKERRQ(ierr);
974   if (!flg) SETERRQ(PetscObjectComm((PetscObject)X),PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix");
975   if (B->rmap->n != X->rmap->n) SETERRQ(PetscObjectComm((PetscObject)B),PETSC_ERR_ARG_WRONG,"Matrix B and X must have same row distribution");
976 
977   ierr = MatGetSize(B,&M,&nrhs);CHKERRQ(ierr);
978   mumps->id.nrhs = nrhs;
979   mumps->id.lrhs = M;
980 
981   if (mumps->size == 1) {
982     /* copy B to X */
983     ierr = MatDenseGetArray(B,&bray);CHKERRQ(ierr);
984     ierr = MatDenseGetArray(X,&array);CHKERRQ(ierr);
985     ierr = PetscMemcpy(array,bray,M*nrhs*sizeof(PetscScalar));CHKERRQ(ierr);
986     ierr = MatDenseRestoreArray(B,&bray);CHKERRQ(ierr);
987     mumps->id.rhs = (MumpsScalar*)array;
988     /* handle condensation step of Schur complement (if any) */
989     ierr = MatMumpsHandleSchur_Private(mumps,PETSC_FALSE);CHKERRQ(ierr);
990 
991     /* solve phase */
992     /*-------------*/
993     mumps->id.job = JOB_SOLVE;
994     PetscMUMPS_c(&mumps->id);
995     if (mumps->id.INFOG(1) < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in solve phase: INFOG(1)=%d\n",mumps->id.INFOG(1));
996 
997     /* handle expansion step of Schur complement (if any) */
998     ierr = MatMumpsHandleSchur_Private(mumps,PETSC_TRUE);CHKERRQ(ierr);
999     ierr = MatDenseRestoreArray(X,&array);CHKERRQ(ierr);
1000   } else {  /*--------- parallel case --------*/
1001     PetscInt       lsol_loc,nlsol_loc,*isol_loc,*idx,*iidx,*idxx,*isol_loc_save;
1002     MumpsScalar    *sol_loc,*sol_loc_save;
1003     IS             is_to,is_from;
1004     PetscInt       k,proc,j,m;
1005     const PetscInt *rstart;
1006     Vec            v_mpi,b_seq,x_seq;
1007     VecScatter     scat_rhs,scat_sol;
1008 
1009     /* create x_seq to hold local solution */
1010     isol_loc_save = mumps->id.isol_loc; /* save it for MatSovle() */
1011     sol_loc_save  = mumps->id.sol_loc;
1012 
1013     lsol_loc  = mumps->id.INFO(23);
1014     nlsol_loc = nrhs*lsol_loc;     /* length of sol_loc */
1015     ierr = PetscMalloc2(nlsol_loc,&sol_loc,nlsol_loc,&isol_loc);CHKERRQ(ierr);
1016     mumps->id.sol_loc = (MumpsScalar*)sol_loc;
1017     mumps->id.isol_loc = isol_loc;
1018 
1019     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,nlsol_loc,(PetscScalar*)sol_loc,&x_seq);CHKERRQ(ierr);
1020 
1021     /* copy rhs matrix B into vector v_mpi */
1022     ierr = MatGetLocalSize(B,&m,NULL);CHKERRQ(ierr);
1023     ierr = MatDenseGetArray(B,&bray);CHKERRQ(ierr);
1024     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),1,nrhs*m,nrhs*M,(const PetscScalar*)bray,&v_mpi);CHKERRQ(ierr);
1025     ierr = MatDenseRestoreArray(B,&bray);CHKERRQ(ierr);
1026 
1027     /* scatter v_mpi to b_seq because MUMPS only supports centralized rhs */
1028     /* idx: maps from k-th index of v_mpi to (i,j)-th global entry of B;
1029       iidx: inverse of idx, will be used by scattering xx_seq -> X       */
1030     ierr = PetscMalloc2(nrhs*M,&idx,nrhs*M,&iidx);CHKERRQ(ierr);
1031     ierr = MatGetOwnershipRanges(B,&rstart);CHKERRQ(ierr);
1032     k = 0;
1033     for (proc=0; proc<mumps->size; proc++){
1034       for (j=0; j<nrhs; j++){
1035         for (i=rstart[proc]; i<rstart[proc+1]; i++){
1036           iidx[j*M + i] = k;
1037           idx[k++]      = j*M + i;
1038         }
1039       }
1040     }
1041 
1042     if (!mumps->myid) {
1043       ierr = VecCreateSeq(PETSC_COMM_SELF,nrhs*M,&b_seq);CHKERRQ(ierr);
1044       ierr = ISCreateGeneral(PETSC_COMM_SELF,nrhs*M,idx,PETSC_COPY_VALUES,&is_to);CHKERRQ(ierr);
1045       ierr = ISCreateStride(PETSC_COMM_SELF,nrhs*M,0,1,&is_from);CHKERRQ(ierr);
1046     } else {
1047       ierr = VecCreateSeq(PETSC_COMM_SELF,0,&b_seq);CHKERRQ(ierr);
1048       ierr = ISCreateStride(PETSC_COMM_SELF,0,0,1,&is_to);CHKERRQ(ierr);
1049       ierr = ISCreateStride(PETSC_COMM_SELF,0,0,1,&is_from);CHKERRQ(ierr);
1050     }
1051     ierr = VecScatterCreate(v_mpi,is_from,b_seq,is_to,&scat_rhs);CHKERRQ(ierr);
1052     ierr = VecScatterBegin(scat_rhs,v_mpi,b_seq,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1053     ierr = ISDestroy(&is_to);CHKERRQ(ierr);
1054     ierr = ISDestroy(&is_from);CHKERRQ(ierr);
1055     ierr = VecScatterEnd(scat_rhs,v_mpi,b_seq,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1056 
1057     if (!mumps->myid) { /* define rhs on the host */
1058       ierr = VecGetArray(b_seq,&bray);CHKERRQ(ierr);
1059       mumps->id.rhs = (MumpsScalar*)bray;
1060       ierr = VecRestoreArray(b_seq,&bray);CHKERRQ(ierr);
1061     }
1062 
1063     /* solve phase */
1064     /*-------------*/
1065     mumps->id.job = JOB_SOLVE;
1066     PetscMUMPS_c(&mumps->id);
1067     if (mumps->id.INFOG(1) < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in solve phase: INFOG(1)=%d\n",mumps->id.INFOG(1));
1068 
1069     /* scatter mumps distributed solution to petsc vector v_mpi, which shares local arrays with solution matrix X */
1070     ierr = MatDenseGetArray(X,&array);CHKERRQ(ierr);
1071     ierr = VecPlaceArray(v_mpi,array);CHKERRQ(ierr);
1072 
1073     /* create scatter scat_sol */
1074     ierr = PetscMalloc1(nlsol_loc,&idxx);CHKERRQ(ierr);
1075     ierr = ISCreateStride(PETSC_COMM_SELF,nlsol_loc,0,1,&is_from);CHKERRQ(ierr);
1076     for (i=0; i<lsol_loc; i++) {
1077       isol_loc[i] -= 1; /* change Fortran style to C style */
1078       idxx[i] = iidx[isol_loc[i]];
1079       for (j=1; j<nrhs; j++){
1080         idxx[j*lsol_loc+i] = iidx[isol_loc[i]+j*M];
1081       }
1082     }
1083     ierr = ISCreateGeneral(PETSC_COMM_SELF,nlsol_loc,idxx,PETSC_COPY_VALUES,&is_to);CHKERRQ(ierr);
1084     ierr = VecScatterCreate(x_seq,is_from,v_mpi,is_to,&scat_sol);CHKERRQ(ierr);
1085     ierr = VecScatterBegin(scat_sol,x_seq,v_mpi,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1086     ierr = ISDestroy(&is_from);CHKERRQ(ierr);
1087     ierr = ISDestroy(&is_to);CHKERRQ(ierr);
1088     ierr = VecScatterEnd(scat_sol,x_seq,v_mpi,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1089     ierr = MatDenseRestoreArray(X,&array);CHKERRQ(ierr);
1090 
1091     /* free spaces */
1092     mumps->id.sol_loc = sol_loc_save;
1093     mumps->id.isol_loc = isol_loc_save;
1094 
1095     ierr = PetscFree2(sol_loc,isol_loc);CHKERRQ(ierr);
1096     ierr = PetscFree2(idx,iidx);CHKERRQ(ierr);
1097     ierr = PetscFree(idxx);CHKERRQ(ierr);
1098     ierr = VecDestroy(&x_seq);CHKERRQ(ierr);
1099     ierr = VecDestroy(&v_mpi);CHKERRQ(ierr);
1100     ierr = VecDestroy(&b_seq);CHKERRQ(ierr);
1101     ierr = VecScatterDestroy(&scat_rhs);CHKERRQ(ierr);
1102     ierr = VecScatterDestroy(&scat_sol);CHKERRQ(ierr);
1103   }
1104   PetscFunctionReturn(0);
1105 }
1106 
1107 #if !defined(PETSC_USE_COMPLEX)
1108 /*
1109   input:
1110    F:        numeric factor
1111   output:
1112    nneg:     total number of negative pivots
1113    nzero:    0
1114    npos:     (global dimension of F) - nneg
1115 */
1116 
1117 #undef __FUNCT__
1118 #define __FUNCT__ "MatGetInertia_SBAIJMUMPS"
1119 PetscErrorCode MatGetInertia_SBAIJMUMPS(Mat F,int *nneg,int *nzero,int *npos)
1120 {
1121   Mat_MUMPS      *mumps =(Mat_MUMPS*)F->spptr;
1122   PetscErrorCode ierr;
1123   PetscMPIInt    size;
1124 
1125   PetscFunctionBegin;
1126   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)F),&size);CHKERRQ(ierr);
1127   /* MUMPS 4.3.1 calls ScaLAPACK when ICNTL(13)=0 (default), which does not offer the possibility to compute the inertia of a dense matrix. Set ICNTL(13)=1 to skip ScaLAPACK */
1128   if (size > 1 && mumps->id.ICNTL(13) != 1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"ICNTL(13)=%d. -mat_mumps_icntl_13 must be set as 1 for correct global matrix inertia\n",mumps->id.INFOG(13));
1129 
1130   if (nneg) *nneg = mumps->id.INFOG(12);
1131   if (nzero || npos) {
1132     if (mumps->id.ICNTL(24) != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"-mat_mumps_icntl_24 must be set as 1 for null pivot row detection");
1133     if (nzero) *nzero = mumps->id.INFOG(28);
1134     if (npos) *npos   = F->rmap->N - (mumps->id.INFOG(12) + mumps->id.INFOG(28));
1135   }
1136   PetscFunctionReturn(0);
1137 }
1138 #endif /* !defined(PETSC_USE_COMPLEX) */
1139 
1140 #undef __FUNCT__
1141 #define __FUNCT__ "MatFactorNumeric_MUMPS"
1142 PetscErrorCode MatFactorNumeric_MUMPS(Mat F,Mat A,MatFactorInfo *info)
1143 {
1144   Mat_MUMPS      *mumps =(Mat_MUMPS*)(F)->spptr;
1145   PetscErrorCode ierr;
1146   Mat            F_diag;
1147   PetscBool      isMPIAIJ;
1148 
1149   PetscFunctionBegin;
1150   if (mumps->id.INFOG(1) == -6) {
1151     ierr = PetscInfo2(A,"MatFactorNumeric is called with singular matrix structure, INFOG(1)=%d, INFO(2)=%d\n",mumps->id.INFOG(1),mumps->id.INFO(2));CHKERRQ(ierr);
1152     PetscFunctionReturn(0);
1153   }
1154   ierr = (*mumps->ConvertToTriples)(A, 1, MAT_REUSE_MATRIX, &mumps->nz, &mumps->irn, &mumps->jcn, &mumps->val);CHKERRQ(ierr);
1155 
1156   /* numerical factorization phase */
1157   /*-------------------------------*/
1158   mumps->id.job = JOB_FACTNUMERIC;
1159   if (!mumps->id.ICNTL(18)) { /* A is centralized */
1160     if (!mumps->myid) {
1161       mumps->id.a = (MumpsScalar*)mumps->val;
1162     }
1163   } else {
1164     mumps->id.a_loc = (MumpsScalar*)mumps->val;
1165   }
1166   PetscMUMPS_c(&mumps->id);
1167   if (mumps->id.INFOG(1) < 0) {
1168     if (mumps->id.INFOG(1) == -13) {
1169       if (mumps->id.INFO(2) < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in numerical factorization phase: Cannot allocate required memory %d megabytes\n",-mumps->id.INFO(2));
1170       else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in numerical factorization phase: Cannot allocate required memory %d bytes\n",mumps->id.INFO(2));
1171     } else if (mumps->id.INFOG(1) == -10) { /* numerically singular matrix */
1172       if (!A->erroriffpe) {
1173         ierr = PetscInfo2(F,"matrix is numerically singular, INFOG(1)=%d, INFO(2)=%d\n",mumps->id.INFOG(1),mumps->id.INFO(2));CHKERRQ(ierr);
1174         info->errortype = MAT_FACTOR_NUMERIC_ZEROPIVOT;
1175       } else {
1176         SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in numerical factorization phase: INFOG(1)=%d, INFO(2)=%d, matrix is numerically singular\n",mumps->id.INFOG(1),mumps->id.INFO(2));
1177       }
1178     } else {
1179       SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in numerical factorization phase: INFOG(1)=%d, INFO(2)=%d\n",mumps->id.INFOG(1),mumps->id.INFO(2));
1180     }
1181   }
1182   if (!mumps->myid && mumps->id.ICNTL(16) > 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"  mumps->id.ICNTL(16):=%d\n",mumps->id.INFOG(16));
1183 
1184   (F)->assembled        = PETSC_TRUE;
1185   mumps->matstruc       = SAME_NONZERO_PATTERN;
1186   mumps->schur_factored = PETSC_FALSE;
1187   mumps->schur_inverted = PETSC_FALSE;
1188 
1189   /* just to be sure that ICNTL(19) value returned by a call from MatMumpsGetIcntl is always consistent */
1190   if (!mumps->sym && mumps->id.ICNTL(19) && mumps->id.ICNTL(19) != 1) mumps->id.ICNTL(19) = 3;
1191 
1192   if (mumps->size > 1) {
1193     PetscInt    lsol_loc;
1194     PetscScalar *sol_loc;
1195 
1196     ierr = PetscObjectTypeCompare((PetscObject)A,MATMPIAIJ,&isMPIAIJ);CHKERRQ(ierr);
1197     if (isMPIAIJ) F_diag = ((Mat_MPIAIJ*)(F)->data)->A;
1198     else F_diag = ((Mat_MPISBAIJ*)(F)->data)->A;
1199     F_diag->assembled = PETSC_TRUE;
1200 
1201     /* distributed solution; Create x_seq=sol_loc for repeated use */
1202     if (mumps->x_seq) {
1203       ierr = VecScatterDestroy(&mumps->scat_sol);CHKERRQ(ierr);
1204       ierr = PetscFree2(mumps->id.sol_loc,mumps->id.isol_loc);CHKERRQ(ierr);
1205       ierr = VecDestroy(&mumps->x_seq);CHKERRQ(ierr);
1206     }
1207     lsol_loc = mumps->id.INFO(23); /* length of sol_loc */
1208     ierr = PetscMalloc2(lsol_loc,&sol_loc,lsol_loc,&mumps->id.isol_loc);CHKERRQ(ierr);
1209     mumps->id.lsol_loc = lsol_loc;
1210     mumps->id.sol_loc = (MumpsScalar*)sol_loc;
1211     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lsol_loc,sol_loc,&mumps->x_seq);CHKERRQ(ierr);
1212   }
1213   PetscFunctionReturn(0);
1214 }
1215 
1216 /* Sets MUMPS options from the options database */
1217 #undef __FUNCT__
1218 #define __FUNCT__ "PetscSetMUMPSFromOptions"
1219 PetscErrorCode PetscSetMUMPSFromOptions(Mat F, Mat A)
1220 {
1221   Mat_MUMPS      *mumps = (Mat_MUMPS*)F->spptr;
1222   PetscErrorCode ierr;
1223   PetscInt       icntl,info[40],i,ninfo=40;
1224   PetscBool      flg;
1225 
1226   PetscFunctionBegin;
1227   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)A),((PetscObject)A)->prefix,"MUMPS Options","Mat");CHKERRQ(ierr);
1228   ierr = PetscOptionsInt("-mat_mumps_icntl_1","ICNTL(1): output stream for error messages","None",mumps->id.ICNTL(1),&icntl,&flg);CHKERRQ(ierr);
1229   if (flg) mumps->id.ICNTL(1) = icntl;
1230   ierr = PetscOptionsInt("-mat_mumps_icntl_2","ICNTL(2): output stream for diagnostic printing, statistics, and warning","None",mumps->id.ICNTL(2),&icntl,&flg);CHKERRQ(ierr);
1231   if (flg) mumps->id.ICNTL(2) = icntl;
1232   ierr = PetscOptionsInt("-mat_mumps_icntl_3","ICNTL(3): output stream for global information, collected on the host","None",mumps->id.ICNTL(3),&icntl,&flg);CHKERRQ(ierr);
1233   if (flg) mumps->id.ICNTL(3) = icntl;
1234 
1235   ierr = PetscOptionsInt("-mat_mumps_icntl_4","ICNTL(4): level of printing (0 to 4)","None",mumps->id.ICNTL(4),&icntl,&flg);CHKERRQ(ierr);
1236   if (flg) mumps->id.ICNTL(4) = icntl;
1237   if (mumps->id.ICNTL(4) || PetscLogPrintInfo) mumps->id.ICNTL(3) = 6; /* resume MUMPS default id.ICNTL(3) = 6 */
1238 
1239   ierr = PetscOptionsInt("-mat_mumps_icntl_6","ICNTL(6): permutes to a zero-free diagonal and/or scale the matrix (0 to 7)","None",mumps->id.ICNTL(6),&icntl,&flg);CHKERRQ(ierr);
1240   if (flg) mumps->id.ICNTL(6) = icntl;
1241 
1242   ierr = PetscOptionsInt("-mat_mumps_icntl_7","ICNTL(7): computes a symmetric permutation in sequential analysis (0 to 7). 3=Scotch, 4=PORD, 5=Metis","None",mumps->id.ICNTL(7),&icntl,&flg);CHKERRQ(ierr);
1243   if (flg) {
1244     if (icntl== 1 && mumps->size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"pivot order be set by the user in PERM_IN -- not supported by the PETSc/MUMPS interface\n");
1245     else mumps->id.ICNTL(7) = icntl;
1246   }
1247 
1248   ierr = PetscOptionsInt("-mat_mumps_icntl_8","ICNTL(8): scaling strategy (-2 to 8 or 77)","None",mumps->id.ICNTL(8),&mumps->id.ICNTL(8),NULL);CHKERRQ(ierr);
1249   /* ierr = PetscOptionsInt("-mat_mumps_icntl_9","ICNTL(9): computes the solution using A or A^T","None",mumps->id.ICNTL(9),&mumps->id.ICNTL(9),NULL);CHKERRQ(ierr); handled by MatSolveTranspose_MUMPS() */
1250   ierr = PetscOptionsInt("-mat_mumps_icntl_10","ICNTL(10): max num of refinements","None",mumps->id.ICNTL(10),&mumps->id.ICNTL(10),NULL);CHKERRQ(ierr);
1251   ierr = PetscOptionsInt("-mat_mumps_icntl_11","ICNTL(11): statistics related to an error analysis (via -ksp_view)","None",mumps->id.ICNTL(11),&mumps->id.ICNTL(11),NULL);CHKERRQ(ierr);
1252   ierr = PetscOptionsInt("-mat_mumps_icntl_12","ICNTL(12): an ordering strategy for symmetric matrices (0 to 3)","None",mumps->id.ICNTL(12),&mumps->id.ICNTL(12),NULL);CHKERRQ(ierr);
1253   ierr = PetscOptionsInt("-mat_mumps_icntl_13","ICNTL(13): parallelism of the root node (enable ScaLAPACK) and its splitting","None",mumps->id.ICNTL(13),&mumps->id.ICNTL(13),NULL);CHKERRQ(ierr);
1254   ierr = PetscOptionsInt("-mat_mumps_icntl_14","ICNTL(14): percentage increase in the estimated working space","None",mumps->id.ICNTL(14),&mumps->id.ICNTL(14),NULL);CHKERRQ(ierr);
1255   ierr = PetscOptionsInt("-mat_mumps_icntl_19","ICNTL(19): computes the Schur complement","None",mumps->id.ICNTL(19),&mumps->id.ICNTL(19),NULL);CHKERRQ(ierr);
1256   if (mumps->id.ICNTL(19) <= 0 || mumps->id.ICNTL(19) > 3) { /* reset any schur data (if any) */
1257     ierr = MatMumpsResetSchur_Private(mumps);CHKERRQ(ierr);
1258   }
1259   /* ierr = PetscOptionsInt("-mat_mumps_icntl_20","ICNTL(20): the format (dense or sparse) of the right-hand sides","None",mumps->id.ICNTL(20),&mumps->id.ICNTL(20),NULL);CHKERRQ(ierr); -- sparse rhs is not supported in PETSc API */
1260   /* ierr = PetscOptionsInt("-mat_mumps_icntl_21","ICNTL(21): the distribution (centralized or distributed) of the solution vectors","None",mumps->id.ICNTL(21),&mumps->id.ICNTL(21),NULL);CHKERRQ(ierr); we only use distributed solution vector */
1261 
1262   ierr = PetscOptionsInt("-mat_mumps_icntl_22","ICNTL(22): in-core/out-of-core factorization and solve (0 or 1)","None",mumps->id.ICNTL(22),&mumps->id.ICNTL(22),NULL);CHKERRQ(ierr);
1263   ierr = PetscOptionsInt("-mat_mumps_icntl_23","ICNTL(23): max size of the working memory (MB) that can allocate per processor","None",mumps->id.ICNTL(23),&mumps->id.ICNTL(23),NULL);CHKERRQ(ierr);
1264   ierr = PetscOptionsInt("-mat_mumps_icntl_24","ICNTL(24): detection of null pivot rows (0 or 1)","None",mumps->id.ICNTL(24),&mumps->id.ICNTL(24),NULL);CHKERRQ(ierr);
1265   if (mumps->id.ICNTL(24)) {
1266     mumps->id.ICNTL(13) = 1; /* turn-off ScaLAPACK to help with the correct detection of null pivots */
1267   }
1268 
1269   ierr = PetscOptionsInt("-mat_mumps_icntl_25","ICNTL(25): compute a solution of a deficient matrix and a null space basis","None",mumps->id.ICNTL(25),&mumps->id.ICNTL(25),NULL);CHKERRQ(ierr);
1270   ierr = PetscOptionsInt("-mat_mumps_icntl_26","ICNTL(26): drives the solution phase if a Schur complement matrix","None",mumps->id.ICNTL(26),&mumps->id.ICNTL(26),NULL);CHKERRQ(ierr);
1271   ierr = PetscOptionsInt("-mat_mumps_icntl_27","ICNTL(27): the blocking size for multiple right-hand sides","None",mumps->id.ICNTL(27),&mumps->id.ICNTL(27),NULL);CHKERRQ(ierr);
1272   ierr = PetscOptionsInt("-mat_mumps_icntl_28","ICNTL(28): use 1 for sequential analysis and ictnl(7) ordering, or 2 for parallel analysis and ictnl(29) ordering","None",mumps->id.ICNTL(28),&mumps->id.ICNTL(28),NULL);CHKERRQ(ierr);
1273   ierr = PetscOptionsInt("-mat_mumps_icntl_29","ICNTL(29): parallel ordering 1 = ptscotch, 2 = parmetis","None",mumps->id.ICNTL(29),&mumps->id.ICNTL(29),NULL);CHKERRQ(ierr);
1274   ierr = PetscOptionsInt("-mat_mumps_icntl_30","ICNTL(30): compute user-specified set of entries in inv(A)","None",mumps->id.ICNTL(30),&mumps->id.ICNTL(30),NULL);CHKERRQ(ierr);
1275   ierr = PetscOptionsInt("-mat_mumps_icntl_31","ICNTL(31): indicates which factors may be discarded during factorization","None",mumps->id.ICNTL(31),&mumps->id.ICNTL(31),NULL);CHKERRQ(ierr);
1276   /* ierr = PetscOptionsInt("-mat_mumps_icntl_32","ICNTL(32): performs the forward elemination of the right-hand sides during factorization","None",mumps->id.ICNTL(32),&mumps->id.ICNTL(32),NULL);CHKERRQ(ierr);  -- not supported by PETSc API */
1277   ierr = PetscOptionsInt("-mat_mumps_icntl_33","ICNTL(33): compute determinant","None",mumps->id.ICNTL(33),&mumps->id.ICNTL(33),NULL);CHKERRQ(ierr);
1278 
1279   ierr = PetscOptionsReal("-mat_mumps_cntl_1","CNTL(1): relative pivoting threshold","None",mumps->id.CNTL(1),&mumps->id.CNTL(1),NULL);CHKERRQ(ierr);
1280   ierr = PetscOptionsReal("-mat_mumps_cntl_2","CNTL(2): stopping criterion of refinement","None",mumps->id.CNTL(2),&mumps->id.CNTL(2),NULL);CHKERRQ(ierr);
1281   ierr = PetscOptionsReal("-mat_mumps_cntl_3","CNTL(3): absolute pivoting threshold","None",mumps->id.CNTL(3),&mumps->id.CNTL(3),NULL);CHKERRQ(ierr);
1282   ierr = PetscOptionsReal("-mat_mumps_cntl_4","CNTL(4): value for static pivoting","None",mumps->id.CNTL(4),&mumps->id.CNTL(4),NULL);CHKERRQ(ierr);
1283   ierr = PetscOptionsReal("-mat_mumps_cntl_5","CNTL(5): fixation for null pivots","None",mumps->id.CNTL(5),&mumps->id.CNTL(5),NULL);CHKERRQ(ierr);
1284 
1285   ierr = PetscOptionsString("-mat_mumps_ooc_tmpdir", "out of core directory", "None", mumps->id.ooc_tmpdir, mumps->id.ooc_tmpdir, 256, NULL);
1286 
1287   ierr = PetscOptionsIntArray("-mat_mumps_view_info","request INFO local to each processor","",info,&ninfo,NULL);CHKERRQ(ierr);
1288   if (ninfo) {
1289     if (ninfo > 40) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"number of INFO %d must <= 40\n",ninfo);
1290     ierr = PetscMalloc1(ninfo,&mumps->info);CHKERRQ(ierr);
1291     mumps->ninfo = ninfo;
1292     for (i=0; i<ninfo; i++) {
1293       if (info[i] < 0 || info[i]>40) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_USER,"index of INFO %d must between 1 and 40\n",ninfo);
1294       else {
1295         mumps->info[i] = info[i];
1296       }
1297     }
1298   }
1299 
1300   PetscOptionsEnd();
1301   PetscFunctionReturn(0);
1302 }
1303 
1304 #undef __FUNCT__
1305 #define __FUNCT__ "PetscInitializeMUMPS"
1306 PetscErrorCode PetscInitializeMUMPS(Mat A,Mat_MUMPS *mumps)
1307 {
1308   PetscErrorCode ierr;
1309 
1310   PetscFunctionBegin;
1311   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A), &mumps->myid);
1312   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)A),&mumps->size);CHKERRQ(ierr);
1313   ierr = MPI_Comm_dup(PetscObjectComm((PetscObject)A),&(mumps->comm_mumps));CHKERRQ(ierr);
1314 
1315   mumps->id.comm_fortran = MPI_Comm_c2f(mumps->comm_mumps);
1316 
1317   mumps->id.job = JOB_INIT;
1318   mumps->id.par = 1;  /* host participates factorizaton and solve */
1319   mumps->id.sym = mumps->sym;
1320   PetscMUMPS_c(&mumps->id);
1321 
1322   mumps->scat_rhs     = NULL;
1323   mumps->scat_sol     = NULL;
1324 
1325   /* set PETSc-MUMPS default options - override MUMPS default */
1326   mumps->id.ICNTL(3) = 0;
1327   mumps->id.ICNTL(4) = 0;
1328   if (mumps->size == 1) {
1329     mumps->id.ICNTL(18) = 0;   /* centralized assembled matrix input */
1330   } else {
1331     mumps->id.ICNTL(18) = 3;   /* distributed assembled matrix input */
1332     mumps->id.ICNTL(20) = 0;   /* rhs is in dense format */
1333     mumps->id.ICNTL(21) = 1;   /* distributed solution */
1334   }
1335 
1336   /* schur */
1337   mumps->id.size_schur      = 0;
1338   mumps->id.listvar_schur   = NULL;
1339   mumps->id.schur           = NULL;
1340   mumps->sizeredrhs         = 0;
1341   mumps->schur_pivots       = NULL;
1342   mumps->schur_work         = NULL;
1343   mumps->schur_sol          = NULL;
1344   mumps->schur_sizesol      = 0;
1345   mumps->schur_factored     = PETSC_FALSE;
1346   mumps->schur_inverted     = PETSC_FALSE;
1347   PetscFunctionReturn(0);
1348 }
1349 
1350 /* Note Petsc r(=c) permutation is used when mumps->id.ICNTL(7)==1 with centralized assembled matrix input; otherwise r and c are ignored */
1351 #undef __FUNCT__
1352 #define __FUNCT__ "MatLUFactorSymbolic_AIJMUMPS"
1353 PetscErrorCode MatLUFactorSymbolic_AIJMUMPS(Mat F,Mat A,IS r,IS c,MatFactorInfo *info)
1354 {
1355   Mat_MUMPS      *mumps = (Mat_MUMPS*)F->spptr;
1356   PetscErrorCode ierr;
1357   Vec            b;
1358   IS             is_iden;
1359   const PetscInt M = A->rmap->N;
1360 
1361   PetscFunctionBegin;
1362   mumps->matstruc = DIFFERENT_NONZERO_PATTERN;
1363 
1364   /* Set MUMPS options from the options database */
1365   ierr = PetscSetMUMPSFromOptions(F,A);CHKERRQ(ierr);
1366 
1367   ierr = (*mumps->ConvertToTriples)(A, 1, MAT_INITIAL_MATRIX, &mumps->nz, &mumps->irn, &mumps->jcn, &mumps->val);CHKERRQ(ierr);
1368 
1369   /* analysis phase */
1370   /*----------------*/
1371   mumps->id.job = JOB_FACTSYMBOLIC;
1372   mumps->id.n   = M;
1373   switch (mumps->id.ICNTL(18)) {
1374   case 0:  /* centralized assembled matrix input */
1375     if (!mumps->myid) {
1376       mumps->id.nz =mumps->nz; mumps->id.irn=mumps->irn; mumps->id.jcn=mumps->jcn;
1377       if (mumps->id.ICNTL(6)>1) {
1378         mumps->id.a = (MumpsScalar*)mumps->val;
1379       }
1380       if (mumps->id.ICNTL(7) == 1) { /* use user-provide matrix ordering - assuming r = c ordering */
1381         /*
1382         PetscBool      flag;
1383         ierr = ISEqual(r,c,&flag);CHKERRQ(ierr);
1384         if (!flag) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"row_perm != col_perm");
1385         ierr = ISView(r,PETSC_VIEWER_STDOUT_SELF);
1386          */
1387         if (!mumps->myid) {
1388           const PetscInt *idx;
1389           PetscInt       i,*perm_in;
1390 
1391           ierr = PetscMalloc1(M,&perm_in);CHKERRQ(ierr);
1392           ierr = ISGetIndices(r,&idx);CHKERRQ(ierr);
1393 
1394           mumps->id.perm_in = perm_in;
1395           for (i=0; i<M; i++) perm_in[i] = idx[i]+1; /* perm_in[]: start from 1, not 0! */
1396           ierr = ISRestoreIndices(r,&idx);CHKERRQ(ierr);
1397         }
1398       }
1399     }
1400     break;
1401   case 3:  /* distributed assembled matrix input (size>1) */
1402     mumps->id.nz_loc = mumps->nz;
1403     mumps->id.irn_loc=mumps->irn; mumps->id.jcn_loc=mumps->jcn;
1404     if (mumps->id.ICNTL(6)>1) {
1405       mumps->id.a_loc = (MumpsScalar*)mumps->val;
1406     }
1407     /* MUMPS only supports centralized rhs. Create scatter scat_rhs for repeated use in MatSolve() */
1408     if (!mumps->myid) {
1409       ierr = VecCreateSeq(PETSC_COMM_SELF,A->rmap->N,&mumps->b_seq);CHKERRQ(ierr);
1410       ierr = ISCreateStride(PETSC_COMM_SELF,A->rmap->N,0,1,&is_iden);CHKERRQ(ierr);
1411     } else {
1412       ierr = VecCreateSeq(PETSC_COMM_SELF,0,&mumps->b_seq);CHKERRQ(ierr);
1413       ierr = ISCreateStride(PETSC_COMM_SELF,0,0,1,&is_iden);CHKERRQ(ierr);
1414     }
1415     ierr = MatCreateVecs(A,NULL,&b);CHKERRQ(ierr);
1416     ierr = VecScatterCreate(b,is_iden,mumps->b_seq,is_iden,&mumps->scat_rhs);CHKERRQ(ierr);
1417     ierr = ISDestroy(&is_iden);CHKERRQ(ierr);
1418     ierr = VecDestroy(&b);CHKERRQ(ierr);
1419     break;
1420   }
1421   PetscMUMPS_c(&mumps->id);
1422   if (mumps->id.INFOG(1) < 0) {
1423     if (mumps->id.INFOG(1) == -6) {
1424       if (!A->erroriffpe) {
1425         ierr = PetscInfo2(F,"matrix is singular in structure, INFOG(1)=%d, INFO(2)=%d\n",mumps->id.INFOG(1),mumps->id.INFO(2));CHKERRQ(ierr);
1426       } else {
1427         SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in analysis phase: INFOG(1)=%d, INFO(2)=%d, matrix is numerically singular\n",mumps->id.INFOG(1),mumps->id.INFO(2));
1428       }
1429     } else {
1430       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in analysis phase: INFOG(1)=%d\n",mumps->id.INFOG(1));
1431     }
1432   }
1433 
1434   F->ops->lufactornumeric = MatFactorNumeric_MUMPS;
1435   F->ops->solve           = MatSolve_MUMPS;
1436   F->ops->solvetranspose  = MatSolveTranspose_MUMPS;
1437   F->ops->matsolve        = MatMatSolve_MUMPS;
1438   PetscFunctionReturn(0);
1439 }
1440 
1441 /* Note the Petsc r and c permutations are ignored */
1442 #undef __FUNCT__
1443 #define __FUNCT__ "MatLUFactorSymbolic_BAIJMUMPS"
1444 PetscErrorCode MatLUFactorSymbolic_BAIJMUMPS(Mat F,Mat A,IS r,IS c,MatFactorInfo *info)
1445 {
1446   Mat_MUMPS      *mumps = (Mat_MUMPS*)F->spptr;
1447   PetscErrorCode ierr;
1448   Vec            b;
1449   IS             is_iden;
1450   const PetscInt M = A->rmap->N;
1451 
1452   PetscFunctionBegin;
1453   mumps->matstruc = DIFFERENT_NONZERO_PATTERN;
1454 
1455   /* Set MUMPS options from the options database */
1456   ierr = PetscSetMUMPSFromOptions(F,A);CHKERRQ(ierr);
1457 
1458   ierr = (*mumps->ConvertToTriples)(A, 1, MAT_INITIAL_MATRIX, &mumps->nz, &mumps->irn, &mumps->jcn, &mumps->val);CHKERRQ(ierr);
1459 
1460   /* analysis phase */
1461   /*----------------*/
1462   mumps->id.job = JOB_FACTSYMBOLIC;
1463   mumps->id.n   = M;
1464   switch (mumps->id.ICNTL(18)) {
1465   case 0:  /* centralized assembled matrix input */
1466     if (!mumps->myid) {
1467       mumps->id.nz =mumps->nz; mumps->id.irn=mumps->irn; mumps->id.jcn=mumps->jcn;
1468       if (mumps->id.ICNTL(6)>1) {
1469         mumps->id.a = (MumpsScalar*)mumps->val;
1470       }
1471     }
1472     break;
1473   case 3:  /* distributed assembled matrix input (size>1) */
1474     mumps->id.nz_loc = mumps->nz;
1475     mumps->id.irn_loc=mumps->irn; mumps->id.jcn_loc=mumps->jcn;
1476     if (mumps->id.ICNTL(6)>1) {
1477       mumps->id.a_loc = (MumpsScalar*)mumps->val;
1478     }
1479     /* MUMPS only supports centralized rhs. Create scatter scat_rhs for repeated use in MatSolve() */
1480     if (!mumps->myid) {
1481       ierr = VecCreateSeq(PETSC_COMM_SELF,A->cmap->N,&mumps->b_seq);CHKERRQ(ierr);
1482       ierr = ISCreateStride(PETSC_COMM_SELF,A->cmap->N,0,1,&is_iden);CHKERRQ(ierr);
1483     } else {
1484       ierr = VecCreateSeq(PETSC_COMM_SELF,0,&mumps->b_seq);CHKERRQ(ierr);
1485       ierr = ISCreateStride(PETSC_COMM_SELF,0,0,1,&is_iden);CHKERRQ(ierr);
1486     }
1487     ierr = MatCreateVecs(A,NULL,&b);CHKERRQ(ierr);
1488     ierr = VecScatterCreate(b,is_iden,mumps->b_seq,is_iden,&mumps->scat_rhs);CHKERRQ(ierr);
1489     ierr = ISDestroy(&is_iden);CHKERRQ(ierr);
1490     ierr = VecDestroy(&b);CHKERRQ(ierr);
1491     break;
1492   }
1493   PetscMUMPS_c(&mumps->id);
1494   if (mumps->id.INFOG(1) < 0) {
1495     if (mumps->id.INFOG(1) == -6) {
1496       if (!A->erroriffpe) {
1497         ierr = PetscInfo2(F,"matrix is singular in structure, INFOG(1)=%d, INFO(2)=%d\n",mumps->id.INFOG(1),mumps->id.INFO(2));CHKERRQ(ierr);
1498       } else {
1499         SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in analysis phase: INFOG(1)=%d, INFO(2)=%d, matrix is numerically singular\n",mumps->id.INFOG(1),mumps->id.INFO(2));
1500       }
1501     } else {
1502       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in analysis phase: INFOG(1)=%d\n",mumps->id.INFOG(1));
1503     }
1504   }
1505 
1506   F->ops->lufactornumeric = MatFactorNumeric_MUMPS;
1507   F->ops->solve           = MatSolve_MUMPS;
1508   F->ops->solvetranspose  = MatSolveTranspose_MUMPS;
1509   PetscFunctionReturn(0);
1510 }
1511 
1512 /* Note the Petsc r permutation and factor info are ignored */
1513 #undef __FUNCT__
1514 #define __FUNCT__ "MatCholeskyFactorSymbolic_MUMPS"
1515 PetscErrorCode MatCholeskyFactorSymbolic_MUMPS(Mat F,Mat A,IS r,MatFactorInfo *info)
1516 {
1517   Mat_MUMPS      *mumps = (Mat_MUMPS*)F->spptr;
1518   PetscErrorCode ierr;
1519   Vec            b;
1520   IS             is_iden;
1521   const PetscInt M = A->rmap->N;
1522 
1523   PetscFunctionBegin;
1524   mumps->matstruc = DIFFERENT_NONZERO_PATTERN;
1525 
1526   /* Set MUMPS options from the options database */
1527   ierr = PetscSetMUMPSFromOptions(F,A);CHKERRQ(ierr);
1528 
1529   ierr = (*mumps->ConvertToTriples)(A, 1, MAT_INITIAL_MATRIX, &mumps->nz, &mumps->irn, &mumps->jcn, &mumps->val);CHKERRQ(ierr);
1530 
1531   /* analysis phase */
1532   /*----------------*/
1533   mumps->id.job = JOB_FACTSYMBOLIC;
1534   mumps->id.n   = M;
1535   switch (mumps->id.ICNTL(18)) {
1536   case 0:  /* centralized assembled matrix input */
1537     if (!mumps->myid) {
1538       mumps->id.nz =mumps->nz; mumps->id.irn=mumps->irn; mumps->id.jcn=mumps->jcn;
1539       if (mumps->id.ICNTL(6)>1) {
1540         mumps->id.a = (MumpsScalar*)mumps->val;
1541       }
1542     }
1543     break;
1544   case 3:  /* distributed assembled matrix input (size>1) */
1545     mumps->id.nz_loc = mumps->nz;
1546     mumps->id.irn_loc=mumps->irn; mumps->id.jcn_loc=mumps->jcn;
1547     if (mumps->id.ICNTL(6)>1) {
1548       mumps->id.a_loc = (MumpsScalar*)mumps->val;
1549     }
1550     /* MUMPS only supports centralized rhs. Create scatter scat_rhs for repeated use in MatSolve() */
1551     if (!mumps->myid) {
1552       ierr = VecCreateSeq(PETSC_COMM_SELF,A->cmap->N,&mumps->b_seq);CHKERRQ(ierr);
1553       ierr = ISCreateStride(PETSC_COMM_SELF,A->cmap->N,0,1,&is_iden);CHKERRQ(ierr);
1554     } else {
1555       ierr = VecCreateSeq(PETSC_COMM_SELF,0,&mumps->b_seq);CHKERRQ(ierr);
1556       ierr = ISCreateStride(PETSC_COMM_SELF,0,0,1,&is_iden);CHKERRQ(ierr);
1557     }
1558     ierr = MatCreateVecs(A,NULL,&b);CHKERRQ(ierr);
1559     ierr = VecScatterCreate(b,is_iden,mumps->b_seq,is_iden,&mumps->scat_rhs);CHKERRQ(ierr);
1560     ierr = ISDestroy(&is_iden);CHKERRQ(ierr);
1561     ierr = VecDestroy(&b);CHKERRQ(ierr);
1562     break;
1563   }
1564   PetscMUMPS_c(&mumps->id);
1565   if (mumps->id.INFOG(1) < 0) {
1566     if (mumps->id.INFOG(1) == -6) {
1567       if (!A->erroriffpe) {
1568         ierr = PetscInfo2(F,"matrix is singular in structure, INFOG(1)=%d, INFO(2)=%d\n",mumps->id.INFOG(1),mumps->id.INFO(2));CHKERRQ(ierr);
1569       } else {
1570         SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in analysis phase: INFOG(1)=%d, INFO(2)=%d, matrix is numerically singular\n",mumps->id.INFOG(1),mumps->id.INFO(2));
1571       }
1572     } else {
1573       SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error reported by MUMPS in analysis phase: INFOG(1)=%d\n",mumps->id.INFOG(1));
1574     }
1575   }
1576 
1577   F->ops->choleskyfactornumeric = MatFactorNumeric_MUMPS;
1578   F->ops->solve                 = MatSolve_MUMPS;
1579   F->ops->solvetranspose        = MatSolve_MUMPS;
1580   F->ops->matsolve              = MatMatSolve_MUMPS;
1581 #if defined(PETSC_USE_COMPLEX)
1582   F->ops->getinertia = NULL;
1583 #else
1584   F->ops->getinertia = MatGetInertia_SBAIJMUMPS;
1585 #endif
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 #undef __FUNCT__
1590 #define __FUNCT__ "MatView_MUMPS"
1591 PetscErrorCode MatView_MUMPS(Mat A,PetscViewer viewer)
1592 {
1593   PetscErrorCode    ierr;
1594   PetscBool         iascii;
1595   PetscViewerFormat format;
1596   Mat_MUMPS         *mumps=(Mat_MUMPS*)A->spptr;
1597 
1598   PetscFunctionBegin;
1599   /* check if matrix is mumps type */
1600   if (A->ops->solve != MatSolve_MUMPS) PetscFunctionReturn(0);
1601 
1602   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
1603   if (iascii) {
1604     ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
1605     if (format == PETSC_VIEWER_ASCII_INFO) {
1606       ierr = PetscViewerASCIIPrintf(viewer,"MUMPS run parameters:\n");CHKERRQ(ierr);
1607       ierr = PetscViewerASCIIPrintf(viewer,"  SYM (matrix type):                   %d \n",mumps->id.sym);CHKERRQ(ierr);
1608       ierr = PetscViewerASCIIPrintf(viewer,"  PAR (host participation):            %d \n",mumps->id.par);CHKERRQ(ierr);
1609       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(1) (output for error):         %d \n",mumps->id.ICNTL(1));CHKERRQ(ierr);
1610       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(2) (output of diagnostic msg): %d \n",mumps->id.ICNTL(2));CHKERRQ(ierr);
1611       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(3) (output for global info):   %d \n",mumps->id.ICNTL(3));CHKERRQ(ierr);
1612       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(4) (level of printing):        %d \n",mumps->id.ICNTL(4));CHKERRQ(ierr);
1613       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(5) (input mat struct):         %d \n",mumps->id.ICNTL(5));CHKERRQ(ierr);
1614       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(6) (matrix prescaling):        %d \n",mumps->id.ICNTL(6));CHKERRQ(ierr);
1615       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(7) (sequentia matrix ordering):%d \n",mumps->id.ICNTL(7));CHKERRQ(ierr);
1616       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(8) (scalling strategy):        %d \n",mumps->id.ICNTL(8));CHKERRQ(ierr);
1617       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(10) (max num of refinements):  %d \n",mumps->id.ICNTL(10));CHKERRQ(ierr);
1618       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(11) (error analysis):          %d \n",mumps->id.ICNTL(11));CHKERRQ(ierr);
1619       if (mumps->id.ICNTL(11)>0) {
1620         ierr = PetscViewerASCIIPrintf(viewer,"    RINFOG(4) (inf norm of input mat):        %g\n",mumps->id.RINFOG(4));CHKERRQ(ierr);
1621         ierr = PetscViewerASCIIPrintf(viewer,"    RINFOG(5) (inf norm of solution):         %g\n",mumps->id.RINFOG(5));CHKERRQ(ierr);
1622         ierr = PetscViewerASCIIPrintf(viewer,"    RINFOG(6) (inf norm of residual):         %g\n",mumps->id.RINFOG(6));CHKERRQ(ierr);
1623         ierr = PetscViewerASCIIPrintf(viewer,"    RINFOG(7),RINFOG(8) (backward error est): %g, %g\n",mumps->id.RINFOG(7),mumps->id.RINFOG(8));CHKERRQ(ierr);
1624         ierr = PetscViewerASCIIPrintf(viewer,"    RINFOG(9) (error estimate):               %g \n",mumps->id.RINFOG(9));CHKERRQ(ierr);
1625         ierr = PetscViewerASCIIPrintf(viewer,"    RINFOG(10),RINFOG(11)(condition numbers): %g, %g\n",mumps->id.RINFOG(10),mumps->id.RINFOG(11));CHKERRQ(ierr);
1626       }
1627       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(12) (efficiency control):                         %d \n",mumps->id.ICNTL(12));CHKERRQ(ierr);
1628       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(13) (efficiency control):                         %d \n",mumps->id.ICNTL(13));CHKERRQ(ierr);
1629       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(14) (percentage of estimated workspace increase): %d \n",mumps->id.ICNTL(14));CHKERRQ(ierr);
1630       /* ICNTL(15-17) not used */
1631       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(18) (input mat struct):                           %d \n",mumps->id.ICNTL(18));CHKERRQ(ierr);
1632       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(19) (Shur complement info):                       %d \n",mumps->id.ICNTL(19));CHKERRQ(ierr);
1633       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(20) (rhs sparse pattern):                         %d \n",mumps->id.ICNTL(20));CHKERRQ(ierr);
1634       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(21) (solution struct):                            %d \n",mumps->id.ICNTL(21));CHKERRQ(ierr);
1635       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(22) (in-core/out-of-core facility):               %d \n",mumps->id.ICNTL(22));CHKERRQ(ierr);
1636       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(23) (max size of memory can be allocated locally):%d \n",mumps->id.ICNTL(23));CHKERRQ(ierr);
1637 
1638       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(24) (detection of null pivot rows):               %d \n",mumps->id.ICNTL(24));CHKERRQ(ierr);
1639       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(25) (computation of a null space basis):          %d \n",mumps->id.ICNTL(25));CHKERRQ(ierr);
1640       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(26) (Schur options for rhs or solution):          %d \n",mumps->id.ICNTL(26));CHKERRQ(ierr);
1641       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(27) (experimental parameter):                     %d \n",mumps->id.ICNTL(27));CHKERRQ(ierr);
1642       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(28) (use parallel or sequential ordering):        %d \n",mumps->id.ICNTL(28));CHKERRQ(ierr);
1643       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(29) (parallel ordering):                          %d \n",mumps->id.ICNTL(29));CHKERRQ(ierr);
1644 
1645       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(30) (user-specified set of entries in inv(A)):    %d \n",mumps->id.ICNTL(30));CHKERRQ(ierr);
1646       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(31) (factors is discarded in the solve phase):    %d \n",mumps->id.ICNTL(31));CHKERRQ(ierr);
1647       ierr = PetscViewerASCIIPrintf(viewer,"  ICNTL(33) (compute determinant):                        %d \n",mumps->id.ICNTL(33));CHKERRQ(ierr);
1648 
1649       ierr = PetscViewerASCIIPrintf(viewer,"  CNTL(1) (relative pivoting threshold):      %g \n",mumps->id.CNTL(1));CHKERRQ(ierr);
1650       ierr = PetscViewerASCIIPrintf(viewer,"  CNTL(2) (stopping criterion of refinement): %g \n",mumps->id.CNTL(2));CHKERRQ(ierr);
1651       ierr = PetscViewerASCIIPrintf(viewer,"  CNTL(3) (absolute pivoting threshold):      %g \n",mumps->id.CNTL(3));CHKERRQ(ierr);
1652       ierr = PetscViewerASCIIPrintf(viewer,"  CNTL(4) (value of static pivoting):         %g \n",mumps->id.CNTL(4));CHKERRQ(ierr);
1653       ierr = PetscViewerASCIIPrintf(viewer,"  CNTL(5) (fixation for null pivots):         %g \n",mumps->id.CNTL(5));CHKERRQ(ierr);
1654 
1655       /* infomation local to each processor */
1656       ierr = PetscViewerASCIIPrintf(viewer, "  RINFO(1) (local estimated flops for the elimination after analysis): \n");CHKERRQ(ierr);
1657       ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
1658       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"    [%d] %g \n",mumps->myid,mumps->id.RINFO(1));CHKERRQ(ierr);
1659       ierr = PetscViewerFlush(viewer);
1660       ierr = PetscViewerASCIIPrintf(viewer, "  RINFO(2) (local estimated flops for the assembly after factorization): \n");CHKERRQ(ierr);
1661       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"    [%d]  %g \n",mumps->myid,mumps->id.RINFO(2));CHKERRQ(ierr);
1662       ierr = PetscViewerFlush(viewer);
1663       ierr = PetscViewerASCIIPrintf(viewer, "  RINFO(3) (local estimated flops for the elimination after factorization): \n");CHKERRQ(ierr);
1664       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"    [%d]  %g \n",mumps->myid,mumps->id.RINFO(3));CHKERRQ(ierr);
1665       ierr = PetscViewerFlush(viewer);
1666 
1667       ierr = PetscViewerASCIIPrintf(viewer, "  INFO(15) (estimated size of (in MB) MUMPS internal data for running numerical factorization): \n");CHKERRQ(ierr);
1668       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"  [%d] %d \n",mumps->myid,mumps->id.INFO(15));CHKERRQ(ierr);
1669       ierr = PetscViewerFlush(viewer);
1670 
1671       ierr = PetscViewerASCIIPrintf(viewer, "  INFO(16) (size of (in MB) MUMPS internal data used during numerical factorization): \n");CHKERRQ(ierr);
1672       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"    [%d] %d \n",mumps->myid,mumps->id.INFO(16));CHKERRQ(ierr);
1673       ierr = PetscViewerFlush(viewer);
1674 
1675       ierr = PetscViewerASCIIPrintf(viewer, "  INFO(23) (num of pivots eliminated on this processor after factorization): \n");CHKERRQ(ierr);
1676       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"    [%d] %d \n",mumps->myid,mumps->id.INFO(23));CHKERRQ(ierr);
1677       ierr = PetscViewerFlush(viewer);
1678 
1679       if (mumps->ninfo && mumps->ninfo <= 40){
1680         PetscInt i;
1681         for (i=0; i<mumps->ninfo; i++){
1682           ierr = PetscViewerASCIIPrintf(viewer, "  INFO(%d): \n",mumps->info[i]);CHKERRQ(ierr);
1683           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"    [%d] %d \n",mumps->myid,mumps->id.INFO(mumps->info[i]));CHKERRQ(ierr);
1684           ierr = PetscViewerFlush(viewer);
1685         }
1686       }
1687 
1688 
1689       ierr = PetscViewerASCIIPopSynchronized(viewer);CHKERRQ(ierr);
1690 
1691       if (!mumps->myid) { /* information from the host */
1692         ierr = PetscViewerASCIIPrintf(viewer,"  RINFOG(1) (global estimated flops for the elimination after analysis): %g \n",mumps->id.RINFOG(1));CHKERRQ(ierr);
1693         ierr = PetscViewerASCIIPrintf(viewer,"  RINFOG(2) (global estimated flops for the assembly after factorization): %g \n",mumps->id.RINFOG(2));CHKERRQ(ierr);
1694         ierr = PetscViewerASCIIPrintf(viewer,"  RINFOG(3) (global estimated flops for the elimination after factorization): %g \n",mumps->id.RINFOG(3));CHKERRQ(ierr);
1695         ierr = PetscViewerASCIIPrintf(viewer,"  (RINFOG(12) RINFOG(13))*2^INFOG(34) (determinant): (%g,%g)*(2^%d)\n",mumps->id.RINFOG(12),mumps->id.RINFOG(13),mumps->id.INFOG(34));CHKERRQ(ierr);
1696 
1697         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(3) (estimated real workspace for factors on all processors after analysis): %d \n",mumps->id.INFOG(3));CHKERRQ(ierr);
1698         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(4) (estimated integer workspace for factors on all processors after analysis): %d \n",mumps->id.INFOG(4));CHKERRQ(ierr);
1699         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(5) (estimated maximum front size in the complete tree): %d \n",mumps->id.INFOG(5));CHKERRQ(ierr);
1700         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(6) (number of nodes in the complete tree): %d \n",mumps->id.INFOG(6));CHKERRQ(ierr);
1701         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(7) (ordering option effectively use after analysis): %d \n",mumps->id.INFOG(7));CHKERRQ(ierr);
1702         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(8) (structural symmetry in percent of the permuted matrix after analysis): %d \n",mumps->id.INFOG(8));CHKERRQ(ierr);
1703         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(9) (total real/complex workspace to store the matrix factors after factorization): %d \n",mumps->id.INFOG(9));CHKERRQ(ierr);
1704         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(10) (total integer space store the matrix factors after factorization): %d \n",mumps->id.INFOG(10));CHKERRQ(ierr);
1705         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(11) (order of largest frontal matrix after factorization): %d \n",mumps->id.INFOG(11));CHKERRQ(ierr);
1706         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(12) (number of off-diagonal pivots): %d \n",mumps->id.INFOG(12));CHKERRQ(ierr);
1707         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(13) (number of delayed pivots after factorization): %d \n",mumps->id.INFOG(13));CHKERRQ(ierr);
1708         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(14) (number of memory compress after factorization): %d \n",mumps->id.INFOG(14));CHKERRQ(ierr);
1709         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(15) (number of steps of iterative refinement after solution): %d \n",mumps->id.INFOG(15));CHKERRQ(ierr);
1710         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(16) (estimated size (in MB) of all MUMPS internal data for factorization after analysis: value on the most memory consuming processor): %d \n",mumps->id.INFOG(16));CHKERRQ(ierr);
1711         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(17) (estimated size of all MUMPS internal data for factorization after analysis: sum over all processors): %d \n",mumps->id.INFOG(17));CHKERRQ(ierr);
1712         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(18) (size of all MUMPS internal data allocated during factorization: value on the most memory consuming processor): %d \n",mumps->id.INFOG(18));CHKERRQ(ierr);
1713         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(19) (size of all MUMPS internal data allocated during factorization: sum over all processors): %d \n",mumps->id.INFOG(19));CHKERRQ(ierr);
1714         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(20) (estimated number of entries in the factors): %d \n",mumps->id.INFOG(20));CHKERRQ(ierr);
1715         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(21) (size in MB of memory effectively used during factorization - value on the most memory consuming processor): %d \n",mumps->id.INFOG(21));CHKERRQ(ierr);
1716         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(22) (size in MB of memory effectively used during factorization - sum over all processors): %d \n",mumps->id.INFOG(22));CHKERRQ(ierr);
1717         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(23) (after analysis: value of ICNTL(6) effectively used): %d \n",mumps->id.INFOG(23));CHKERRQ(ierr);
1718         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(24) (after analysis: value of ICNTL(12) effectively used): %d \n",mumps->id.INFOG(24));CHKERRQ(ierr);
1719         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(25) (after factorization: number of pivots modified by static pivoting): %d \n",mumps->id.INFOG(25));CHKERRQ(ierr);
1720         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(28) (after factorization: number of null pivots encountered): %d\n",mumps->id.INFOG(28));CHKERRQ(ierr);
1721         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(29) (after factorization: effective number of entries in the factors (sum over all processors)): %d\n",mumps->id.INFOG(29));CHKERRQ(ierr);
1722         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(30, 31) (after solution: size in Mbytes of memory used during solution phase): %d, %d\n",mumps->id.INFOG(30),mumps->id.INFOG(31));CHKERRQ(ierr);
1723         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(32) (after analysis: type of analysis done): %d\n",mumps->id.INFOG(32));CHKERRQ(ierr);
1724         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(33) (value used for ICNTL(8)): %d\n",mumps->id.INFOG(33));CHKERRQ(ierr);
1725         ierr = PetscViewerASCIIPrintf(viewer,"  INFOG(34) (exponent of the determinant if determinant is requested): %d\n",mumps->id.INFOG(34));CHKERRQ(ierr);
1726       }
1727     }
1728   }
1729   PetscFunctionReturn(0);
1730 }
1731 
1732 #undef __FUNCT__
1733 #define __FUNCT__ "MatGetInfo_MUMPS"
1734 PetscErrorCode MatGetInfo_MUMPS(Mat A,MatInfoType flag,MatInfo *info)
1735 {
1736   Mat_MUMPS *mumps =(Mat_MUMPS*)A->spptr;
1737 
1738   PetscFunctionBegin;
1739   info->block_size        = 1.0;
1740   info->nz_allocated      = mumps->id.INFOG(20);
1741   info->nz_used           = mumps->id.INFOG(20);
1742   info->nz_unneeded       = 0.0;
1743   info->assemblies        = 0.0;
1744   info->mallocs           = 0.0;
1745   info->memory            = 0.0;
1746   info->fill_ratio_given  = 0;
1747   info->fill_ratio_needed = 0;
1748   info->factor_mallocs    = 0;
1749   PetscFunctionReturn(0);
1750 }
1751 
1752 /* -------------------------------------------------------------------------------------------*/
1753 #undef __FUNCT__
1754 #define __FUNCT__ "MatFactorSetSchurIS_MUMPS"
1755 PetscErrorCode MatFactorSetSchurIS_MUMPS(Mat F, IS is)
1756 {
1757   Mat_MUMPS      *mumps =(Mat_MUMPS*)F->spptr;
1758   const PetscInt *idxs;
1759   PetscInt       size,i;
1760   PetscErrorCode ierr;
1761 
1762   PetscFunctionBegin;
1763   if (mumps->size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"MUMPS parallel Schur complements not yet supported from PETSc\n");
1764   ierr = ISGetLocalSize(is,&size);CHKERRQ(ierr);
1765   if (mumps->id.size_schur != size) {
1766     ierr = PetscFree2(mumps->id.listvar_schur,mumps->id.schur);CHKERRQ(ierr);
1767     mumps->id.size_schur = size;
1768     mumps->id.schur_lld = size;
1769     ierr = PetscMalloc2(size,&mumps->id.listvar_schur,size*size,&mumps->id.schur);CHKERRQ(ierr);
1770   }
1771   ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
1772   ierr = PetscMemcpy(mumps->id.listvar_schur,idxs,size*sizeof(PetscInt));CHKERRQ(ierr);
1773   /* MUMPS expects Fortran style indices */
1774   for (i=0;i<size;i++) mumps->id.listvar_schur[i]++;
1775   ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
1776   if (size) { /* turn on Schur switch if we the set of indices is not empty */
1777     if (F->factortype == MAT_FACTOR_LU) {
1778       mumps->id.ICNTL(19) = 3; /* MUMPS returns full matrix */
1779     } else {
1780       mumps->id.ICNTL(19) = 2; /* MUMPS returns lower triangular part */
1781     }
1782     /* set a special value of ICNTL (not handled my MUMPS) to be used in the solve phase by PETSc */
1783     mumps->id.ICNTL(26) = -1;
1784   }
1785   PetscFunctionReturn(0);
1786 }
1787 
1788 /* -------------------------------------------------------------------------------------------*/
1789 #undef __FUNCT__
1790 #define __FUNCT__ "MatFactorCreateSchurComplement_MUMPS"
1791 PetscErrorCode MatFactorCreateSchurComplement_MUMPS(Mat F,Mat* S)
1792 {
1793   Mat            St;
1794   Mat_MUMPS      *mumps =(Mat_MUMPS*)F->spptr;
1795   PetscScalar    *array;
1796 #if defined(PETSC_USE_COMPLEX)
1797   PetscScalar    im = PetscSqrtScalar((PetscScalar)-1.0);
1798 #endif
1799   PetscErrorCode ierr;
1800 
1801   PetscFunctionBegin;
1802   if (!mumps->id.ICNTL(19)) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur complement mode not selected! You should call MatFactorSetSchurIS to enable it");
1803   else if (!mumps->id.size_schur) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur indices not set! You should call MatFactorSetSchurIS before");
1804 
1805   ierr = MatCreate(PetscObjectComm((PetscObject)F),&St);CHKERRQ(ierr);
1806   ierr = MatSetSizes(St,PETSC_DECIDE,PETSC_DECIDE,mumps->id.size_schur,mumps->id.size_schur);CHKERRQ(ierr);
1807   ierr = MatSetType(St,MATDENSE);CHKERRQ(ierr);
1808   ierr = MatSetUp(St);CHKERRQ(ierr);
1809   ierr = MatDenseGetArray(St,&array);CHKERRQ(ierr);
1810   if (!mumps->sym) { /* MUMPS always return a full matrix */
1811     if (mumps->id.ICNTL(19) == 1) { /* stored by rows */
1812       PetscInt i,j,N=mumps->id.size_schur;
1813       for (i=0;i<N;i++) {
1814         for (j=0;j<N;j++) {
1815 #if !defined(PETSC_USE_COMPLEX)
1816           PetscScalar val = mumps->id.schur[i*N+j];
1817 #else
1818           PetscScalar val = mumps->id.schur[i*N+j].r + im*mumps->id.schur[i*N+j].i;
1819 #endif
1820           array[j*N+i] = val;
1821         }
1822       }
1823     } else { /* stored by columns */
1824       ierr = PetscMemcpy(array,mumps->id.schur,mumps->id.size_schur*mumps->id.size_schur*sizeof(PetscScalar));CHKERRQ(ierr);
1825     }
1826   } else { /* either full or lower-triangular (not packed) */
1827     if (mumps->id.ICNTL(19) == 2) { /* lower triangular stored by columns */
1828       PetscInt i,j,N=mumps->id.size_schur;
1829       for (i=0;i<N;i++) {
1830         for (j=i;j<N;j++) {
1831 #if !defined(PETSC_USE_COMPLEX)
1832           PetscScalar val = mumps->id.schur[i*N+j];
1833 #else
1834           PetscScalar val = mumps->id.schur[i*N+j].r + im*mumps->id.schur[i*N+j].i;
1835 #endif
1836           array[i*N+j] = val;
1837           array[j*N+i] = val;
1838         }
1839       }
1840     } else if (mumps->id.ICNTL(19) == 3) { /* full matrix */
1841       ierr = PetscMemcpy(array,mumps->id.schur,mumps->id.size_schur*mumps->id.size_schur*sizeof(PetscScalar));CHKERRQ(ierr);
1842     } else { /* ICNTL(19) == 1 lower triangular stored by rows */
1843       PetscInt i,j,N=mumps->id.size_schur;
1844       for (i=0;i<N;i++) {
1845         for (j=0;j<i+1;j++) {
1846 #if !defined(PETSC_USE_COMPLEX)
1847           PetscScalar val = mumps->id.schur[i*N+j];
1848 #else
1849           PetscScalar val = mumps->id.schur[i*N+j].r + im*mumps->id.schur[i*N+j].i;
1850 #endif
1851           array[i*N+j] = val;
1852           array[j*N+i] = val;
1853         }
1854       }
1855     }
1856   }
1857   ierr = MatDenseRestoreArray(St,&array);CHKERRQ(ierr);
1858   *S = St;
1859   PetscFunctionReturn(0);
1860 }
1861 
1862 /* -------------------------------------------------------------------------------------------*/
1863 #undef __FUNCT__
1864 #define __FUNCT__ "MatFactorGetSchurComplement_MUMPS"
1865 PetscErrorCode MatFactorGetSchurComplement_MUMPS(Mat F,Mat* S)
1866 {
1867   Mat            St;
1868   Mat_MUMPS      *mumps =(Mat_MUMPS*)F->spptr;
1869   PetscErrorCode ierr;
1870 
1871   PetscFunctionBegin;
1872   if (!mumps->id.ICNTL(19)) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur complement mode not selected! You should call MatFactorSetSchurIS to enable it");
1873   else if (!mumps->id.size_schur) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur indices not set! You should call MatFactorSetSchurIS before");
1874 
1875   /* It should be the responsibility of the user to handle different ICNTL(19) cases and factorization stages if they want to work with the raw data */
1876   ierr = MatCreateSeqDense(PetscObjectComm((PetscObject)F),mumps->id.size_schur,mumps->id.size_schur,(PetscScalar*)mumps->id.schur,&St);CHKERRQ(ierr);
1877   *S = St;
1878   PetscFunctionReturn(0);
1879 }
1880 
1881 /* -------------------------------------------------------------------------------------------*/
1882 #undef __FUNCT__
1883 #define __FUNCT__ "MatFactorInvertSchurComplement_MUMPS"
1884 PetscErrorCode MatFactorInvertSchurComplement_MUMPS(Mat F)
1885 {
1886   Mat_MUMPS      *mumps =(Mat_MUMPS*)F->spptr;
1887   PetscErrorCode ierr;
1888 
1889   PetscFunctionBegin;
1890   if (!mumps->id.ICNTL(19)) { /* do nothing */
1891     PetscFunctionReturn(0);
1892   }
1893   if (!mumps->id.size_schur) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur indices not set! You should call MatFactorSetSchurIS before");
1894   ierr = MatMumpsInvertSchur_Private(mumps);CHKERRQ(ierr);
1895   PetscFunctionReturn(0);
1896 }
1897 
1898 /* -------------------------------------------------------------------------------------------*/
1899 #undef __FUNCT__
1900 #define __FUNCT__ "MatFactorSolveSchurComplement_MUMPS"
1901 PetscErrorCode MatFactorSolveSchurComplement_MUMPS(Mat F, Vec rhs, Vec sol)
1902 {
1903   Mat_MUMPS      *mumps =(Mat_MUMPS*)F->spptr;
1904   MumpsScalar    *orhs;
1905   PetscScalar    *osol,*nrhs,*nsol;
1906   PetscInt       orhs_size,osol_size,olrhs_size;
1907   PetscErrorCode ierr;
1908 
1909   PetscFunctionBegin;
1910   if (!mumps->id.ICNTL(19)) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur complement mode not selected! You should call MatFactorSetSchurIS to enable it");
1911   if (!mumps->id.size_schur) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur indices not set! You should call MatFactorSetSchurIS before");
1912 
1913   /* swap pointers */
1914   orhs = mumps->id.redrhs;
1915   olrhs_size = mumps->id.lredrhs;
1916   orhs_size = mumps->sizeredrhs;
1917   osol = mumps->schur_sol;
1918   osol_size = mumps->schur_sizesol;
1919   ierr = VecGetArray(rhs,&nrhs);CHKERRQ(ierr);
1920   ierr = VecGetArray(sol,&nsol);CHKERRQ(ierr);
1921   mumps->id.redrhs = (MumpsScalar*)nrhs;
1922   ierr = VecGetLocalSize(rhs,&mumps->sizeredrhs);CHKERRQ(ierr);
1923   mumps->id.lredrhs = mumps->sizeredrhs;
1924   mumps->schur_sol = nsol;
1925   ierr = VecGetLocalSize(sol,&mumps->schur_sizesol);CHKERRQ(ierr);
1926 
1927   /* solve Schur complement */
1928   mumps->id.nrhs = 1;
1929   ierr = MatMumpsSolveSchur_Private(mumps,PETSC_FALSE);CHKERRQ(ierr);
1930   /* restore pointers */
1931   ierr = VecRestoreArray(rhs,&nrhs);CHKERRQ(ierr);
1932   ierr = VecRestoreArray(sol,&nsol);CHKERRQ(ierr);
1933   mumps->id.redrhs = orhs;
1934   mumps->id.lredrhs = olrhs_size;
1935   mumps->sizeredrhs = orhs_size;
1936   mumps->schur_sol = osol;
1937   mumps->schur_sizesol = osol_size;
1938   PetscFunctionReturn(0);
1939 }
1940 
1941 /* -------------------------------------------------------------------------------------------*/
1942 #undef __FUNCT__
1943 #define __FUNCT__ "MatFactorSolveSchurComplementTranspose_MUMPS"
1944 PetscErrorCode MatFactorSolveSchurComplementTranspose_MUMPS(Mat F, Vec rhs, Vec sol)
1945 {
1946   Mat_MUMPS      *mumps =(Mat_MUMPS*)F->spptr;
1947   MumpsScalar    *orhs;
1948   PetscScalar    *osol,*nrhs,*nsol;
1949   PetscInt       orhs_size,osol_size;
1950   PetscErrorCode ierr;
1951 
1952   PetscFunctionBegin;
1953   if (!mumps->id.ICNTL(19)) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur complement mode not selected! You should call MatFactorSetSchurIS to enable it");
1954   else if (!mumps->id.size_schur) SETERRQ(PetscObjectComm((PetscObject)F),PETSC_ERR_ORDER,"Schur indices not set! You should call MatFactorSetSchurIS before");
1955 
1956   /* swap pointers */
1957   orhs = mumps->id.redrhs;
1958   orhs_size = mumps->sizeredrhs;
1959   osol = mumps->schur_sol;
1960   osol_size = mumps->schur_sizesol;
1961   ierr = VecGetArray(rhs,&nrhs);CHKERRQ(ierr);
1962   ierr = VecGetArray(sol,&nsol);CHKERRQ(ierr);
1963   mumps->id.redrhs = (MumpsScalar*)nrhs;
1964   ierr = VecGetLocalSize(rhs,&mumps->sizeredrhs);CHKERRQ(ierr);
1965   mumps->schur_sol = nsol;
1966   ierr = VecGetLocalSize(sol,&mumps->schur_sizesol);CHKERRQ(ierr);
1967 
1968   /* solve Schur complement */
1969   mumps->id.nrhs = 1;
1970   mumps->id.ICNTL(9) = 0;
1971   ierr = MatMumpsSolveSchur_Private(mumps,PETSC_FALSE);CHKERRQ(ierr);
1972   mumps->id.ICNTL(9) = 1;
1973   /* restore pointers */
1974   ierr = VecRestoreArray(rhs,&nrhs);CHKERRQ(ierr);
1975   ierr = VecRestoreArray(sol,&nsol);CHKERRQ(ierr);
1976   mumps->id.redrhs = orhs;
1977   mumps->sizeredrhs = orhs_size;
1978   mumps->schur_sol = osol;
1979   mumps->schur_sizesol = osol_size;
1980   PetscFunctionReturn(0);
1981 }
1982 
1983 /* -------------------------------------------------------------------------------------------*/
1984 #undef __FUNCT__
1985 #define __FUNCT__ "MatMumpsSetIcntl_MUMPS"
1986 PetscErrorCode MatMumpsSetIcntl_MUMPS(Mat F,PetscInt icntl,PetscInt ival)
1987 {
1988   Mat_MUMPS *mumps =(Mat_MUMPS*)F->spptr;
1989 
1990   PetscFunctionBegin;
1991   mumps->id.ICNTL(icntl) = ival;
1992   PetscFunctionReturn(0);
1993 }
1994 
1995 #undef __FUNCT__
1996 #define __FUNCT__ "MatMumpsGetIcntl_MUMPS"
1997 PetscErrorCode MatMumpsGetIcntl_MUMPS(Mat F,PetscInt icntl,PetscInt *ival)
1998 {
1999   Mat_MUMPS *mumps =(Mat_MUMPS*)F->spptr;
2000 
2001   PetscFunctionBegin;
2002   *ival = mumps->id.ICNTL(icntl);
2003   PetscFunctionReturn(0);
2004 }
2005 
2006 #undef __FUNCT__
2007 #define __FUNCT__ "MatMumpsSetIcntl"
2008 /*@
2009   MatMumpsSetIcntl - Set MUMPS parameter ICNTL()
2010 
2011    Logically Collective on Mat
2012 
2013    Input Parameters:
2014 +  F - the factored matrix obtained by calling MatGetFactor() from PETSc-MUMPS interface
2015 .  icntl - index of MUMPS parameter array ICNTL()
2016 -  ival - value of MUMPS ICNTL(icntl)
2017 
2018   Options Database:
2019 .   -mat_mumps_icntl_<icntl> <ival>
2020 
2021    Level: beginner
2022 
2023    References: MUMPS Users' Guide
2024 
2025 .seealso: MatGetFactor()
2026 @*/
2027 PetscErrorCode MatMumpsSetIcntl(Mat F,PetscInt icntl,PetscInt ival)
2028 {
2029   PetscErrorCode ierr;
2030 
2031   PetscFunctionBegin;
2032   PetscValidLogicalCollectiveInt(F,icntl,2);
2033   PetscValidLogicalCollectiveInt(F,ival,3);
2034   ierr = PetscTryMethod(F,"MatMumpsSetIcntl_C",(Mat,PetscInt,PetscInt),(F,icntl,ival));CHKERRQ(ierr);
2035   PetscFunctionReturn(0);
2036 }
2037 
2038 #undef __FUNCT__
2039 #define __FUNCT__ "MatMumpsGetIcntl"
2040 /*@
2041   MatMumpsGetIcntl - Get MUMPS parameter ICNTL()
2042 
2043    Logically Collective on Mat
2044 
2045    Input Parameters:
2046 +  F - the factored matrix obtained by calling MatGetFactor() from PETSc-MUMPS interface
2047 -  icntl - index of MUMPS parameter array ICNTL()
2048 
2049   Output Parameter:
2050 .  ival - value of MUMPS ICNTL(icntl)
2051 
2052    Level: beginner
2053 
2054    References: MUMPS Users' Guide
2055 
2056 .seealso: MatGetFactor()
2057 @*/
2058 PetscErrorCode MatMumpsGetIcntl(Mat F,PetscInt icntl,PetscInt *ival)
2059 {
2060   PetscErrorCode ierr;
2061 
2062   PetscFunctionBegin;
2063   PetscValidLogicalCollectiveInt(F,icntl,2);
2064   PetscValidIntPointer(ival,3);
2065   ierr = PetscTryMethod(F,"MatMumpsGetIcntl_C",(Mat,PetscInt,PetscInt*),(F,icntl,ival));CHKERRQ(ierr);
2066   PetscFunctionReturn(0);
2067 }
2068 
2069 /* -------------------------------------------------------------------------------------------*/
2070 #undef __FUNCT__
2071 #define __FUNCT__ "MatMumpsSetCntl_MUMPS"
2072 PetscErrorCode MatMumpsSetCntl_MUMPS(Mat F,PetscInt icntl,PetscReal val)
2073 {
2074   Mat_MUMPS *mumps =(Mat_MUMPS*)F->spptr;
2075 
2076   PetscFunctionBegin;
2077   mumps->id.CNTL(icntl) = val;
2078   PetscFunctionReturn(0);
2079 }
2080 
2081 #undef __FUNCT__
2082 #define __FUNCT__ "MatMumpsGetCntl_MUMPS"
2083 PetscErrorCode MatMumpsGetCntl_MUMPS(Mat F,PetscInt icntl,PetscReal *val)
2084 {
2085   Mat_MUMPS *mumps =(Mat_MUMPS*)F->spptr;
2086 
2087   PetscFunctionBegin;
2088   *val = mumps->id.CNTL(icntl);
2089   PetscFunctionReturn(0);
2090 }
2091 
2092 #undef __FUNCT__
2093 #define __FUNCT__ "MatMumpsSetCntl"
2094 /*@
2095   MatMumpsSetCntl - Set MUMPS parameter CNTL()
2096 
2097    Logically Collective on Mat
2098 
2099    Input Parameters:
2100 +  F - the factored matrix obtained by calling MatGetFactor() from PETSc-MUMPS interface
2101 .  icntl - index of MUMPS parameter array CNTL()
2102 -  val - value of MUMPS CNTL(icntl)
2103 
2104   Options Database:
2105 .   -mat_mumps_cntl_<icntl> <val>
2106 
2107    Level: beginner
2108 
2109    References: MUMPS Users' Guide
2110 
2111 .seealso: MatGetFactor()
2112 @*/
2113 PetscErrorCode MatMumpsSetCntl(Mat F,PetscInt icntl,PetscReal val)
2114 {
2115   PetscErrorCode ierr;
2116 
2117   PetscFunctionBegin;
2118   PetscValidLogicalCollectiveInt(F,icntl,2);
2119   PetscValidLogicalCollectiveReal(F,val,3);
2120   ierr = PetscTryMethod(F,"MatMumpsSetCntl_C",(Mat,PetscInt,PetscReal),(F,icntl,val));CHKERRQ(ierr);
2121   PetscFunctionReturn(0);
2122 }
2123 
2124 #undef __FUNCT__
2125 #define __FUNCT__ "MatMumpsGetCntl"
2126 /*@
2127   MatMumpsGetCntl - Get MUMPS parameter CNTL()
2128 
2129    Logically Collective on Mat
2130 
2131    Input Parameters:
2132 +  F - the factored matrix obtained by calling MatGetFactor() from PETSc-MUMPS interface
2133 -  icntl - index of MUMPS parameter array CNTL()
2134 
2135   Output Parameter:
2136 .  val - value of MUMPS CNTL(icntl)
2137 
2138    Level: beginner
2139 
2140    References: MUMPS Users' Guide
2141 
2142 .seealso: MatGetFactor()
2143 @*/
2144 PetscErrorCode MatMumpsGetCntl(Mat F,PetscInt icntl,PetscReal *val)
2145 {
2146   PetscErrorCode ierr;
2147 
2148   PetscFunctionBegin;
2149   PetscValidLogicalCollectiveInt(F,icntl,2);
2150   PetscValidRealPointer(val,3);
2151   ierr = PetscTryMethod(F,"MatMumpsGetCntl_C",(Mat,PetscInt,PetscReal*),(F,icntl,val));CHKERRQ(ierr);
2152   PetscFunctionReturn(0);
2153 }
2154 
2155 #undef __FUNCT__
2156 #define __FUNCT__ "MatMumpsGetInfo_MUMPS"
2157 PetscErrorCode MatMumpsGetInfo_MUMPS(Mat F,PetscInt icntl,PetscInt *info)
2158 {
2159   Mat_MUMPS *mumps =(Mat_MUMPS*)F->spptr;
2160 
2161   PetscFunctionBegin;
2162   *info = mumps->id.INFO(icntl);
2163   PetscFunctionReturn(0);
2164 }
2165 
2166 #undef __FUNCT__
2167 #define __FUNCT__ "MatMumpsGetInfog_MUMPS"
2168 PetscErrorCode MatMumpsGetInfog_MUMPS(Mat F,PetscInt icntl,PetscInt *infog)
2169 {
2170   Mat_MUMPS *mumps =(Mat_MUMPS*)F->spptr;
2171 
2172   PetscFunctionBegin;
2173   *infog = mumps->id.INFOG(icntl);
2174   PetscFunctionReturn(0);
2175 }
2176 
2177 #undef __FUNCT__
2178 #define __FUNCT__ "MatMumpsGetRinfo_MUMPS"
2179 PetscErrorCode MatMumpsGetRinfo_MUMPS(Mat F,PetscInt icntl,PetscReal *rinfo)
2180 {
2181   Mat_MUMPS *mumps =(Mat_MUMPS*)F->spptr;
2182 
2183   PetscFunctionBegin;
2184   *rinfo = mumps->id.RINFO(icntl);
2185   PetscFunctionReturn(0);
2186 }
2187 
2188 #undef __FUNCT__
2189 #define __FUNCT__ "MatMumpsGetRinfog_MUMPS"
2190 PetscErrorCode MatMumpsGetRinfog_MUMPS(Mat F,PetscInt icntl,PetscReal *rinfog)
2191 {
2192   Mat_MUMPS *mumps =(Mat_MUMPS*)F->spptr;
2193 
2194   PetscFunctionBegin;
2195   *rinfog = mumps->id.RINFOG(icntl);
2196   PetscFunctionReturn(0);
2197 }
2198 
2199 #undef __FUNCT__
2200 #define __FUNCT__ "MatMumpsGetInfo"
2201 /*@
2202   MatMumpsGetInfo - Get MUMPS parameter INFO()
2203 
2204    Logically Collective on Mat
2205 
2206    Input Parameters:
2207 +  F - the factored matrix obtained by calling MatGetFactor() from PETSc-MUMPS interface
2208 -  icntl - index of MUMPS parameter array INFO()
2209 
2210   Output Parameter:
2211 .  ival - value of MUMPS INFO(icntl)
2212 
2213    Level: beginner
2214 
2215    References: MUMPS Users' Guide
2216 
2217 .seealso: MatGetFactor()
2218 @*/
2219 PetscErrorCode MatMumpsGetInfo(Mat F,PetscInt icntl,PetscInt *ival)
2220 {
2221   PetscErrorCode ierr;
2222 
2223   PetscFunctionBegin;
2224   PetscValidIntPointer(ival,3);
2225   ierr = PetscTryMethod(F,"MatMumpsGetInfo_C",(Mat,PetscInt,PetscInt*),(F,icntl,ival));CHKERRQ(ierr);
2226   PetscFunctionReturn(0);
2227 }
2228 
2229 #undef __FUNCT__
2230 #define __FUNCT__ "MatMumpsGetInfog"
2231 /*@
2232   MatMumpsGetInfog - Get MUMPS parameter INFOG()
2233 
2234    Logically Collective on Mat
2235 
2236    Input Parameters:
2237 +  F - the factored matrix obtained by calling MatGetFactor() from PETSc-MUMPS interface
2238 -  icntl - index of MUMPS parameter array INFOG()
2239 
2240   Output Parameter:
2241 .  ival - value of MUMPS INFOG(icntl)
2242 
2243    Level: beginner
2244 
2245    References: MUMPS Users' Guide
2246 
2247 .seealso: MatGetFactor()
2248 @*/
2249 PetscErrorCode MatMumpsGetInfog(Mat F,PetscInt icntl,PetscInt *ival)
2250 {
2251   PetscErrorCode ierr;
2252 
2253   PetscFunctionBegin;
2254   PetscValidIntPointer(ival,3);
2255   ierr = PetscTryMethod(F,"MatMumpsGetInfog_C",(Mat,PetscInt,PetscInt*),(F,icntl,ival));CHKERRQ(ierr);
2256   PetscFunctionReturn(0);
2257 }
2258 
2259 #undef __FUNCT__
2260 #define __FUNCT__ "MatMumpsGetRinfo"
2261 /*@
2262   MatMumpsGetRinfo - Get MUMPS parameter RINFO()
2263 
2264    Logically Collective on Mat
2265 
2266    Input Parameters:
2267 +  F - the factored matrix obtained by calling MatGetFactor() from PETSc-MUMPS interface
2268 -  icntl - index of MUMPS parameter array RINFO()
2269 
2270   Output Parameter:
2271 .  val - value of MUMPS RINFO(icntl)
2272 
2273    Level: beginner
2274 
2275    References: MUMPS Users' Guide
2276 
2277 .seealso: MatGetFactor()
2278 @*/
2279 PetscErrorCode MatMumpsGetRinfo(Mat F,PetscInt icntl,PetscReal *val)
2280 {
2281   PetscErrorCode ierr;
2282 
2283   PetscFunctionBegin;
2284   PetscValidRealPointer(val,3);
2285   ierr = PetscTryMethod(F,"MatMumpsGetRinfo_C",(Mat,PetscInt,PetscReal*),(F,icntl,val));CHKERRQ(ierr);
2286   PetscFunctionReturn(0);
2287 }
2288 
2289 #undef __FUNCT__
2290 #define __FUNCT__ "MatMumpsGetRinfog"
2291 /*@
2292   MatMumpsGetRinfog - Get MUMPS parameter RINFOG()
2293 
2294    Logically Collective on Mat
2295 
2296    Input Parameters:
2297 +  F - the factored matrix obtained by calling MatGetFactor() from PETSc-MUMPS interface
2298 -  icntl - index of MUMPS parameter array RINFOG()
2299 
2300   Output Parameter:
2301 .  val - value of MUMPS RINFOG(icntl)
2302 
2303    Level: beginner
2304 
2305    References: MUMPS Users' Guide
2306 
2307 .seealso: MatGetFactor()
2308 @*/
2309 PetscErrorCode MatMumpsGetRinfog(Mat F,PetscInt icntl,PetscReal *val)
2310 {
2311   PetscErrorCode ierr;
2312 
2313   PetscFunctionBegin;
2314   PetscValidRealPointer(val,3);
2315   ierr = PetscTryMethod(F,"MatMumpsGetRinfog_C",(Mat,PetscInt,PetscReal*),(F,icntl,val));CHKERRQ(ierr);
2316   PetscFunctionReturn(0);
2317 }
2318 
2319 /*MC
2320   MATSOLVERMUMPS -  A matrix type providing direct solvers (LU and Cholesky) for
2321   distributed and sequential matrices via the external package MUMPS.
2322 
2323   Works with MATAIJ and MATSBAIJ matrices
2324 
2325   Use ./configure --download-mumps --download-scalapack --download-parmetis --download-metis --download-ptscotch  to have PETSc installed with MUMPS
2326 
2327   Use -pc_type cholesky or lu -pc_factor_mat_solver_package mumps to us this direct solver
2328 
2329   Options Database Keys:
2330 +  -mat_mumps_icntl_1 <6>: ICNTL(1): output stream for error messages (None)
2331 .  -mat_mumps_icntl_2 <0>: ICNTL(2): output stream for diagnostic printing, statistics, and warning (None)
2332 .  -mat_mumps_icntl_3 <0>: ICNTL(3): output stream for global information, collected on the host (None)
2333 .  -mat_mumps_icntl_4 <0>: ICNTL(4): level of printing (0 to 4) (None)
2334 .  -mat_mumps_icntl_6 <7>: ICNTL(6): permutes to a zero-free diagonal and/or scale the matrix (0 to 7) (None)
2335 .  -mat_mumps_icntl_7 <7>: ICNTL(7): computes a symmetric permutation in sequential analysis (0 to 7). 3=Scotch, 4=PORD, 5=Metis (None)
2336 .  -mat_mumps_icntl_8 <77>: ICNTL(8): scaling strategy (-2 to 8 or 77) (None)
2337 .  -mat_mumps_icntl_10 <0>: ICNTL(10): max num of refinements (None)
2338 .  -mat_mumps_icntl_11 <0>: ICNTL(11): statistics related to an error analysis (via -ksp_view) (None)
2339 .  -mat_mumps_icntl_12 <1>: ICNTL(12): an ordering strategy for symmetric matrices (0 to 3) (None)
2340 .  -mat_mumps_icntl_13 <0>: ICNTL(13): parallelism of the root node (enable ScaLAPACK) and its splitting (None)
2341 .  -mat_mumps_icntl_14 <20>: ICNTL(14): percentage increase in the estimated working space (None)
2342 .  -mat_mumps_icntl_19 <0>: ICNTL(19): computes the Schur complement (None)
2343 .  -mat_mumps_icntl_22 <0>: ICNTL(22): in-core/out-of-core factorization and solve (0 or 1) (None)
2344 .  -mat_mumps_icntl_23 <0>: ICNTL(23): max size of the working memory (MB) that can allocate per processor (None)
2345 .  -mat_mumps_icntl_24 <0>: ICNTL(24): detection of null pivot rows (0 or 1) (None)
2346 .  -mat_mumps_icntl_25 <0>: ICNTL(25): compute a solution of a deficient matrix and a null space basis (None)
2347 .  -mat_mumps_icntl_26 <0>: ICNTL(26): drives the solution phase if a Schur complement matrix (None)
2348 .  -mat_mumps_icntl_28 <1>: ICNTL(28): use 1 for sequential analysis and ictnl(7) ordering, or 2 for parallel analysis and ictnl(29) ordering (None)
2349 .  -mat_mumps_icntl_29 <0>: ICNTL(29): parallel ordering 1 = ptscotch, 2 = parmetis (None)
2350 .  -mat_mumps_icntl_30 <0>: ICNTL(30): compute user-specified set of entries in inv(A) (None)
2351 .  -mat_mumps_icntl_31 <0>: ICNTL(31): indicates which factors may be discarded during factorization (None)
2352 .  -mat_mumps_icntl_33 <0>: ICNTL(33): compute determinant (None)
2353 .  -mat_mumps_cntl_1 <0.01>: CNTL(1): relative pivoting threshold (None)
2354 .  -mat_mumps_cntl_2 <1.49012e-08>: CNTL(2): stopping criterion of refinement (None)
2355 .  -mat_mumps_cntl_3 <0>: CNTL(3): absolute pivoting threshold (None)
2356 .  -mat_mumps_cntl_4 <-1>: CNTL(4): value for static pivoting (None)
2357 -  -mat_mumps_cntl_5 <0>: CNTL(5): fixation for null pivots (None)
2358 
2359   Level: beginner
2360 
2361 .seealso: PCFactorSetMatSolverPackage(), MatSolverPackage
2362 
2363 M*/
2364 
2365 #undef __FUNCT__
2366 #define __FUNCT__ "MatFactorGetSolverPackage_mumps"
2367 static PetscErrorCode MatFactorGetSolverPackage_mumps(Mat A,const MatSolverPackage *type)
2368 {
2369   PetscFunctionBegin;
2370   *type = MATSOLVERMUMPS;
2371   PetscFunctionReturn(0);
2372 }
2373 
2374 /* MatGetFactor for Seq and MPI AIJ matrices */
2375 #undef __FUNCT__
2376 #define __FUNCT__ "MatGetFactor_aij_mumps"
2377 PETSC_EXTERN PetscErrorCode MatGetFactor_aij_mumps(Mat A,MatFactorType ftype,Mat *F)
2378 {
2379   Mat            B;
2380   PetscErrorCode ierr;
2381   Mat_MUMPS      *mumps;
2382   PetscBool      isSeqAIJ;
2383 
2384   PetscFunctionBegin;
2385   /* Create the factorization matrix */
2386   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isSeqAIJ);CHKERRQ(ierr);
2387   ierr = MatCreate(PetscObjectComm((PetscObject)A),&B);CHKERRQ(ierr);
2388   ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,A->rmap->N,A->cmap->N);CHKERRQ(ierr);
2389   ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr);
2390   if (isSeqAIJ) {
2391     ierr = MatSeqAIJSetPreallocation(B,0,NULL);CHKERRQ(ierr);
2392   } else {
2393     ierr = MatMPIAIJSetPreallocation(B,0,NULL,0,NULL);CHKERRQ(ierr);
2394   }
2395 
2396   ierr = PetscNewLog(B,&mumps);CHKERRQ(ierr);
2397 
2398   B->ops->view        = MatView_MUMPS;
2399   B->ops->getinfo     = MatGetInfo_MUMPS;
2400   B->ops->getdiagonal = MatGetDiagonal_MUMPS;
2401 
2402   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSolverPackage_C",MatFactorGetSolverPackage_mumps);CHKERRQ(ierr);
2403   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSetSchurIS_C",MatFactorSetSchurIS_MUMPS);CHKERRQ(ierr);
2404   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorInvertSchurComplement_C",MatFactorInvertSchurComplement_MUMPS);CHKERRQ(ierr);
2405   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorCreateSchurComplement_C",MatFactorCreateSchurComplement_MUMPS);CHKERRQ(ierr);
2406   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSchurComplement_C",MatFactorGetSchurComplement_MUMPS);CHKERRQ(ierr);
2407   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSolveSchurComplement_C",MatFactorSolveSchurComplement_MUMPS);CHKERRQ(ierr);
2408   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSolveSchurComplementTranspose_C",MatFactorSolveSchurComplementTranspose_MUMPS);CHKERRQ(ierr);
2409   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsSetIcntl_C",MatMumpsSetIcntl_MUMPS);CHKERRQ(ierr);
2410   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetIcntl_C",MatMumpsGetIcntl_MUMPS);CHKERRQ(ierr);
2411   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsSetCntl_C",MatMumpsSetCntl_MUMPS);CHKERRQ(ierr);
2412   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetCntl_C",MatMumpsGetCntl_MUMPS);CHKERRQ(ierr);
2413   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetInfo_C",MatMumpsGetInfo_MUMPS);CHKERRQ(ierr);
2414   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetInfog_C",MatMumpsGetInfog_MUMPS);CHKERRQ(ierr);
2415   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetRinfo_C",MatMumpsGetRinfo_MUMPS);CHKERRQ(ierr);
2416   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetRinfog_C",MatMumpsGetRinfog_MUMPS);CHKERRQ(ierr);
2417 
2418   if (ftype == MAT_FACTOR_LU) {
2419     B->ops->lufactorsymbolic = MatLUFactorSymbolic_AIJMUMPS;
2420     B->factortype            = MAT_FACTOR_LU;
2421     if (isSeqAIJ) mumps->ConvertToTriples = MatConvertToTriples_seqaij_seqaij;
2422     else mumps->ConvertToTriples = MatConvertToTriples_mpiaij_mpiaij;
2423     mumps->sym = 0;
2424   } else {
2425     B->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_MUMPS;
2426     B->factortype                  = MAT_FACTOR_CHOLESKY;
2427     if (isSeqAIJ) mumps->ConvertToTriples = MatConvertToTriples_seqaij_seqsbaij;
2428     else mumps->ConvertToTriples = MatConvertToTriples_mpiaij_mpisbaij;
2429 #if defined(PETSC_USE_COMPLEX)
2430     mumps->sym = 2;
2431 #else
2432     if (A->spd_set && A->spd) mumps->sym = 1;
2433     else                      mumps->sym = 2;
2434 #endif
2435   }
2436 
2437   mumps->isAIJ    = PETSC_TRUE;
2438   mumps->Destroy  = B->ops->destroy;
2439   B->ops->destroy = MatDestroy_MUMPS;
2440   B->spptr        = (void*)mumps;
2441 
2442   ierr = PetscInitializeMUMPS(A,mumps);CHKERRQ(ierr);
2443 
2444   *F = B;
2445   PetscFunctionReturn(0);
2446 }
2447 
2448 /* MatGetFactor for Seq and MPI SBAIJ matrices */
2449 #undef __FUNCT__
2450 #define __FUNCT__ "MatGetFactor_sbaij_mumps"
2451 PETSC_EXTERN PetscErrorCode MatGetFactor_sbaij_mumps(Mat A,MatFactorType ftype,Mat *F)
2452 {
2453   Mat            B;
2454   PetscErrorCode ierr;
2455   Mat_MUMPS      *mumps;
2456   PetscBool      isSeqSBAIJ;
2457 
2458   PetscFunctionBegin;
2459   if (ftype != MAT_FACTOR_CHOLESKY) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_SUP,"Cannot use PETSc SBAIJ matrices with MUMPS LU, use AIJ matrix");
2460   if (A->rmap->bs > 1) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_SUP,"Cannot use PETSc SBAIJ matrices with block size > 1 with MUMPS Cholesky, use AIJ matrix instead");
2461   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQSBAIJ,&isSeqSBAIJ);CHKERRQ(ierr);
2462   /* Create the factorization matrix */
2463   ierr = MatCreate(PetscObjectComm((PetscObject)A),&B);CHKERRQ(ierr);
2464   ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,A->rmap->N,A->cmap->N);CHKERRQ(ierr);
2465   ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr);
2466   ierr = PetscNewLog(B,&mumps);CHKERRQ(ierr);
2467   if (isSeqSBAIJ) {
2468     ierr = MatSeqSBAIJSetPreallocation(B,1,0,NULL);CHKERRQ(ierr);
2469 
2470     mumps->ConvertToTriples = MatConvertToTriples_seqsbaij_seqsbaij;
2471   } else {
2472     ierr = MatMPISBAIJSetPreallocation(B,1,0,NULL,0,NULL);CHKERRQ(ierr);
2473 
2474     mumps->ConvertToTriples = MatConvertToTriples_mpisbaij_mpisbaij;
2475   }
2476 
2477   B->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_MUMPS;
2478   B->ops->view                   = MatView_MUMPS;
2479   B->ops->getdiagonal            = MatGetDiagonal_MUMPS;
2480 
2481   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSolverPackage_C",MatFactorGetSolverPackage_mumps);CHKERRQ(ierr);
2482   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSetSchurIS_C",MatFactorSetSchurIS_MUMPS);CHKERRQ(ierr);
2483   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorInvertSchurComplement_C",MatFactorInvertSchurComplement_MUMPS);CHKERRQ(ierr);
2484   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorCreateSchurComplement_C",MatFactorCreateSchurComplement_MUMPS);CHKERRQ(ierr);
2485   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSchurComplement_C",MatFactorGetSchurComplement_MUMPS);CHKERRQ(ierr);
2486   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSolveSchurComplement_C",MatFactorSolveSchurComplement_MUMPS);CHKERRQ(ierr);
2487   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSolveSchurComplementTranspose_C",MatFactorSolveSchurComplementTranspose_MUMPS);CHKERRQ(ierr);
2488   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsSetIcntl_C",MatMumpsSetIcntl_MUMPS);CHKERRQ(ierr);
2489   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetIcntl_C",MatMumpsGetIcntl_MUMPS);CHKERRQ(ierr);
2490   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsSetCntl_C",MatMumpsSetCntl_MUMPS);CHKERRQ(ierr);
2491   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetCntl_C",MatMumpsGetCntl_MUMPS);CHKERRQ(ierr);
2492   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetInfo_C",MatMumpsGetInfo_MUMPS);CHKERRQ(ierr);
2493   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetInfog_C",MatMumpsGetInfog_MUMPS);CHKERRQ(ierr);
2494   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetRinfo_C",MatMumpsGetRinfo_MUMPS);CHKERRQ(ierr);
2495   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetRinfog_C",MatMumpsGetRinfog_MUMPS);CHKERRQ(ierr);
2496 
2497   B->factortype = MAT_FACTOR_CHOLESKY;
2498 #if defined(PETSC_USE_COMPLEX)
2499   mumps->sym = 2;
2500 #else
2501   if (A->spd_set && A->spd) mumps->sym = 1;
2502   else                      mumps->sym = 2;
2503 #endif
2504 
2505   mumps->isAIJ    = PETSC_FALSE;
2506   mumps->Destroy  = B->ops->destroy;
2507   B->ops->destroy = MatDestroy_MUMPS;
2508   B->spptr        = (void*)mumps;
2509 
2510   ierr = PetscInitializeMUMPS(A,mumps);CHKERRQ(ierr);
2511 
2512   *F = B;
2513   PetscFunctionReturn(0);
2514 }
2515 
2516 #undef __FUNCT__
2517 #define __FUNCT__ "MatGetFactor_baij_mumps"
2518 PETSC_EXTERN PetscErrorCode MatGetFactor_baij_mumps(Mat A,MatFactorType ftype,Mat *F)
2519 {
2520   Mat            B;
2521   PetscErrorCode ierr;
2522   Mat_MUMPS      *mumps;
2523   PetscBool      isSeqBAIJ;
2524 
2525   PetscFunctionBegin;
2526   /* Create the factorization matrix */
2527   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQBAIJ,&isSeqBAIJ);CHKERRQ(ierr);
2528   ierr = MatCreate(PetscObjectComm((PetscObject)A),&B);CHKERRQ(ierr);
2529   ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,A->rmap->N,A->cmap->N);CHKERRQ(ierr);
2530   ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr);
2531   if (isSeqBAIJ) {
2532     ierr = MatSeqBAIJSetPreallocation(B,A->rmap->bs,0,NULL);CHKERRQ(ierr);
2533   } else {
2534     ierr = MatMPIBAIJSetPreallocation(B,A->rmap->bs,0,NULL,0,NULL);CHKERRQ(ierr);
2535   }
2536 
2537   ierr = PetscNewLog(B,&mumps);CHKERRQ(ierr);
2538   if (ftype == MAT_FACTOR_LU) {
2539     B->ops->lufactorsymbolic = MatLUFactorSymbolic_BAIJMUMPS;
2540     B->factortype            = MAT_FACTOR_LU;
2541     if (isSeqBAIJ) mumps->ConvertToTriples = MatConvertToTriples_seqbaij_seqaij;
2542     else mumps->ConvertToTriples = MatConvertToTriples_mpibaij_mpiaij;
2543     mumps->sym = 0;
2544   } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot use PETSc BAIJ matrices with MUMPS Cholesky, use SBAIJ or AIJ matrix instead\n");
2545 
2546   B->ops->view        = MatView_MUMPS;
2547   B->ops->getdiagonal = MatGetDiagonal_MUMPS;
2548 
2549   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSolverPackage_C",MatFactorGetSolverPackage_mumps);CHKERRQ(ierr);
2550   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSetSchurIS_C",MatFactorSetSchurIS_MUMPS);CHKERRQ(ierr);
2551   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorInvertSchurComplement_C",MatFactorInvertSchurComplement_MUMPS);CHKERRQ(ierr);
2552   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorCreateSchurComplement_C",MatFactorCreateSchurComplement_MUMPS);CHKERRQ(ierr);
2553   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSchurComplement_C",MatFactorGetSchurComplement_MUMPS);CHKERRQ(ierr);
2554   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSolveSchurComplement_C",MatFactorSolveSchurComplement_MUMPS);CHKERRQ(ierr);
2555   ierr = PetscObjectComposeFunction((PetscObject)B,"MatFactorSolveSchurComplementTranspose_C",MatFactorSolveSchurComplementTranspose_MUMPS);CHKERRQ(ierr);
2556   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsSetIcntl_C",MatMumpsSetIcntl_MUMPS);CHKERRQ(ierr);
2557   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetIcntl_C",MatMumpsGetIcntl_MUMPS);CHKERRQ(ierr);
2558   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsSetCntl_C",MatMumpsSetCntl_MUMPS);CHKERRQ(ierr);
2559   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetCntl_C",MatMumpsGetCntl_MUMPS);CHKERRQ(ierr);
2560   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetInfo_C",MatMumpsGetInfo_MUMPS);CHKERRQ(ierr);
2561   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetInfog_C",MatMumpsGetInfog_MUMPS);CHKERRQ(ierr);
2562   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetRinfo_C",MatMumpsGetRinfo_MUMPS);CHKERRQ(ierr);
2563   ierr = PetscObjectComposeFunction((PetscObject)B,"MatMumpsGetRinfog_C",MatMumpsGetRinfog_MUMPS);CHKERRQ(ierr);
2564 
2565   mumps->isAIJ    = PETSC_TRUE;
2566   mumps->Destroy  = B->ops->destroy;
2567   B->ops->destroy = MatDestroy_MUMPS;
2568   B->spptr        = (void*)mumps;
2569 
2570   ierr = PetscInitializeMUMPS(A,mumps);CHKERRQ(ierr);
2571 
2572   *F = B;
2573   PetscFunctionReturn(0);
2574 }
2575 
2576 PETSC_EXTERN PetscErrorCode MatGetFactor_aij_mumps(Mat,MatFactorType,Mat*);
2577 PETSC_EXTERN PetscErrorCode MatGetFactor_baij_mumps(Mat,MatFactorType,Mat*);
2578 PETSC_EXTERN PetscErrorCode MatGetFactor_sbaij_mumps(Mat,MatFactorType,Mat*);
2579 
2580 #undef __FUNCT__
2581 #define __FUNCT__ "MatSolverPackageRegister_MUMPS"
2582 PETSC_EXTERN PetscErrorCode MatSolverPackageRegister_MUMPS(void)
2583 {
2584   PetscErrorCode ierr;
2585 
2586   PetscFunctionBegin;
2587   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATMPIAIJ,MAT_FACTOR_LU,MatGetFactor_aij_mumps);CHKERRQ(ierr);
2588   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATMPIAIJ,MAT_FACTOR_CHOLESKY,MatGetFactor_aij_mumps);CHKERRQ(ierr);
2589   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATMPIBAIJ,MAT_FACTOR_LU,MatGetFactor_baij_mumps);CHKERRQ(ierr);
2590   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATMPIBAIJ,MAT_FACTOR_CHOLESKY,MatGetFactor_baij_mumps);CHKERRQ(ierr);
2591   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATMPISBAIJ,MAT_FACTOR_CHOLESKY,MatGetFactor_sbaij_mumps);CHKERRQ(ierr);
2592   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATSEQAIJ,MAT_FACTOR_LU,MatGetFactor_aij_mumps);CHKERRQ(ierr);
2593   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATSEQAIJ,MAT_FACTOR_CHOLESKY,MatGetFactor_aij_mumps);CHKERRQ(ierr);
2594   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATSEQBAIJ,MAT_FACTOR_LU,MatGetFactor_baij_mumps);CHKERRQ(ierr);
2595   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATSEQBAIJ,MAT_FACTOR_CHOLESKY,MatGetFactor_baij_mumps);CHKERRQ(ierr);
2596   ierr = MatSolverPackageRegister(MATSOLVERMUMPS,MATSEQSBAIJ,MAT_FACTOR_CHOLESKY,MatGetFactor_sbaij_mumps);CHKERRQ(ierr);
2597   PetscFunctionReturn(0);
2598 }
2599 
2600