xref: /petsc/src/mat/impls/aij/mpi/mkl_cpardiso/mkl_cpardiso.c (revision bcee047adeeb73090d7e36cc71e39fc287cdbb97)
1 
2 #include <petscsys.h>
3 #include <../src/mat/impls/aij/mpi/mpiaij.h> /*I  "petscmat.h"  I*/
4 #include <../src/mat/impls/sbaij/mpi/mpisbaij.h>
5 
6 #if defined(PETSC_HAVE_MKL_INTEL_ILP64)
7   #define MKL_ILP64
8 #endif
9 #include <mkl.h>
10 #include <mkl_cluster_sparse_solver.h>
11 
12 /*
13  *  Possible mkl_cpardiso phases that controls the execution of the solver.
14  *  For more information check mkl_cpardiso manual.
15  */
16 #define JOB_ANALYSIS                                                    11
17 #define JOB_ANALYSIS_NUMERICAL_FACTORIZATION                            12
18 #define JOB_ANALYSIS_NUMERICAL_FACTORIZATION_SOLVE_ITERATIVE_REFINEMENT 13
19 #define JOB_NUMERICAL_FACTORIZATION                                     22
20 #define JOB_NUMERICAL_FACTORIZATION_SOLVE_ITERATIVE_REFINEMENT          23
21 #define JOB_SOLVE_ITERATIVE_REFINEMENT                                  33
22 #define JOB_SOLVE_FORWARD_SUBSTITUTION                                  331
23 #define JOB_SOLVE_DIAGONAL_SUBSTITUTION                                 332
24 #define JOB_SOLVE_BACKWARD_SUBSTITUTION                                 333
25 #define JOB_RELEASE_OF_LU_MEMORY                                        0
26 #define JOB_RELEASE_OF_ALL_MEMORY                                       -1
27 
28 #define IPARM_SIZE 64
29 #define INT_TYPE   MKL_INT
30 
31 static const char *Err_MSG_CPardiso(int errNo)
32 {
33   switch (errNo) {
34   case -1:
35     return "input inconsistent";
36     break;
37   case -2:
38     return "not enough memory";
39     break;
40   case -3:
41     return "reordering problem";
42     break;
43   case -4:
44     return "zero pivot, numerical factorization or iterative refinement problem";
45     break;
46   case -5:
47     return "unclassified (internal) error";
48     break;
49   case -6:
50     return "preordering failed (matrix types 11, 13 only)";
51     break;
52   case -7:
53     return "diagonal matrix problem";
54     break;
55   case -8:
56     return "32-bit integer overflow problem";
57     break;
58   case -9:
59     return "not enough memory for OOC";
60     break;
61   case -10:
62     return "problems with opening OOC temporary files";
63     break;
64   case -11:
65     return "read/write problems with the OOC data file";
66     break;
67   default:
68     return "unknown error";
69   }
70 }
71 
72 /*
73  *  Internal data structure.
74  *  For more information check mkl_cpardiso manual.
75  */
76 
77 typedef struct {
78   /* Configuration vector */
79   INT_TYPE iparm[IPARM_SIZE];
80 
81   /*
82    * Internal mkl_cpardiso memory location.
83    * After the first call to mkl_cpardiso do not modify pt, as that could cause a serious memory leak.
84    */
85   void *pt[IPARM_SIZE];
86 
87   MPI_Fint comm_mkl_cpardiso;
88 
89   /* Basic mkl_cpardiso info*/
90   INT_TYPE phase, maxfct, mnum, mtype, n, nrhs, msglvl, err;
91 
92   /* Matrix structure */
93   PetscScalar *a;
94 
95   INT_TYPE *ia, *ja;
96 
97   /* Number of non-zero elements */
98   INT_TYPE nz;
99 
100   /* Row permutaton vector*/
101   INT_TYPE *perm;
102 
103   /* Define is matrix preserve sparce structure. */
104   MatStructure matstruc;
105 
106   PetscErrorCode (*ConvertToTriples)(Mat, MatReuse, PetscInt *, PetscInt **, PetscInt **, PetscScalar **);
107 
108   /* True if mkl_cpardiso function have been used. */
109   PetscBool CleanUp;
110 } Mat_MKL_CPARDISO;
111 
112 /*
113  * Copy the elements of matrix A.
114  * Input:
115  *   - Mat A: MATSEQAIJ matrix
116  *   - int shift: matrix index.
117  *     - 0 for c representation
118  *     - 1 for fortran representation
119  *   - MatReuse reuse:
120  *     - MAT_INITIAL_MATRIX: Create a new aij representation
121  *     - MAT_REUSE_MATRIX: Reuse all aij representation and just change values
122  * Output:
123  *   - int *nnz: Number of nonzero-elements.
124  *   - int **r pointer to i index
125  *   - int **c pointer to j elements
126  *   - MATRIXTYPE **v: Non-zero elements
127  */
128 PetscErrorCode MatCopy_seqaij_seqaij_MKL_CPARDISO(Mat A, MatReuse reuse, PetscInt *nnz, PetscInt **r, PetscInt **c, PetscScalar **v)
129 {
130   Mat_SeqAIJ *aa = (Mat_SeqAIJ *)A->data;
131 
132   PetscFunctionBegin;
133   *v = aa->a;
134   if (reuse == MAT_INITIAL_MATRIX) {
135     *r   = (INT_TYPE *)aa->i;
136     *c   = (INT_TYPE *)aa->j;
137     *nnz = aa->nz;
138   }
139   PetscFunctionReturn(PETSC_SUCCESS);
140 }
141 
142 PetscErrorCode MatConvertToTriples_mpiaij_mpiaij_MKL_CPARDISO(Mat A, MatReuse reuse, PetscInt *nnz, PetscInt **r, PetscInt **c, PetscScalar **v)
143 {
144   const PetscInt    *ai, *aj, *bi, *bj, *garray, m = A->rmap->n, *ajj, *bjj;
145   PetscInt           rstart, nz, i, j, countA, countB;
146   PetscInt          *row, *col;
147   const PetscScalar *av, *bv;
148   PetscScalar       *val;
149   Mat_MPIAIJ        *mat = (Mat_MPIAIJ *)A->data;
150   Mat_SeqAIJ        *aa  = (Mat_SeqAIJ *)(mat->A)->data;
151   Mat_SeqAIJ        *bb  = (Mat_SeqAIJ *)(mat->B)->data;
152   PetscInt           colA_start, jB, jcol;
153 
154   PetscFunctionBegin;
155   ai     = aa->i;
156   aj     = aa->j;
157   bi     = bb->i;
158   bj     = bb->j;
159   rstart = A->rmap->rstart;
160   av     = aa->a;
161   bv     = bb->a;
162 
163   garray = mat->garray;
164 
165   if (reuse == MAT_INITIAL_MATRIX) {
166     nz   = aa->nz + bb->nz;
167     *nnz = nz;
168     PetscCall(PetscMalloc3(m + 1, &row, nz, &col, nz, &val));
169     *r = row;
170     *c = col;
171     *v = val;
172   } else {
173     row = *r;
174     col = *c;
175     val = *v;
176   }
177 
178   nz = 0;
179   for (i = 0; i < m; i++) {
180     row[i] = nz;
181     countA = ai[i + 1] - ai[i];
182     countB = bi[i + 1] - bi[i];
183     ajj    = aj + ai[i]; /* ptr to the beginning of this row */
184     bjj    = bj + bi[i];
185 
186     /* B part, smaller col index */
187     colA_start = rstart + ajj[0]; /* the smallest global col index of A */
188     jB         = 0;
189     for (j = 0; j < countB; j++) {
190       jcol = garray[bjj[j]];
191       if (jcol > colA_start) break;
192       col[nz]   = jcol;
193       val[nz++] = *bv++;
194     }
195     jB = j;
196 
197     /* A part */
198     for (j = 0; j < countA; j++) {
199       col[nz]   = rstart + ajj[j];
200       val[nz++] = *av++;
201     }
202 
203     /* B part, larger col index */
204     for (j = jB; j < countB; j++) {
205       col[nz]   = garray[bjj[j]];
206       val[nz++] = *bv++;
207     }
208   }
209   row[m] = nz;
210 
211   PetscFunctionReturn(PETSC_SUCCESS);
212 }
213 
214 PetscErrorCode MatConvertToTriples_mpibaij_mpibaij_MKL_CPARDISO(Mat A, MatReuse reuse, PetscInt *nnz, PetscInt **r, PetscInt **c, PetscScalar **v)
215 {
216   const PetscInt    *ai, *aj, *bi, *bj, *garray, bs = A->rmap->bs, bs2 = bs * bs, m = A->rmap->n / bs, *ajj, *bjj;
217   PetscInt           rstart, nz, i, j, countA, countB;
218   PetscInt          *row, *col;
219   const PetscScalar *av, *bv;
220   PetscScalar       *val;
221   Mat_MPIBAIJ       *mat = (Mat_MPIBAIJ *)A->data;
222   Mat_SeqBAIJ       *aa  = (Mat_SeqBAIJ *)(mat->A)->data;
223   Mat_SeqBAIJ       *bb  = (Mat_SeqBAIJ *)(mat->B)->data;
224   PetscInt           colA_start, jB, jcol;
225 
226   PetscFunctionBegin;
227   ai     = aa->i;
228   aj     = aa->j;
229   bi     = bb->i;
230   bj     = bb->j;
231   rstart = A->rmap->rstart / bs;
232   av     = aa->a;
233   bv     = bb->a;
234 
235   garray = mat->garray;
236 
237   if (reuse == MAT_INITIAL_MATRIX) {
238     nz   = aa->nz + bb->nz;
239     *nnz = nz;
240     PetscCall(PetscMalloc3(m + 1, &row, nz, &col, nz * bs2, &val));
241     *r = row;
242     *c = col;
243     *v = val;
244   } else {
245     row = *r;
246     col = *c;
247     val = *v;
248   }
249 
250   nz = 0;
251   for (i = 0; i < m; i++) {
252     row[i] = nz + 1;
253     countA = ai[i + 1] - ai[i];
254     countB = bi[i + 1] - bi[i];
255     ajj    = aj + ai[i]; /* ptr to the beginning of this row */
256     bjj    = bj + bi[i];
257 
258     /* B part, smaller col index */
259     colA_start = rstart + (countA > 0 ? ajj[0] : 0); /* the smallest global col index of A */
260     jB         = 0;
261     for (j = 0; j < countB; j++) {
262       jcol = garray[bjj[j]];
263       if (jcol > colA_start) break;
264       col[nz++] = jcol + 1;
265     }
266     jB = j;
267     PetscCall(PetscArraycpy(val, bv, jB * bs2));
268     val += jB * bs2;
269     bv += jB * bs2;
270 
271     /* A part */
272     for (j = 0; j < countA; j++) col[nz++] = rstart + ajj[j] + 1;
273     PetscCall(PetscArraycpy(val, av, countA * bs2));
274     val += countA * bs2;
275     av += countA * bs2;
276 
277     /* B part, larger col index */
278     for (j = jB; j < countB; j++) col[nz++] = garray[bjj[j]] + 1;
279     PetscCall(PetscArraycpy(val, bv, (countB - jB) * bs2));
280     val += (countB - jB) * bs2;
281     bv += (countB - jB) * bs2;
282   }
283   row[m] = nz + 1;
284 
285   PetscFunctionReturn(PETSC_SUCCESS);
286 }
287 
288 PetscErrorCode MatConvertToTriples_mpisbaij_mpisbaij_MKL_CPARDISO(Mat A, MatReuse reuse, PetscInt *nnz, PetscInt **r, PetscInt **c, PetscScalar **v)
289 {
290   const PetscInt    *ai, *aj, *bi, *bj, *garray, bs = A->rmap->bs, bs2 = bs * bs, m = A->rmap->n / bs, *ajj, *bjj;
291   PetscInt           rstart, nz, i, j, countA, countB;
292   PetscInt          *row, *col;
293   const PetscScalar *av, *bv;
294   PetscScalar       *val;
295   Mat_MPISBAIJ      *mat = (Mat_MPISBAIJ *)A->data;
296   Mat_SeqSBAIJ      *aa  = (Mat_SeqSBAIJ *)(mat->A)->data;
297   Mat_SeqBAIJ       *bb  = (Mat_SeqBAIJ *)(mat->B)->data;
298 
299   PetscFunctionBegin;
300   ai     = aa->i;
301   aj     = aa->j;
302   bi     = bb->i;
303   bj     = bb->j;
304   rstart = A->rmap->rstart / bs;
305   av     = aa->a;
306   bv     = bb->a;
307 
308   garray = mat->garray;
309 
310   if (reuse == MAT_INITIAL_MATRIX) {
311     nz   = aa->nz + bb->nz;
312     *nnz = nz;
313     PetscCall(PetscMalloc3(m + 1, &row, nz, &col, nz * bs2, &val));
314     *r = row;
315     *c = col;
316     *v = val;
317   } else {
318     row = *r;
319     col = *c;
320     val = *v;
321   }
322 
323   nz = 0;
324   for (i = 0; i < m; i++) {
325     row[i] = nz + 1;
326     countA = ai[i + 1] - ai[i];
327     countB = bi[i + 1] - bi[i];
328     ajj    = aj + ai[i]; /* ptr to the beginning of this row */
329     bjj    = bj + bi[i];
330 
331     /* A part */
332     for (j = 0; j < countA; j++) col[nz++] = rstart + ajj[j] + 1;
333     PetscCall(PetscArraycpy(val, av, countA * bs2));
334     val += countA * bs2;
335     av += countA * bs2;
336 
337     /* B part, larger col index */
338     for (j = 0; j < countB; j++) col[nz++] = garray[bjj[j]] + 1;
339     PetscCall(PetscArraycpy(val, bv, countB * bs2));
340     val += countB * bs2;
341     bv += countB * bs2;
342   }
343   row[m] = nz + 1;
344 
345   PetscFunctionReturn(PETSC_SUCCESS);
346 }
347 
348 /*
349  * Free memory for Mat_MKL_CPARDISO structure and pointers to objects.
350  */
351 PetscErrorCode MatDestroy_MKL_CPARDISO(Mat A)
352 {
353   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)A->data;
354   MPI_Comm          comm;
355 
356   PetscFunctionBegin;
357   /* Terminate instance, deallocate memories */
358   if (mat_mkl_cpardiso->CleanUp) {
359     mat_mkl_cpardiso->phase = JOB_RELEASE_OF_ALL_MEMORY;
360 
361     cluster_sparse_solver(mat_mkl_cpardiso->pt, &mat_mkl_cpardiso->maxfct, &mat_mkl_cpardiso->mnum, &mat_mkl_cpardiso->mtype, &mat_mkl_cpardiso->phase, &mat_mkl_cpardiso->n, NULL, NULL, NULL, mat_mkl_cpardiso->perm, &mat_mkl_cpardiso->nrhs,
362                           mat_mkl_cpardiso->iparm, &mat_mkl_cpardiso->msglvl, NULL, NULL, &mat_mkl_cpardiso->comm_mkl_cpardiso, (PetscInt *)&mat_mkl_cpardiso->err);
363   }
364 
365   if (mat_mkl_cpardiso->ConvertToTriples != MatCopy_seqaij_seqaij_MKL_CPARDISO) PetscCall(PetscFree3(mat_mkl_cpardiso->ia, mat_mkl_cpardiso->ja, mat_mkl_cpardiso->a));
366   comm = MPI_Comm_f2c(mat_mkl_cpardiso->comm_mkl_cpardiso);
367   PetscCallMPI(MPI_Comm_free(&comm));
368   PetscCall(PetscFree(A->data));
369 
370   /* clear composed functions */
371   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatFactorGetSolverType_C", NULL));
372   PetscCall(PetscObjectComposeFunction((PetscObject)A, "MatMkl_CPardisoSetCntl_C", NULL));
373   PetscFunctionReturn(PETSC_SUCCESS);
374 }
375 
376 /*
377  * Computes Ax = b
378  */
379 PetscErrorCode MatSolve_MKL_CPARDISO(Mat A, Vec b, Vec x)
380 {
381   Mat_MKL_CPARDISO  *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)(A)->data;
382   PetscScalar       *xarray;
383   const PetscScalar *barray;
384 
385   PetscFunctionBegin;
386   mat_mkl_cpardiso->nrhs = 1;
387   PetscCall(VecGetArray(x, &xarray));
388   PetscCall(VecGetArrayRead(b, &barray));
389 
390   /* solve phase */
391   mat_mkl_cpardiso->phase = JOB_SOLVE_ITERATIVE_REFINEMENT;
392   cluster_sparse_solver(mat_mkl_cpardiso->pt, &mat_mkl_cpardiso->maxfct, &mat_mkl_cpardiso->mnum, &mat_mkl_cpardiso->mtype, &mat_mkl_cpardiso->phase, &mat_mkl_cpardiso->n, mat_mkl_cpardiso->a, mat_mkl_cpardiso->ia, mat_mkl_cpardiso->ja,
393                         mat_mkl_cpardiso->perm, &mat_mkl_cpardiso->nrhs, mat_mkl_cpardiso->iparm, &mat_mkl_cpardiso->msglvl, (void *)barray, (void *)xarray, &mat_mkl_cpardiso->comm_mkl_cpardiso, (PetscInt *)&mat_mkl_cpardiso->err);
394 
395   PetscCheck(mat_mkl_cpardiso->err >= 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "Error reported by MKL_CPARDISO: err=%d, msg = \"%s\". Please check manual", mat_mkl_cpardiso->err, Err_MSG_CPardiso(mat_mkl_cpardiso->err));
396 
397   PetscCall(VecRestoreArray(x, &xarray));
398   PetscCall(VecRestoreArrayRead(b, &barray));
399   mat_mkl_cpardiso->CleanUp = PETSC_TRUE;
400   PetscFunctionReturn(PETSC_SUCCESS);
401 }
402 
403 PetscErrorCode MatSolveTranspose_MKL_CPARDISO(Mat A, Vec b, Vec x)
404 {
405   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)A->data;
406 
407   PetscFunctionBegin;
408 #if defined(PETSC_USE_COMPLEX)
409   mat_mkl_cpardiso->iparm[12 - 1] = 1;
410 #else
411   mat_mkl_cpardiso->iparm[12 - 1] = 2;
412 #endif
413   PetscCall(MatSolve_MKL_CPARDISO(A, b, x));
414   mat_mkl_cpardiso->iparm[12 - 1] = 0;
415   PetscFunctionReturn(PETSC_SUCCESS);
416 }
417 
418 PetscErrorCode MatMatSolve_MKL_CPARDISO(Mat A, Mat B, Mat X)
419 {
420   Mat_MKL_CPARDISO  *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)(A)->data;
421   PetscScalar       *xarray;
422   const PetscScalar *barray;
423 
424   PetscFunctionBegin;
425   PetscCall(MatGetSize(B, NULL, (PetscInt *)&mat_mkl_cpardiso->nrhs));
426 
427   if (mat_mkl_cpardiso->nrhs > 0) {
428     PetscCall(MatDenseGetArrayRead(B, &barray));
429     PetscCall(MatDenseGetArray(X, &xarray));
430 
431     PetscCheck(barray != xarray, PETSC_COMM_SELF, PETSC_ERR_SUP, "B and X cannot share the same memory location");
432 
433     /* solve phase */
434     mat_mkl_cpardiso->phase = JOB_SOLVE_ITERATIVE_REFINEMENT;
435     cluster_sparse_solver(mat_mkl_cpardiso->pt, &mat_mkl_cpardiso->maxfct, &mat_mkl_cpardiso->mnum, &mat_mkl_cpardiso->mtype, &mat_mkl_cpardiso->phase, &mat_mkl_cpardiso->n, mat_mkl_cpardiso->a, mat_mkl_cpardiso->ia, mat_mkl_cpardiso->ja,
436                           mat_mkl_cpardiso->perm, &mat_mkl_cpardiso->nrhs, mat_mkl_cpardiso->iparm, &mat_mkl_cpardiso->msglvl, (void *)barray, (void *)xarray, &mat_mkl_cpardiso->comm_mkl_cpardiso, (PetscInt *)&mat_mkl_cpardiso->err);
437     PetscCheck(mat_mkl_cpardiso->err >= 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "Error reported by MKL_CPARDISO: err=%d, msg = \"%s\". Please check manual", mat_mkl_cpardiso->err, Err_MSG_CPardiso(mat_mkl_cpardiso->err));
438     PetscCall(MatDenseRestoreArrayRead(B, &barray));
439     PetscCall(MatDenseRestoreArray(X, &xarray));
440   }
441   mat_mkl_cpardiso->CleanUp = PETSC_TRUE;
442   PetscFunctionReturn(PETSC_SUCCESS);
443 }
444 
445 /*
446  * LU Decomposition
447  */
448 PetscErrorCode MatFactorNumeric_MKL_CPARDISO(Mat F, Mat A, const MatFactorInfo *info)
449 {
450   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)(F)->data;
451 
452   PetscFunctionBegin;
453   mat_mkl_cpardiso->matstruc = SAME_NONZERO_PATTERN;
454   PetscCall((*mat_mkl_cpardiso->ConvertToTriples)(A, MAT_REUSE_MATRIX, &mat_mkl_cpardiso->nz, &mat_mkl_cpardiso->ia, &mat_mkl_cpardiso->ja, &mat_mkl_cpardiso->a));
455 
456   mat_mkl_cpardiso->phase = JOB_NUMERICAL_FACTORIZATION;
457   cluster_sparse_solver(mat_mkl_cpardiso->pt, &mat_mkl_cpardiso->maxfct, &mat_mkl_cpardiso->mnum, &mat_mkl_cpardiso->mtype, &mat_mkl_cpardiso->phase, &mat_mkl_cpardiso->n, mat_mkl_cpardiso->a, mat_mkl_cpardiso->ia, mat_mkl_cpardiso->ja,
458                         mat_mkl_cpardiso->perm, &mat_mkl_cpardiso->nrhs, mat_mkl_cpardiso->iparm, &mat_mkl_cpardiso->msglvl, NULL, NULL, &mat_mkl_cpardiso->comm_mkl_cpardiso, &mat_mkl_cpardiso->err);
459   PetscCheck(mat_mkl_cpardiso->err >= 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "Error reported by MKL_CPARDISO: err=%d, msg = \"%s\". Please check manual", mat_mkl_cpardiso->err, Err_MSG_CPardiso(mat_mkl_cpardiso->err));
460 
461   mat_mkl_cpardiso->matstruc = SAME_NONZERO_PATTERN;
462   mat_mkl_cpardiso->CleanUp  = PETSC_TRUE;
463   PetscFunctionReturn(PETSC_SUCCESS);
464 }
465 
466 /* Sets mkl_cpardiso options from the options database */
467 PetscErrorCode MatSetFromOptions_MKL_CPARDISO(Mat F, Mat A)
468 {
469   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)F->data;
470   PetscInt          icntl, threads;
471   PetscBool         flg;
472 
473   PetscFunctionBegin;
474   PetscOptionsBegin(PetscObjectComm((PetscObject)F), ((PetscObject)F)->prefix, "MKL_CPARDISO Options", "Mat");
475   PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_65", "Suggested number of threads to use within MKL_CPARDISO", "None", threads, &threads, &flg));
476   if (flg) mkl_set_num_threads((int)threads);
477 
478   PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_66", "Maximum number of factors with identical sparsity structure that must be kept in memory at the same time", "None", mat_mkl_cpardiso->maxfct, &icntl, &flg));
479   if (flg) mat_mkl_cpardiso->maxfct = icntl;
480 
481   PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_67", "Indicates the actual matrix for the solution phase", "None", mat_mkl_cpardiso->mnum, &icntl, &flg));
482   if (flg) mat_mkl_cpardiso->mnum = icntl;
483 
484   PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_68", "Message level information", "None", mat_mkl_cpardiso->msglvl, &icntl, &flg));
485   if (flg) mat_mkl_cpardiso->msglvl = icntl;
486 
487   PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_69", "Defines the matrix type", "None", mat_mkl_cpardiso->mtype, &icntl, &flg));
488   if (flg) mat_mkl_cpardiso->mtype = icntl;
489   PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_1", "Use default values", "None", mat_mkl_cpardiso->iparm[0], &icntl, &flg));
490 
491   if (flg && icntl != 0) {
492     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_2", "Fill-in reducing ordering for the input matrix", "None", mat_mkl_cpardiso->iparm[1], &icntl, &flg));
493     if (flg) mat_mkl_cpardiso->iparm[1] = icntl;
494 
495     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_4", "Preconditioned CGS/CG", "None", mat_mkl_cpardiso->iparm[3], &icntl, &flg));
496     if (flg) mat_mkl_cpardiso->iparm[3] = icntl;
497 
498     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_5", "User permutation", "None", mat_mkl_cpardiso->iparm[4], &icntl, &flg));
499     if (flg) mat_mkl_cpardiso->iparm[4] = icntl;
500 
501     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_6", "Write solution on x", "None", mat_mkl_cpardiso->iparm[5], &icntl, &flg));
502     if (flg) mat_mkl_cpardiso->iparm[5] = icntl;
503 
504     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_8", "Iterative refinement step", "None", mat_mkl_cpardiso->iparm[7], &icntl, &flg));
505     if (flg) mat_mkl_cpardiso->iparm[7] = icntl;
506 
507     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_10", "Pivoting perturbation", "None", mat_mkl_cpardiso->iparm[9], &icntl, &flg));
508     if (flg) mat_mkl_cpardiso->iparm[9] = icntl;
509 
510     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_11", "Scaling vectors", "None", mat_mkl_cpardiso->iparm[10], &icntl, &flg));
511     if (flg) mat_mkl_cpardiso->iparm[10] = icntl;
512 
513     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_12", "Solve with transposed or conjugate transposed matrix A", "None", mat_mkl_cpardiso->iparm[11], &icntl, &flg));
514     if (flg) mat_mkl_cpardiso->iparm[11] = icntl;
515 
516     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_13", "Improved accuracy using (non-) symmetric weighted matching", "None", mat_mkl_cpardiso->iparm[12], &icntl, &flg));
517     if (flg) mat_mkl_cpardiso->iparm[12] = icntl;
518 
519     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_18", "Numbers of non-zero elements", "None", mat_mkl_cpardiso->iparm[17], &icntl, &flg));
520     if (flg) mat_mkl_cpardiso->iparm[17] = icntl;
521 
522     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_19", "Report number of floating point operations", "None", mat_mkl_cpardiso->iparm[18], &icntl, &flg));
523     if (flg) mat_mkl_cpardiso->iparm[18] = icntl;
524 
525     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_21", "Pivoting for symmetric indefinite matrices", "None", mat_mkl_cpardiso->iparm[20], &icntl, &flg));
526     if (flg) mat_mkl_cpardiso->iparm[20] = icntl;
527 
528     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_24", "Parallel factorization control", "None", mat_mkl_cpardiso->iparm[23], &icntl, &flg));
529     if (flg) mat_mkl_cpardiso->iparm[23] = icntl;
530 
531     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_25", "Parallel forward/backward solve control", "None", mat_mkl_cpardiso->iparm[24], &icntl, &flg));
532     if (flg) mat_mkl_cpardiso->iparm[24] = icntl;
533 
534     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_27", "Matrix checker", "None", mat_mkl_cpardiso->iparm[26], &icntl, &flg));
535     if (flg) mat_mkl_cpardiso->iparm[26] = icntl;
536 
537     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_31", "Partial solve and computing selected components of the solution vectors", "None", mat_mkl_cpardiso->iparm[30], &icntl, &flg));
538     if (flg) mat_mkl_cpardiso->iparm[30] = icntl;
539 
540     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_34", "Optimal number of threads for conditional numerical reproducibility (CNR) mode", "None", mat_mkl_cpardiso->iparm[33], &icntl, &flg));
541     if (flg) mat_mkl_cpardiso->iparm[33] = icntl;
542 
543     PetscCall(PetscOptionsInt("-mat_mkl_cpardiso_60", "Intel MKL_CPARDISO mode", "None", mat_mkl_cpardiso->iparm[59], &icntl, &flg));
544     if (flg) mat_mkl_cpardiso->iparm[59] = icntl;
545   }
546 
547   PetscOptionsEnd();
548   PetscFunctionReturn(PETSC_SUCCESS);
549 }
550 
551 PetscErrorCode PetscInitialize_MKL_CPARDISO(Mat A, Mat_MKL_CPARDISO *mat_mkl_cpardiso)
552 {
553   PetscInt    bs;
554   PetscBool   match;
555   PetscMPIInt size;
556   MPI_Comm    comm;
557 
558   PetscFunctionBegin;
559 
560   PetscCallMPI(MPI_Comm_dup(PetscObjectComm((PetscObject)A), &comm));
561   PetscCallMPI(MPI_Comm_size(comm, &size));
562   mat_mkl_cpardiso->comm_mkl_cpardiso = MPI_Comm_c2f(comm);
563 
564   mat_mkl_cpardiso->CleanUp = PETSC_FALSE;
565   mat_mkl_cpardiso->maxfct  = 1;
566   mat_mkl_cpardiso->mnum    = 1;
567   mat_mkl_cpardiso->n       = A->rmap->N;
568   if (mat_mkl_cpardiso->iparm[36]) mat_mkl_cpardiso->n /= mat_mkl_cpardiso->iparm[36];
569   mat_mkl_cpardiso->msglvl = 0;
570   mat_mkl_cpardiso->nrhs   = 1;
571   mat_mkl_cpardiso->err    = 0;
572   mat_mkl_cpardiso->phase  = -1;
573 #if defined(PETSC_USE_COMPLEX)
574   mat_mkl_cpardiso->mtype = 13;
575 #else
576   mat_mkl_cpardiso->mtype         = 11;
577 #endif
578 
579 #if defined(PETSC_USE_REAL_SINGLE)
580   mat_mkl_cpardiso->iparm[27] = 1;
581 #else
582   mat_mkl_cpardiso->iparm[27]     = 0;
583 #endif
584 
585   mat_mkl_cpardiso->iparm[0]  = 1;  /* Solver default parameters overridden with provided by iparm */
586   mat_mkl_cpardiso->iparm[1]  = 2;  /* Use METIS for fill-in reordering */
587   mat_mkl_cpardiso->iparm[5]  = 0;  /* Write solution into x */
588   mat_mkl_cpardiso->iparm[7]  = 2;  /* Max number of iterative refinement steps */
589   mat_mkl_cpardiso->iparm[9]  = 13; /* Perturb the pivot elements with 1E-13 */
590   mat_mkl_cpardiso->iparm[10] = 1;  /* Use nonsymmetric permutation and scaling MPS */
591   mat_mkl_cpardiso->iparm[12] = 1;  /* Switch on Maximum Weighted Matching algorithm (default for non-symmetric) */
592   mat_mkl_cpardiso->iparm[17] = -1; /* Output: Number of nonzeros in the factor LU */
593   mat_mkl_cpardiso->iparm[18] = -1; /* Output: Mflops for LU factorization */
594   mat_mkl_cpardiso->iparm[26] = 1;  /* Check input data for correctness */
595 
596   mat_mkl_cpardiso->iparm[39] = 0;
597   if (size > 1) {
598     mat_mkl_cpardiso->iparm[39] = 2;
599     mat_mkl_cpardiso->iparm[40] = A->rmap->rstart;
600     mat_mkl_cpardiso->iparm[41] = A->rmap->rend - 1;
601   }
602   PetscCall(PetscObjectTypeCompareAny((PetscObject)A, &match, MATMPIBAIJ, MATMPISBAIJ, ""));
603   if (match) {
604     PetscCall(MatGetBlockSize(A, &bs));
605     mat_mkl_cpardiso->iparm[36] = bs;
606     mat_mkl_cpardiso->iparm[40] /= bs;
607     mat_mkl_cpardiso->iparm[41] /= bs;
608     mat_mkl_cpardiso->iparm[40]++;
609     mat_mkl_cpardiso->iparm[41]++;
610     mat_mkl_cpardiso->iparm[34] = 0; /* Fortran style */
611   } else {
612     mat_mkl_cpardiso->iparm[34] = 1; /* C style */
613   }
614 
615   mat_mkl_cpardiso->perm = 0;
616   PetscFunctionReturn(PETSC_SUCCESS);
617 }
618 
619 /*
620  * Symbolic decomposition. Mkl_Pardiso analysis phase.
621  */
622 PetscErrorCode MatLUFactorSymbolic_AIJMKL_CPARDISO(Mat F, Mat A, IS r, IS c, const MatFactorInfo *info)
623 {
624   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)F->data;
625 
626   PetscFunctionBegin;
627   mat_mkl_cpardiso->matstruc = DIFFERENT_NONZERO_PATTERN;
628 
629   /* Set MKL_CPARDISO options from the options database */
630   PetscCall(MatSetFromOptions_MKL_CPARDISO(F, A));
631   PetscCall((*mat_mkl_cpardiso->ConvertToTriples)(A, MAT_INITIAL_MATRIX, &mat_mkl_cpardiso->nz, &mat_mkl_cpardiso->ia, &mat_mkl_cpardiso->ja, &mat_mkl_cpardiso->a));
632 
633   mat_mkl_cpardiso->n = A->rmap->N;
634   if (mat_mkl_cpardiso->iparm[36]) mat_mkl_cpardiso->n /= mat_mkl_cpardiso->iparm[36];
635 
636   /* analysis phase */
637   mat_mkl_cpardiso->phase = JOB_ANALYSIS;
638 
639   cluster_sparse_solver(mat_mkl_cpardiso->pt, &mat_mkl_cpardiso->maxfct, &mat_mkl_cpardiso->mnum, &mat_mkl_cpardiso->mtype, &mat_mkl_cpardiso->phase, &mat_mkl_cpardiso->n, mat_mkl_cpardiso->a, mat_mkl_cpardiso->ia, mat_mkl_cpardiso->ja,
640                         mat_mkl_cpardiso->perm, &mat_mkl_cpardiso->nrhs, mat_mkl_cpardiso->iparm, &mat_mkl_cpardiso->msglvl, NULL, NULL, &mat_mkl_cpardiso->comm_mkl_cpardiso, (PetscInt *)&mat_mkl_cpardiso->err);
641 
642   PetscCheck(mat_mkl_cpardiso->err >= 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "Error reported by MKL_CPARDISO: err=%d, msg = \"%s\".Check manual", mat_mkl_cpardiso->err, Err_MSG_CPardiso(mat_mkl_cpardiso->err));
643 
644   mat_mkl_cpardiso->CleanUp = PETSC_TRUE;
645   F->ops->lufactornumeric   = MatFactorNumeric_MKL_CPARDISO;
646   F->ops->solve             = MatSolve_MKL_CPARDISO;
647   F->ops->solvetranspose    = MatSolveTranspose_MKL_CPARDISO;
648   F->ops->matsolve          = MatMatSolve_MKL_CPARDISO;
649   PetscFunctionReturn(PETSC_SUCCESS);
650 }
651 
652 PetscErrorCode MatCholeskyFactorSymbolic_AIJMKL_CPARDISO(Mat F, Mat A, IS perm, const MatFactorInfo *info)
653 {
654   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)F->data;
655 
656   PetscFunctionBegin;
657   mat_mkl_cpardiso->matstruc = DIFFERENT_NONZERO_PATTERN;
658 
659   /* Set MKL_CPARDISO options from the options database */
660   PetscCall(MatSetFromOptions_MKL_CPARDISO(F, A));
661   PetscCall((*mat_mkl_cpardiso->ConvertToTriples)(A, MAT_INITIAL_MATRIX, &mat_mkl_cpardiso->nz, &mat_mkl_cpardiso->ia, &mat_mkl_cpardiso->ja, &mat_mkl_cpardiso->a));
662 
663   mat_mkl_cpardiso->n = A->rmap->N;
664   if (mat_mkl_cpardiso->iparm[36]) mat_mkl_cpardiso->n /= mat_mkl_cpardiso->iparm[36];
665   PetscCheck(!PetscDefined(USE_COMPLEX), PetscObjectComm((PetscObject)A), PETSC_ERR_SUP, "No support for PARDISO CHOLESKY with complex scalars! Use MAT_FACTOR_LU instead");
666   if (A->spd == PETSC_BOOL3_TRUE) mat_mkl_cpardiso->mtype = 2;
667   else mat_mkl_cpardiso->mtype = -2;
668 
669   /* analysis phase */
670   mat_mkl_cpardiso->phase = JOB_ANALYSIS;
671 
672   cluster_sparse_solver(mat_mkl_cpardiso->pt, &mat_mkl_cpardiso->maxfct, &mat_mkl_cpardiso->mnum, &mat_mkl_cpardiso->mtype, &mat_mkl_cpardiso->phase, &mat_mkl_cpardiso->n, mat_mkl_cpardiso->a, mat_mkl_cpardiso->ia, mat_mkl_cpardiso->ja,
673                         mat_mkl_cpardiso->perm, &mat_mkl_cpardiso->nrhs, mat_mkl_cpardiso->iparm, &mat_mkl_cpardiso->msglvl, NULL, NULL, &mat_mkl_cpardiso->comm_mkl_cpardiso, (PetscInt *)&mat_mkl_cpardiso->err);
674 
675   PetscCheck(mat_mkl_cpardiso->err >= 0, PETSC_COMM_SELF, PETSC_ERR_LIB, "Error reported by MKL_CPARDISO: err=%d, msg = \"%s\".Check manual", mat_mkl_cpardiso->err, Err_MSG_CPardiso(mat_mkl_cpardiso->err));
676 
677   mat_mkl_cpardiso->CleanUp     = PETSC_TRUE;
678   F->ops->choleskyfactornumeric = MatFactorNumeric_MKL_CPARDISO;
679   F->ops->solve                 = MatSolve_MKL_CPARDISO;
680   F->ops->solvetranspose        = MatSolveTranspose_MKL_CPARDISO;
681   F->ops->matsolve              = MatMatSolve_MKL_CPARDISO;
682   PetscFunctionReturn(PETSC_SUCCESS);
683 }
684 
685 PetscErrorCode MatView_MKL_CPARDISO(Mat A, PetscViewer viewer)
686 {
687   PetscBool         iascii;
688   PetscViewerFormat format;
689   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)A->data;
690   PetscInt          i;
691 
692   PetscFunctionBegin;
693   /* check if matrix is mkl_cpardiso type */
694   if (A->ops->solve != MatSolve_MKL_CPARDISO) PetscFunctionReturn(PETSC_SUCCESS);
695 
696   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &iascii));
697   if (iascii) {
698     PetscCall(PetscViewerGetFormat(viewer, &format));
699     if (format == PETSC_VIEWER_ASCII_INFO) {
700       PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO run parameters:\n"));
701       PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO phase:             %d \n", mat_mkl_cpardiso->phase));
702       for (i = 1; i <= 64; i++) PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO iparm[%d]:     %d \n", i, mat_mkl_cpardiso->iparm[i - 1]));
703       PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO maxfct:     %d \n", mat_mkl_cpardiso->maxfct));
704       PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO mnum:     %d \n", mat_mkl_cpardiso->mnum));
705       PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO mtype:     %d \n", mat_mkl_cpardiso->mtype));
706       PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO n:     %d \n", mat_mkl_cpardiso->n));
707       PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO nrhs:     %d \n", mat_mkl_cpardiso->nrhs));
708       PetscCall(PetscViewerASCIIPrintf(viewer, "MKL_CPARDISO msglvl:     %d \n", mat_mkl_cpardiso->msglvl));
709     }
710   }
711   PetscFunctionReturn(PETSC_SUCCESS);
712 }
713 
714 PetscErrorCode MatGetInfo_MKL_CPARDISO(Mat A, MatInfoType flag, MatInfo *info)
715 {
716   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)A->data;
717 
718   PetscFunctionBegin;
719   info->block_size        = 1.0;
720   info->nz_allocated      = mat_mkl_cpardiso->nz + 0.0;
721   info->nz_unneeded       = 0.0;
722   info->assemblies        = 0.0;
723   info->mallocs           = 0.0;
724   info->memory            = 0.0;
725   info->fill_ratio_given  = 0;
726   info->fill_ratio_needed = 0;
727   info->factor_mallocs    = 0;
728   PetscFunctionReturn(PETSC_SUCCESS);
729 }
730 
731 PetscErrorCode MatMkl_CPardisoSetCntl_MKL_CPARDISO(Mat F, PetscInt icntl, PetscInt ival)
732 {
733   Mat_MKL_CPARDISO *mat_mkl_cpardiso = (Mat_MKL_CPARDISO *)F->data;
734 
735   PetscFunctionBegin;
736   if (icntl <= 64) {
737     mat_mkl_cpardiso->iparm[icntl - 1] = ival;
738   } else {
739     if (icntl == 65) mkl_set_num_threads((int)ival);
740     else if (icntl == 66) mat_mkl_cpardiso->maxfct = ival;
741     else if (icntl == 67) mat_mkl_cpardiso->mnum = ival;
742     else if (icntl == 68) mat_mkl_cpardiso->msglvl = ival;
743     else if (icntl == 69) mat_mkl_cpardiso->mtype = ival;
744   }
745   PetscFunctionReturn(PETSC_SUCCESS);
746 }
747 
748 /*@
749   MatMkl_CPardisoSetCntl - Set Mkl_Pardiso parameters
750 
751    Logically Collective
752 
753    Input Parameters:
754 +  F - the factored matrix obtained by calling `MatGetFactor()`
755 .  icntl - index of Mkl_Pardiso parameter
756 -  ival - value of Mkl_Pardiso parameter
757 
758   Options Database Key:
759 .   -mat_mkl_cpardiso_<icntl> <ival> - set the option numbered icntl to ival
760 
761    Level: Intermediate
762 
763    Note:
764     This routine cannot be used if you are solving the linear system with `TS`, `SNES`, or `KSP`, only if you directly call `MatGetFactor()` so use the options
765           database approach when working with `TS`, `SNES`, or `KSP`. See `MATSOLVERMKL_CPARDISO` for the options
766 
767    References:
768 .  * - Mkl_Pardiso Users' Guide
769 
770 .seealso: [](ch_matrices), `Mat`, `MatGetFactor()`, `MATMPIAIJ`, `MATSOLVERMKL_CPARDISO`
771 @*/
772 PetscErrorCode MatMkl_CPardisoSetCntl(Mat F, PetscInt icntl, PetscInt ival)
773 {
774   PetscFunctionBegin;
775   PetscTryMethod(F, "MatMkl_CPardisoSetCntl_C", (Mat, PetscInt, PetscInt), (F, icntl, ival));
776   PetscFunctionReturn(PETSC_SUCCESS);
777 }
778 
779 /*MC
780   MATSOLVERMKL_CPARDISO -  A matrix type providing direct solvers (LU) for parallel matrices via the external package MKL_CPARDISO.
781 
782   Works with `MATMPIAIJ` matrices
783 
784   Use `-pc_type lu` `-pc_factor_mat_solver_type mkl_cpardiso` to use this direct solver
785 
786   Options Database Keys:
787 + -mat_mkl_cpardiso_65 - Suggested number of threads to use within MKL_CPARDISO
788 . -mat_mkl_cpardiso_66 - Maximum number of factors with identical sparsity structure that must be kept in memory at the same time
789 . -mat_mkl_cpardiso_67 - Indicates the actual matrix for the solution phase
790 . -mat_mkl_cpardiso_68 - Message level information, use 1 to get detailed information on the solver options
791 . -mat_mkl_cpardiso_69 - Defines the matrix type. IMPORTANT: When you set this flag, iparm parameters are going to be set to the default ones for the matrix type
792 . -mat_mkl_cpardiso_1  - Use default values
793 . -mat_mkl_cpardiso_2  - Fill-in reducing ordering for the input matrix
794 . -mat_mkl_cpardiso_4  - Preconditioned CGS/CG
795 . -mat_mkl_cpardiso_5  - User permutation
796 . -mat_mkl_cpardiso_6  - Write solution on x
797 . -mat_mkl_cpardiso_8  - Iterative refinement step
798 . -mat_mkl_cpardiso_10 - Pivoting perturbation
799 . -mat_mkl_cpardiso_11 - Scaling vectors
800 . -mat_mkl_cpardiso_12 - Solve with transposed or conjugate transposed matrix A
801 . -mat_mkl_cpardiso_13 - Improved accuracy using (non-) symmetric weighted matching
802 . -mat_mkl_cpardiso_18 - Numbers of non-zero elements
803 . -mat_mkl_cpardiso_19 - Report number of floating point operations
804 . -mat_mkl_cpardiso_21 - Pivoting for symmetric indefinite matrices
805 . -mat_mkl_cpardiso_24 - Parallel factorization control
806 . -mat_mkl_cpardiso_25 - Parallel forward/backward solve control
807 . -mat_mkl_cpardiso_27 - Matrix checker
808 . -mat_mkl_cpardiso_31 - Partial solve and computing selected components of the solution vectors
809 . -mat_mkl_cpardiso_34 - Optimal number of threads for conditional numerical reproducibility (CNR) mode
810 - -mat_mkl_cpardiso_60 - Intel MKL_CPARDISO mode
811 
812   Level: beginner
813 
814   Notes:
815     Use `-mat_mkl_cpardiso_68 1` to display the number of threads the solver is using. MKL does not provide a way to directly access this
816     information.
817 
818     For more information on the options check the MKL_CPARDISO manual
819 
820 .seealso: [](ch_matrices), `Mat`, `PCFactorSetMatSolverType()`, `MatSolverType`, `MatMkl_CPardisoSetCntl()`, `MatGetFactor()`
821 M*/
822 
823 static PetscErrorCode MatFactorGetSolverType_mkl_cpardiso(Mat A, MatSolverType *type)
824 {
825   PetscFunctionBegin;
826   *type = MATSOLVERMKL_CPARDISO;
827   PetscFunctionReturn(PETSC_SUCCESS);
828 }
829 
830 /* MatGetFactor for MPI AIJ matrices */
831 static PetscErrorCode MatGetFactor_mpiaij_mkl_cpardiso(Mat A, MatFactorType ftype, Mat *F)
832 {
833   Mat               B;
834   Mat_MKL_CPARDISO *mat_mkl_cpardiso;
835   PetscBool         isSeqAIJ, isMPIBAIJ, isMPISBAIJ;
836 
837   PetscFunctionBegin;
838   /* Create the factorization matrix */
839 
840   PetscCall(PetscObjectTypeCompare((PetscObject)A, MATSEQAIJ, &isSeqAIJ));
841   PetscCall(PetscObjectTypeCompare((PetscObject)A, MATMPIBAIJ, &isMPIBAIJ));
842   PetscCall(PetscObjectTypeCompare((PetscObject)A, MATMPISBAIJ, &isMPISBAIJ));
843   PetscCall(MatCreate(PetscObjectComm((PetscObject)A), &B));
844   PetscCall(MatSetSizes(B, A->rmap->n, A->cmap->n, A->rmap->N, A->cmap->N));
845   PetscCall(PetscStrallocpy("mkl_cpardiso", &((PetscObject)B)->type_name));
846   PetscCall(MatSetUp(B));
847 
848   PetscCall(PetscNew(&mat_mkl_cpardiso));
849 
850   if (isSeqAIJ) mat_mkl_cpardiso->ConvertToTriples = MatCopy_seqaij_seqaij_MKL_CPARDISO;
851   else if (isMPIBAIJ) mat_mkl_cpardiso->ConvertToTriples = MatConvertToTriples_mpibaij_mpibaij_MKL_CPARDISO;
852   else if (isMPISBAIJ) mat_mkl_cpardiso->ConvertToTriples = MatConvertToTriples_mpisbaij_mpisbaij_MKL_CPARDISO;
853   else mat_mkl_cpardiso->ConvertToTriples = MatConvertToTriples_mpiaij_mpiaij_MKL_CPARDISO;
854 
855   if (ftype == MAT_FACTOR_LU) B->ops->lufactorsymbolic = MatLUFactorSymbolic_AIJMKL_CPARDISO;
856   else B->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_AIJMKL_CPARDISO;
857   B->ops->destroy = MatDestroy_MKL_CPARDISO;
858 
859   B->ops->view    = MatView_MKL_CPARDISO;
860   B->ops->getinfo = MatGetInfo_MKL_CPARDISO;
861 
862   B->factortype = ftype;
863   B->assembled  = PETSC_TRUE; /* required by -ksp_view */
864 
865   B->data = mat_mkl_cpardiso;
866 
867   /* set solvertype */
868   PetscCall(PetscFree(B->solvertype));
869   PetscCall(PetscStrallocpy(MATSOLVERMKL_CPARDISO, &B->solvertype));
870 
871   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatFactorGetSolverType_C", MatFactorGetSolverType_mkl_cpardiso));
872   PetscCall(PetscObjectComposeFunction((PetscObject)B, "MatMkl_CPardisoSetCntl_C", MatMkl_CPardisoSetCntl_MKL_CPARDISO));
873   PetscCall(PetscInitialize_MKL_CPARDISO(A, mat_mkl_cpardiso));
874 
875   *F = B;
876   PetscFunctionReturn(PETSC_SUCCESS);
877 }
878 
879 PETSC_EXTERN PetscErrorCode MatSolverTypeRegister_MKL_CPardiso(void)
880 {
881   PetscFunctionBegin;
882   PetscCall(MatSolverTypeRegister(MATSOLVERMKL_CPARDISO, MATMPIAIJ, MAT_FACTOR_LU, MatGetFactor_mpiaij_mkl_cpardiso));
883   PetscCall(MatSolverTypeRegister(MATSOLVERMKL_CPARDISO, MATSEQAIJ, MAT_FACTOR_LU, MatGetFactor_mpiaij_mkl_cpardiso));
884   PetscCall(MatSolverTypeRegister(MATSOLVERMKL_CPARDISO, MATMPIBAIJ, MAT_FACTOR_LU, MatGetFactor_mpiaij_mkl_cpardiso));
885   PetscCall(MatSolverTypeRegister(MATSOLVERMKL_CPARDISO, MATMPISBAIJ, MAT_FACTOR_CHOLESKY, MatGetFactor_mpiaij_mkl_cpardiso));
886   PetscFunctionReturn(PETSC_SUCCESS);
887 }
888