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