xref: /petsc/src/ksp/pc/impls/hpddm/pchpddm.cxx (revision e7dfef6fe55161823ad808feb7b24ef448a5fa5f)
1 #include <petscsf.h>
2 #include <petsc/private/vecimpl.h>
3 #include <petsc/private/matimpl.h>
4 #include <petsc/private/petschpddm.h> /*I "petscpc.h" I*/
5 #include <petsc/private/pcimpl.h>
6 #include <petsc/private/dmimpl.h> /* this must be included after petschpddm.h so that DM_MAX_WORK_VECTORS is not defined  */
7                                   /* otherwise, it is assumed that one is compiling libhpddm_petsc => circular dependency */
8 
9 static PetscErrorCode (*loadedSym)(HPDDM::Schwarz<PetscScalar> *const, IS, Mat, Mat, Mat, std::vector<Vec>, PC_HPDDM_Level **const) = nullptr;
10 
11 static PetscBool PCHPDDMPackageInitialized = PETSC_FALSE;
12 
13 PetscLogEvent PC_HPDDM_Strc;
14 PetscLogEvent PC_HPDDM_PtAP;
15 PetscLogEvent PC_HPDDM_PtBP;
16 PetscLogEvent PC_HPDDM_Next;
17 PetscLogEvent PC_HPDDM_SetUp[PETSC_PCHPDDM_MAXLEVELS];
18 PetscLogEvent PC_HPDDM_Solve[PETSC_PCHPDDM_MAXLEVELS];
19 
20 const char *const PCHPDDMCoarseCorrectionTypes[] = {"DEFLATED", "ADDITIVE", "BALANCED", "NONE", "PCHPDDMCoarseCorrectionType", "PC_HPDDM_COARSE_CORRECTION_", nullptr};
21 const char *const PCHPDDMSchurPreTypes[]         = {"LEAST_SQUARES", "GENEO", "PCHPDDMSchurPreType", "PC_HPDDM_SCHUR_PRE", nullptr};
22 
23 static PetscErrorCode PCReset_HPDDM(PC pc)
24 {
25   PC_HPDDM *data = (PC_HPDDM *)pc->data;
26 
27   PetscFunctionBegin;
28   if (data->levels) {
29     for (PetscInt i = 0; i < PETSC_PCHPDDM_MAXLEVELS && data->levels[i]; ++i) {
30       PetscCall(KSPDestroy(&data->levels[i]->ksp));
31       PetscCall(PCDestroy(&data->levels[i]->pc));
32       PetscCall(PetscFree(data->levels[i]));
33     }
34     PetscCall(PetscFree(data->levels));
35   }
36   PetscCall(ISDestroy(&data->is));
37   PetscCall(MatDestroy(&data->aux));
38   PetscCall(MatDestroy(&data->B));
39   PetscCall(VecDestroy(&data->normal));
40   data->correction = PC_HPDDM_COARSE_CORRECTION_DEFLATED;
41   data->Neumann    = PETSC_BOOL3_UNKNOWN;
42   data->deflation  = PETSC_FALSE;
43   data->setup      = nullptr;
44   data->setup_ctx  = nullptr;
45   PetscFunctionReturn(PETSC_SUCCESS);
46 }
47 
48 static PetscErrorCode PCDestroy_HPDDM(PC pc)
49 {
50   PC_HPDDM *data = (PC_HPDDM *)pc->data;
51 
52   PetscFunctionBegin;
53   PetscCall(PCReset_HPDDM(pc));
54   PetscCall(PetscFree(data));
55   PetscCall(PetscObjectChangeTypeName((PetscObject)pc, nullptr));
56   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetAuxiliaryMat_C", nullptr));
57   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMHasNeumannMat_C", nullptr));
58   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetRHSMat_C", nullptr));
59   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetCoarseCorrectionType_C", nullptr));
60   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMGetCoarseCorrectionType_C", nullptr));
61   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetSTShareSubKSP_C", nullptr));
62   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMGetSTShareSubKSP_C", nullptr));
63   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetDeflationMat_C", nullptr));
64   PetscCall(PetscObjectCompose((PetscObject)pc, "_PCHPDDM_Schur", nullptr));
65   PetscFunctionReturn(PETSC_SUCCESS);
66 }
67 
68 static inline PetscErrorCode PCHPDDMSetAuxiliaryMat_Private(PC pc, IS is, Mat A, PetscBool deflation)
69 {
70   PC_HPDDM                   *data = (PC_HPDDM *)pc->data;
71   PCHPDDMCoarseCorrectionType type = data->correction;
72 
73   PetscFunctionBegin;
74   if (is) {
75     PetscCall(PetscObjectReference((PetscObject)is));
76     if (data->is) { /* new overlap definition resets the PC */
77       PetscCall(PCReset_HPDDM(pc));
78       pc->setfromoptionscalled = 0;
79       pc->setupcalled          = 0;
80       data->correction         = type;
81     }
82     PetscCall(ISDestroy(&data->is));
83     data->is = is;
84   }
85   if (A) {
86     PetscCall(PetscObjectReference((PetscObject)A));
87     PetscCall(MatDestroy(&data->aux));
88     data->aux = A;
89   }
90   data->deflation = deflation;
91   PetscFunctionReturn(PETSC_SUCCESS);
92 }
93 
94 static inline PetscErrorCode PCHPDDMSetAuxiliaryMatNormal_Private(PC pc, Mat A, Mat N, Mat *B, const char *pcpre, Vec *diagonal = nullptr)
95 {
96   PC_HPDDM *data = (PC_HPDDM *)pc->data;
97   Mat      *splitting, *sub, aux;
98   Vec       d;
99   IS        is, cols[2], rows;
100   PetscReal norm;
101   PetscBool flg;
102   char      type[256] = {}; /* same size as in src/ksp/pc/interface/pcset.c */
103 
104   PetscFunctionBegin;
105   PetscCall(MatConvert(N, MATAIJ, MAT_INITIAL_MATRIX, B));
106   PetscCall(ISCreateStride(PETSC_COMM_SELF, A->cmap->n, A->cmap->rstart, 1, cols));
107   PetscCall(ISCreateStride(PETSC_COMM_SELF, A->rmap->N, 0, 1, &rows));
108   PetscCall(MatSetOption(A, MAT_SUBMAT_SINGLEIS, PETSC_TRUE));
109   PetscCall(MatIncreaseOverlap(*B, 1, cols, 1));
110   PetscCall(MatCreateSubMatrices(A, 1, &rows, cols, MAT_INITIAL_MATRIX, &splitting));
111   PetscCall(ISCreateStride(PETSC_COMM_SELF, A->cmap->n, A->cmap->rstart, 1, &is));
112   PetscCall(ISEmbed(*cols, is, PETSC_TRUE, cols + 1));
113   PetscCall(ISDestroy(&is));
114   PetscCall(MatCreateSubMatrices(*splitting, 1, &rows, cols + 1, MAT_INITIAL_MATRIX, &sub));
115   PetscCall(ISDestroy(cols + 1));
116   PetscCall(MatFindZeroRows(*sub, &is));
117   PetscCall(MatDestroySubMatrices(1, &sub));
118   PetscCall(ISDestroy(&rows));
119   PetscCall(MatSetOption(*splitting, MAT_KEEP_NONZERO_PATTERN, PETSC_TRUE));
120   PetscCall(MatZeroRowsIS(*splitting, is, 0.0, nullptr, nullptr));
121   PetscCall(ISDestroy(&is));
122   PetscCall(PetscOptionsGetString(nullptr, pcpre, "-pc_hpddm_levels_1_sub_pc_type", type, sizeof(type), nullptr));
123   PetscCall(PetscStrcmp(type, PCQR, &flg));
124   if (!flg) {
125     Mat conjugate = *splitting;
126 
127     if (PetscDefined(USE_COMPLEX)) {
128       PetscCall(MatDuplicate(*splitting, MAT_COPY_VALUES, &conjugate));
129       PetscCall(MatConjugate(conjugate));
130     }
131     PetscCall(MatTransposeMatMult(conjugate, *splitting, MAT_INITIAL_MATRIX, PETSC_DETERMINE, &aux));
132     if (PetscDefined(USE_COMPLEX)) PetscCall(MatDestroy(&conjugate));
133     PetscCall(MatNorm(aux, NORM_FROBENIUS, &norm));
134     PetscCall(MatSetOption(aux, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE));
135     if (diagonal) {
136       PetscReal norm;
137 
138       PetscCall(VecNorm(*diagonal, NORM_INFINITY, &norm));
139       if (norm > PETSC_SMALL) {
140         PetscSF  scatter;
141         PetscInt n;
142 
143         PetscCall(ISGetLocalSize(*cols, &n));
144         PetscCall(VecCreateMPI(PetscObjectComm((PetscObject)pc), n, PETSC_DECIDE, &d));
145         PetscCall(VecScatterCreate(*diagonal, *cols, d, nullptr, &scatter));
146         PetscCall(VecScatterBegin(scatter, *diagonal, d, INSERT_VALUES, SCATTER_FORWARD));
147         PetscCall(VecScatterEnd(scatter, *diagonal, d, INSERT_VALUES, SCATTER_FORWARD));
148         PetscCall(PetscSFDestroy(&scatter));
149         PetscCall(MatScale(aux, -1.0));
150         PetscCall(MatDiagonalSet(aux, d, ADD_VALUES));
151         PetscCall(VecDestroy(&d));
152       } else PetscCall(VecDestroy(diagonal));
153     }
154     if (!diagonal) PetscCall(MatShift(aux, PETSC_SMALL * norm));
155   } else {
156     PetscBool flg;
157 
158     if (diagonal) {
159       PetscCall(VecNorm(*diagonal, NORM_INFINITY, &norm));
160       PetscCheck(norm < PETSC_SMALL, PetscObjectComm((PetscObject)pc), PETSC_ERR_SUP, "Nonzero diagonal A11 block");
161       PetscCall(VecDestroy(diagonal));
162     }
163     PetscCall(PetscObjectTypeCompare((PetscObject)N, MATNORMAL, &flg));
164     if (flg) PetscCall(MatCreateNormal(*splitting, &aux));
165     else PetscCall(MatCreateNormalHermitian(*splitting, &aux));
166   }
167   PetscCall(MatDestroySubMatrices(1, &splitting));
168   PetscCall(PCHPDDMSetAuxiliaryMat(pc, *cols, aux, nullptr, nullptr));
169   data->Neumann = PETSC_BOOL3_TRUE;
170   PetscCall(ISDestroy(cols));
171   PetscCall(MatDestroy(&aux));
172   PetscFunctionReturn(PETSC_SUCCESS);
173 }
174 
175 static PetscErrorCode PCHPDDMSetAuxiliaryMat_HPDDM(PC pc, IS is, Mat A, PetscErrorCode (*setup)(Mat, PetscReal, Vec, Vec, PetscReal, IS, void *), void *setup_ctx)
176 {
177   PC_HPDDM *data = (PC_HPDDM *)pc->data;
178 
179   PetscFunctionBegin;
180   PetscCall(PCHPDDMSetAuxiliaryMat_Private(pc, is, A, PETSC_FALSE));
181   if (setup) {
182     data->setup     = setup;
183     data->setup_ctx = setup_ctx;
184   }
185   PetscFunctionReturn(PETSC_SUCCESS);
186 }
187 
188 typedef struct {
189   KSP      ksp;
190   PetscInt its;
191 } PC_KSP;
192 
193 static inline PetscErrorCode PCSetUp_KSP_Private(PC pc)
194 {
195   PC_KSP           *data   = (PC_KSP *)pc->data;
196   const std::string prefix = ((PetscObject)data->ksp)->prefix;
197   std::string       sub;
198 
199   PetscFunctionBegin;
200   PetscCheck(prefix.size() >= 9, PETSC_COMM_SELF, PETSC_ERR_PLIB, "The prefix of this PCKSP should be of length at least 9 to hold the suffix pc_hpddm_");
201   sub = prefix.substr(0, prefix.size() - 9);
202   PetscCall(PCSetType(pc, PCHPDDM));
203   PetscCall(PCSetOptionsPrefix(pc, sub.c_str()));
204   PetscFunctionReturn(PETSC_SUCCESS);
205 }
206 
207 static PetscErrorCode PCSetUp_KSP(PC pc)
208 {
209   PetscFunctionBegin;
210   PetscCall(PCSetUp_KSP_Private(pc));
211   PetscCall(PCSetFromOptions(pc));
212   PetscCall(PCSetUp(pc));
213   PetscFunctionReturn(PETSC_SUCCESS);
214 }
215 
216 /*@C
217   PCHPDDMSetAuxiliaryMat - Sets the auxiliary matrix used by `PCHPDDM` for the concurrent GenEO problems at the finest level.
218 
219   Input Parameters:
220 + pc    - preconditioner context
221 . is    - index set of the local auxiliary, e.g., Neumann, matrix
222 . A     - auxiliary sequential matrix
223 . setup - function for generating the auxiliary matrix entries, may be `NULL`
224 - ctx   - context for `setup`, may be `NULL`
225 
226   Calling sequence of `setup`:
227 + J   - matrix whose values are to be set
228 . t   - time
229 . X   - linearization point
230 . X_t - time-derivative of the linearization point
231 . s   - step
232 . ovl - index set of the local auxiliary, e.g., Neumann, matrix
233 - ctx - context for `setup`, may be `NULL`
234 
235   Level: intermediate
236 
237   Note:
238   As an example, in a finite element context with nonoverlapping subdomains plus (overlapping) ghost elements, this could be the unassembled (Neumann)
239   local overlapping operator. As opposed to the assembled (Dirichlet) local overlapping operator obtained by summing neighborhood contributions
240   at the interface of ghost elements.
241 
242   Fortran Notes:
243   Only `PETSC_NULL_FUNCTION` is supported for `setup` and `ctx` is never accessed
244 
245 .seealso: [](ch_ksp), `PCHPDDM`, `PCCreate()`, `PCSetType()`, `PCType`, `PC`, `PCHPDDMSetRHSMat()`, `MATIS`
246 @*/
247 PetscErrorCode PCHPDDMSetAuxiliaryMat(PC pc, IS is, Mat A, PetscErrorCode (*setup)(Mat J, PetscReal t, Vec X, Vec X_t, PetscReal s, IS ovl, void *ctx), void *ctx)
248 {
249   PetscFunctionBegin;
250   PetscValidHeaderSpecific(pc, PC_CLASSID, 1);
251   if (is) PetscValidHeaderSpecific(is, IS_CLASSID, 2);
252   if (A) PetscValidHeaderSpecific(A, MAT_CLASSID, 3);
253   if (pc->ops->setup == PCSetUp_KSP) PetscCall(PCSetUp_KSP_Private(pc));
254   PetscTryMethod(pc, "PCHPDDMSetAuxiliaryMat_C", (PC, IS, Mat, PetscErrorCode (*)(Mat, PetscReal, Vec, Vec, PetscReal, IS, void *), void *), (pc, is, A, setup, ctx));
255   PetscFunctionReturn(PETSC_SUCCESS);
256 }
257 
258 static PetscErrorCode PCHPDDMHasNeumannMat_HPDDM(PC pc, PetscBool has)
259 {
260   PC_HPDDM *data = (PC_HPDDM *)pc->data;
261 
262   PetscFunctionBegin;
263   data->Neumann = PetscBoolToBool3(has);
264   PetscFunctionReturn(PETSC_SUCCESS);
265 }
266 
267 /*@
268   PCHPDDMHasNeumannMat - Informs `PCHPDDM` that the `Mat` passed to `PCHPDDMSetAuxiliaryMat()` is the local Neumann matrix.
269 
270   Input Parameters:
271 + pc  - preconditioner context
272 - has - Boolean value
273 
274   Level: intermediate
275 
276   Notes:
277   This may be used to bypass a call to `MatCreateSubMatrices()` and to `MatConvert()` for `MATSBAIJ` matrices.
278 
279   If a function is composed with DMCreateNeumannOverlap_C implementation is available in the `DM` attached to the Pmat, or the Amat, or the `PC`, the flag is internally set to `PETSC_TRUE`. Its default value is otherwise `PETSC_FALSE`.
280 
281 .seealso: [](ch_ksp), `PCHPDDM`, `PCHPDDMSetAuxiliaryMat()`
282 @*/
283 PetscErrorCode PCHPDDMHasNeumannMat(PC pc, PetscBool has)
284 {
285   PetscFunctionBegin;
286   PetscValidHeaderSpecific(pc, PC_CLASSID, 1);
287   PetscTryMethod(pc, "PCHPDDMHasNeumannMat_C", (PC, PetscBool), (pc, has));
288   PetscFunctionReturn(PETSC_SUCCESS);
289 }
290 
291 static PetscErrorCode PCHPDDMSetRHSMat_HPDDM(PC pc, Mat B)
292 {
293   PC_HPDDM *data = (PC_HPDDM *)pc->data;
294 
295   PetscFunctionBegin;
296   PetscCall(PetscObjectReference((PetscObject)B));
297   PetscCall(MatDestroy(&data->B));
298   data->B = B;
299   PetscFunctionReturn(PETSC_SUCCESS);
300 }
301 
302 /*@
303   PCHPDDMSetRHSMat - Sets the right-hand side matrix used by `PCHPDDM` for the concurrent GenEO problems at the finest level.
304 
305   Input Parameters:
306 + pc - preconditioner context
307 - B  - right-hand side sequential matrix
308 
309   Level: advanced
310 
311   Note:
312   Must be used in conjunction with `PCHPDDMSetAuxiliaryMat`(N), so that Nv = lambda Bv is solved using `EPSSetOperators`(N, B).
313   It is assumed that N and `B` are provided using the same numbering. This provides a means to try more advanced methods such as GenEO-II or H-GenEO.
314 
315 .seealso: [](ch_ksp), `PCHPDDMSetAuxiliaryMat()`, `PCHPDDM`
316 @*/
317 PetscErrorCode PCHPDDMSetRHSMat(PC pc, Mat B)
318 {
319   PetscFunctionBegin;
320   PetscValidHeaderSpecific(pc, PC_CLASSID, 1);
321   if (B) {
322     PetscValidHeaderSpecific(B, MAT_CLASSID, 2);
323     PetscTryMethod(pc, "PCHPDDMSetRHSMat_C", (PC, Mat), (pc, B));
324   }
325   PetscFunctionReturn(PETSC_SUCCESS);
326 }
327 
328 static PetscErrorCode PCSetFromOptions_HPDDM(PC pc, PetscOptionItems *PetscOptionsObject)
329 {
330   PC_HPDDM                   *data   = (PC_HPDDM *)pc->data;
331   PC_HPDDM_Level            **levels = data->levels;
332   char                        prefix[256];
333   int                         i = 1;
334   PetscMPIInt                 size, previous;
335   PetscInt                    n, overlap = 1;
336   PCHPDDMCoarseCorrectionType type;
337   PetscBool                   flg = PETSC_TRUE, set;
338 
339   PetscFunctionBegin;
340   if (!data->levels) {
341     PetscCall(PetscCalloc1(PETSC_PCHPDDM_MAXLEVELS, &levels));
342     data->levels = levels;
343   }
344   PetscOptionsHeadBegin(PetscOptionsObject, "PCHPDDM options");
345   PetscCall(PetscOptionsBoundedInt("-pc_hpddm_harmonic_overlap", "Overlap prior to computing local harmonic extensions", "PCHPDDM", overlap, &overlap, &set, 1));
346   if (!set) overlap = -1;
347   PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)pc), &size));
348   previous = size;
349   while (i < PETSC_PCHPDDM_MAXLEVELS) {
350     PetscInt p = 1;
351 
352     if (!data->levels[i - 1]) PetscCall(PetscNew(data->levels + i - 1));
353     data->levels[i - 1]->parent = data;
354     /* if the previous level has a single process, it is not possible to coarsen further */
355     if (previous == 1 || !flg) break;
356     data->levels[i - 1]->nu        = 0;
357     data->levels[i - 1]->threshold = -1.0;
358     PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_%d_eps_nev", i));
359     PetscCall(PetscOptionsBoundedInt(prefix, "Local number of deflation vectors computed by SLEPc", "EPSSetDimensions", data->levels[i - 1]->nu, &data->levels[i - 1]->nu, nullptr, 0));
360     PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_%d_eps_threshold", i));
361     PetscCall(PetscOptionsReal(prefix, "Local threshold for selecting deflation vectors returned by SLEPc", "PCHPDDM", data->levels[i - 1]->threshold, &data->levels[i - 1]->threshold, nullptr));
362     if (i == 1) {
363       PetscCheck(overlap == -1 || PetscAbsReal(data->levels[i - 1]->threshold + static_cast<PetscReal>(1.0)) < PETSC_MACHINE_EPSILON, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cannot supply both -pc_hpddm_levels_1_eps_threshold and -pc_hpddm_harmonic_overlap");
364       if (overlap != -1) {
365         PetscInt nsv = 0;
366 
367         PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_%d_svd_nsv", i));
368         PetscCall(PetscOptionsBoundedInt(prefix, "Local number of deflation vectors computed by SLEPc", "SVDSetDimensions", nsv, &nsv, nullptr, 0));
369         PetscCheck(bool(data->levels[0]->nu) != bool(nsv), PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Cannot supply %s -pc_hpddm_levels_1_eps_nev %s -pc_hpddm_levels_1_svd_nsv", nsv ? "both" : "neither", nsv ? "and" : "nor");
370         if (nsv) {
371           data->levels[0]->nu = nsv;
372           PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_%d_svd_relative_threshold", i));
373         } else PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_%d_eps_relative_threshold", i));
374         PetscCall(PetscOptionsReal(prefix, "Local relative threshold for selecting deflation vectors returned by SLEPc", "PCHPDDM", data->levels[0]->threshold, &data->levels[0]->threshold, nullptr));
375       }
376       PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_1_st_share_sub_ksp"));
377       PetscCall(PetscOptionsBool(prefix, "Shared KSP between SLEPc ST and the fine-level subdomain solver", "PCHPDDMSetSTShareSubKSP", PETSC_FALSE, &data->share, nullptr));
378     }
379     /* if there is no prescribed coarsening, just break out of the loop */
380     if (data->levels[i - 1]->threshold <= PetscReal() && data->levels[i - 1]->nu <= 0 && !(data->deflation && i == 1)) break;
381     else {
382       ++i;
383       PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_%d_eps_nev", i));
384       PetscCall(PetscOptionsHasName(PetscOptionsObject->options, PetscOptionsObject->prefix, prefix, &flg));
385       if (!flg) {
386         PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_%d_eps_threshold", i));
387         PetscCall(PetscOptionsHasName(PetscOptionsObject->options, PetscOptionsObject->prefix, prefix, &flg));
388       }
389       if (flg) {
390         /* if there are coarsening options for the next level, then register it  */
391         /* otherwise, don't to avoid having both options levels_N_p and coarse_p */
392         PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_levels_%d_p", i));
393         PetscCall(PetscOptionsRangeInt(prefix, "Number of processes used to assemble the coarse operator at this level", "PCHPDDM", p, &p, &flg, 1, PetscMax(1, previous / 2)));
394         previous = p;
395       }
396     }
397   }
398   data->N = i;
399   n       = 1;
400   if (i > 1) {
401     PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_coarse_p"));
402     PetscCall(PetscOptionsRangeInt(prefix, "Number of processes used to assemble the coarsest operator", "PCHPDDM", n, &n, nullptr, 1, PetscMax(1, previous / 2)));
403 #if PetscDefined(HAVE_MUMPS)
404     PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "pc_hpddm_coarse_"));
405     PetscCall(PetscOptionsHasName(nullptr, prefix, "-mat_mumps_use_omp_threads", &flg));
406     if (flg) {
407       char type[64]; /* same size as in src/ksp/pc/impls/factor/factimpl.c */
408 
409       PetscCall(PetscStrncpy(type, n > 1 && PetscDefined(HAVE_MUMPS) ? MATSOLVERMUMPS : MATSOLVERPETSC, sizeof(type))); /* default solver for a MatMPIAIJ or a MatSeqAIJ */
410       PetscCall(PetscOptionsGetString(nullptr, prefix, "-pc_factor_mat_solver_type", type, sizeof(type), nullptr));
411       PetscCall(PetscStrcmp(type, MATSOLVERMUMPS, &flg));
412       PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "-%smat_mumps_use_omp_threads and -%spc_factor_mat_solver_type != %s", prefix, prefix, MATSOLVERMUMPS);
413       size = n;
414       n    = -1;
415       PetscCall(PetscOptionsGetInt(nullptr, prefix, "-mat_mumps_use_omp_threads", &n, nullptr));
416       PetscCheck(n >= 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Need to specify a positive integer for -%smat_mumps_use_omp_threads", prefix);
417       PetscCheck(n * size <= previous, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "%d MPI process%s x %d OpenMP thread%s greater than %d available MPI process%s for the coarsest operator", (int)size, size > 1 ? "es" : "", (int)n, n > 1 ? "s" : "", (int)previous, previous > 1 ? "es" : "");
418     }
419 #endif
420     PetscCall(PetscOptionsEnum("-pc_hpddm_coarse_correction", "Type of coarse correction applied each iteration", "PCHPDDMSetCoarseCorrectionType", PCHPDDMCoarseCorrectionTypes, (PetscEnum)data->correction, (PetscEnum *)&type, &flg));
421     if (flg) PetscCall(PCHPDDMSetCoarseCorrectionType(pc, type));
422     PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_has_neumann"));
423     PetscCall(PetscOptionsBool(prefix, "Is the auxiliary Mat the local Neumann matrix?", "PCHPDDMHasNeumannMat", PetscBool3ToBool(data->Neumann), &flg, &set));
424     if (set) data->Neumann = PetscBoolToBool3(flg);
425     data->log_separate = PETSC_FALSE;
426     if (PetscDefined(USE_LOG)) {
427       PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-pc_hpddm_log_separate"));
428       PetscCall(PetscOptionsBool(prefix, "Log events level by level instead of inside PCSetUp()/KSPSolve()", nullptr, data->log_separate, &data->log_separate, nullptr));
429     }
430   }
431   PetscOptionsHeadEnd();
432   while (i < PETSC_PCHPDDM_MAXLEVELS && data->levels[i]) PetscCall(PetscFree(data->levels[i++]));
433   PetscFunctionReturn(PETSC_SUCCESS);
434 }
435 
436 static PetscErrorCode PCApply_HPDDM(PC pc, Vec x, Vec y)
437 {
438   PC_HPDDM *data = (PC_HPDDM *)pc->data;
439 
440   PetscFunctionBegin;
441   PetscCall(PetscCitationsRegister(HPDDMCitation, &HPDDMCite));
442   PetscCheck(data->levels[0]->ksp, PETSC_COMM_SELF, PETSC_ERR_PLIB, "No KSP attached to PCHPDDM");
443   if (data->log_separate) PetscCall(PetscLogEventBegin(PC_HPDDM_Solve[0], data->levels[0]->ksp, nullptr, nullptr, nullptr)); /* coarser-level events are directly triggered in HPDDM */
444   PetscCall(KSPSolve(data->levels[0]->ksp, x, y));
445   if (data->log_separate) PetscCall(PetscLogEventEnd(PC_HPDDM_Solve[0], data->levels[0]->ksp, nullptr, nullptr, nullptr));
446   PetscFunctionReturn(PETSC_SUCCESS);
447 }
448 
449 static PetscErrorCode PCMatApply_HPDDM(PC pc, Mat X, Mat Y)
450 {
451   PC_HPDDM *data = (PC_HPDDM *)pc->data;
452 
453   PetscFunctionBegin;
454   PetscCall(PetscCitationsRegister(HPDDMCitation, &HPDDMCite));
455   PetscCheck(data->levels[0]->ksp, PETSC_COMM_SELF, PETSC_ERR_PLIB, "No KSP attached to PCHPDDM");
456   PetscCall(KSPMatSolve(data->levels[0]->ksp, X, Y));
457   PetscFunctionReturn(PETSC_SUCCESS);
458 }
459 
460 /*@
461   PCHPDDMGetComplexities - Computes the grid and operator complexities.
462 
463   Collective
464 
465   Input Parameter:
466 . pc - preconditioner context
467 
468   Output Parameters:
469 + gc - grid complexity $ \sum_i m_i / m_1 $
470 - oc - operator complexity $ \sum_i nnz_i / nnz_1 $
471 
472   Level: advanced
473 
474 .seealso: [](ch_ksp), `PCMGGetGridComplexity()`, `PCHPDDM`, `PCHYPRE`, `PCGAMG`
475 @*/
476 PetscErrorCode PCHPDDMGetComplexities(PC pc, PetscReal *gc, PetscReal *oc)
477 {
478   PC_HPDDM      *data = (PC_HPDDM *)pc->data;
479   MatInfo        info;
480   PetscLogDouble accumulate[2]{}, nnz1 = 1.0, m1 = 1.0;
481 
482   PetscFunctionBegin;
483   if (gc) {
484     PetscAssertPointer(gc, 2);
485     *gc = 0;
486   }
487   if (oc) {
488     PetscAssertPointer(oc, 3);
489     *oc = 0;
490   }
491   for (PetscInt n = 0; n < data->N; ++n) {
492     if (data->levels[n]->ksp) {
493       Mat       P, A = nullptr;
494       PetscInt  m;
495       PetscBool flg = PETSC_FALSE;
496 
497       PetscCall(KSPGetOperators(data->levels[n]->ksp, nullptr, &P));
498       PetscCall(MatGetSize(P, &m, nullptr));
499       accumulate[0] += m;
500       if (n == 0) {
501         PetscCall(PetscObjectTypeCompareAny((PetscObject)P, &flg, MATNORMAL, MATNORMALHERMITIAN, ""));
502         if (flg) {
503           PetscCall(MatConvert(P, MATAIJ, MAT_INITIAL_MATRIX, &A));
504           P = A;
505         } else {
506           PetscCall(PetscObjectTypeCompare((PetscObject)P, MATSCHURCOMPLEMENT, &flg));
507           PetscCall(PetscObjectReference((PetscObject)P));
508         }
509       }
510       if (!A && flg) accumulate[1] += m * m; /* assumption that a MATSCHURCOMPLEMENT is dense if stored explicitly */
511       else if (P->ops->getinfo) {
512         PetscCall(MatGetInfo(P, MAT_GLOBAL_SUM, &info));
513         accumulate[1] += info.nz_used;
514       }
515       if (n == 0) {
516         m1 = m;
517         if (!A && flg) nnz1 = m * m;
518         else if (P->ops->getinfo) nnz1 = info.nz_used;
519         PetscCall(MatDestroy(&P));
520       }
521     }
522   }
523   /* only process #0 has access to the full hierarchy by construction, so broadcast to ensure consistent outputs */
524   PetscCallMPI(MPI_Bcast(accumulate, 2, MPIU_PETSCLOGDOUBLE, 0, PetscObjectComm((PetscObject)pc)));
525   if (gc) *gc = static_cast<PetscReal>(accumulate[0] / m1);
526   if (oc) *oc = static_cast<PetscReal>(accumulate[1] / nnz1);
527   PetscFunctionReturn(PETSC_SUCCESS);
528 }
529 
530 static PetscErrorCode PCView_HPDDM(PC pc, PetscViewer viewer)
531 {
532   PC_HPDDM         *data = (PC_HPDDM *)pc->data;
533   PetscViewer       subviewer;
534   PetscViewerFormat format;
535   PetscSubcomm      subcomm;
536   PetscReal         oc, gc;
537   PetscInt          tabs;
538   PetscMPIInt       size, color, rank;
539   PetscBool         flg;
540   const char       *name;
541 
542   PetscFunctionBegin;
543   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &flg));
544   if (flg) {
545     PetscCall(PetscViewerASCIIPrintf(viewer, "level%s: %" PetscInt_FMT "\n", data->N > 1 ? "s" : "", data->N));
546     PetscCall(PCHPDDMGetComplexities(pc, &gc, &oc));
547     if (data->N > 1) {
548       if (!data->deflation) {
549         PetscCall(PetscViewerASCIIPrintf(viewer, "Neumann matrix attached? %s\n", PetscBools[PetscBool3ToBool(data->Neumann)]));
550         PetscCall(PetscViewerASCIIPrintf(viewer, "shared subdomain KSP between SLEPc and PETSc? %s\n", PetscBools[data->share]));
551       } else PetscCall(PetscViewerASCIIPrintf(viewer, "user-supplied deflation matrix\n"));
552       PetscCall(PetscViewerASCIIPrintf(viewer, "coarse correction: %s\n", PCHPDDMCoarseCorrectionTypes[data->correction]));
553       PetscCall(PetscViewerASCIIPrintf(viewer, "on process #0, value%s (+ threshold%s if available) for selecting deflation vectors:", data->N > 2 ? "s" : "", data->N > 2 ? "s" : ""));
554       PetscCall(PetscViewerASCIIGetTab(viewer, &tabs));
555       PetscCall(PetscViewerASCIISetTab(viewer, 0));
556       for (PetscInt i = 1; i < data->N; ++i) {
557         PetscCall(PetscViewerASCIIPrintf(viewer, " %" PetscInt_FMT, data->levels[i - 1]->nu));
558         if (data->levels[i - 1]->threshold > static_cast<PetscReal>(-0.1)) PetscCall(PetscViewerASCIIPrintf(viewer, " (%g)", (double)data->levels[i - 1]->threshold));
559       }
560       PetscCall(PetscViewerASCIIPrintf(viewer, "\n"));
561       PetscCall(PetscViewerASCIISetTab(viewer, tabs));
562     }
563     PetscCall(PetscViewerASCIIPrintf(viewer, "grid and operator complexities: %g %g\n", (double)gc, (double)oc));
564     PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)pc), &size));
565     if (data->levels[0]->ksp) {
566       PetscCall(KSPView(data->levels[0]->ksp, viewer));
567       if (data->levels[0]->pc) PetscCall(PCView(data->levels[0]->pc, viewer));
568       PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)pc), &rank));
569       for (PetscInt i = 1; i < data->N; ++i) {
570         if (data->levels[i]->ksp) color = 1;
571         else color = 0;
572         PetscCall(PetscSubcommCreate(PetscObjectComm((PetscObject)pc), &subcomm));
573         PetscCall(PetscSubcommSetNumber(subcomm, PetscMin(size, 2)));
574         PetscCall(PetscSubcommSetTypeGeneral(subcomm, color, rank));
575         PetscCall(PetscViewerASCIIPushTab(viewer));
576         PetscCall(PetscViewerGetSubViewer(viewer, PetscSubcommChild(subcomm), &subviewer));
577         if (color == 1) {
578           PetscCall(KSPView(data->levels[i]->ksp, subviewer));
579           if (data->levels[i]->pc) PetscCall(PCView(data->levels[i]->pc, subviewer));
580           PetscCall(PetscViewerFlush(subviewer));
581         }
582         PetscCall(PetscViewerRestoreSubViewer(viewer, PetscSubcommChild(subcomm), &subviewer));
583         PetscCall(PetscViewerASCIIPopTab(viewer));
584         PetscCall(PetscSubcommDestroy(&subcomm));
585       }
586     }
587     PetscCall(PetscViewerGetFormat(viewer, &format));
588     if (format == PETSC_VIEWER_ASCII_INFO_DETAIL) {
589       PetscCall(PetscViewerFileGetName(viewer, &name));
590       if (name) {
591         Mat             aux[2];
592         IS              is;
593         const PetscInt *indices;
594         PetscInt        m, n, sizes[5] = {pc->mat->rmap->n, pc->mat->cmap->n, pc->mat->rmap->N, pc->mat->cmap->N, 0};
595         char           *tmp;
596         std::string     prefix, suffix;
597         size_t          pos;
598 
599         PetscCall(PetscStrstr(name, ".", &tmp));
600         if (tmp) {
601           pos    = std::distance(const_cast<char *>(name), tmp);
602           prefix = std::string(name, pos);
603           suffix = std::string(name + pos + 1);
604         } else prefix = name;
605         if (data->aux) {
606           PetscCall(MatGetSize(data->aux, &m, &n));
607           PetscCall(MatCreate(PetscObjectComm((PetscObject)pc), aux));
608           PetscCall(MatSetSizes(aux[0], m, n, PETSC_DETERMINE, PETSC_DETERMINE));
609           PetscCall(PetscObjectBaseTypeCompare((PetscObject)data->aux, MATSEQAIJ, &flg));
610           if (flg) PetscCall(MatSetType(aux[0], MATMPIAIJ));
611           else {
612             PetscCall(PetscObjectBaseTypeCompare((PetscObject)data->aux, MATSEQBAIJ, &flg));
613             if (flg) PetscCall(MatSetType(aux[0], MATMPIBAIJ));
614             else {
615               PetscCall(PetscObjectBaseTypeCompare((PetscObject)data->aux, MATSEQSBAIJ, &flg));
616               PetscCheck(flg, PetscObjectComm((PetscObject)pc), PETSC_ERR_SUP, "MatType of auxiliary Mat (%s) is not any of the following: MATSEQAIJ, MATSEQBAIJ, or MATSEQSBAIJ", ((PetscObject)data->aux)->type_name);
617               PetscCall(MatSetType(aux[0], MATMPISBAIJ));
618             }
619           }
620           PetscCall(MatSetBlockSizesFromMats(aux[0], data->aux, data->aux));
621           PetscCall(MatAssemblyBegin(aux[0], MAT_FINAL_ASSEMBLY));
622           PetscCall(MatAssemblyEnd(aux[0], MAT_FINAL_ASSEMBLY));
623           PetscCall(MatGetDiagonalBlock(aux[0], aux + 1));
624           PetscCall(MatCopy(data->aux, aux[1], DIFFERENT_NONZERO_PATTERN));
625           PetscCall(PetscViewerBinaryOpen(PetscObjectComm((PetscObject)pc), std::string(prefix + "_aux_" + std::to_string(size) + (tmp ? ("." + suffix) : "")).c_str(), FILE_MODE_WRITE, &subviewer));
626           PetscCall(MatView(aux[0], subviewer));
627           PetscCall(PetscViewerDestroy(&subviewer));
628           PetscCall(MatDestroy(aux));
629         }
630         if (data->is) {
631           PetscCall(ISGetIndices(data->is, &indices));
632           PetscCall(ISGetSize(data->is, sizes + 4));
633           PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc), sizes[4], indices, PETSC_USE_POINTER, &is));
634           PetscCall(PetscViewerBinaryOpen(PetscObjectComm((PetscObject)pc), std::string(prefix + "_is_" + std::to_string(size) + (tmp ? ("." + suffix) : "")).c_str(), FILE_MODE_WRITE, &subviewer));
635           PetscCall(ISView(is, subviewer));
636           PetscCall(PetscViewerDestroy(&subviewer));
637           PetscCall(ISDestroy(&is));
638           PetscCall(ISRestoreIndices(data->is, &indices));
639         }
640         PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc), PETSC_STATIC_ARRAY_LENGTH(sizes), sizes, PETSC_USE_POINTER, &is));
641         PetscCall(PetscViewerBinaryOpen(PetscObjectComm((PetscObject)pc), std::string(prefix + "_sizes_" + std::to_string(size) + (tmp ? ("." + suffix) : "")).c_str(), FILE_MODE_WRITE, &subviewer));
642         PetscCall(ISView(is, subviewer));
643         PetscCall(PetscViewerDestroy(&subviewer));
644         PetscCall(ISDestroy(&is));
645       }
646     }
647   }
648   PetscFunctionReturn(PETSC_SUCCESS);
649 }
650 
651 static PetscErrorCode PCPreSolve_HPDDM(PC pc, KSP ksp, Vec, Vec)
652 {
653   PC_HPDDM *data = (PC_HPDDM *)pc->data;
654   Mat       A;
655   PetscBool flg;
656 
657   PetscFunctionBegin;
658   if (ksp) {
659     PetscCall(PetscObjectTypeCompare((PetscObject)ksp, KSPLSQR, &flg));
660     if (flg && !data->normal) {
661       PetscCall(KSPGetOperators(ksp, &A, nullptr));
662       PetscCall(MatCreateVecs(A, nullptr, &data->normal)); /* temporary Vec used in PCApply_HPDDMShell() for coarse grid corrections */
663     } else if (!flg) {
664       PetscCall(PetscObjectTypeCompareAny((PetscObject)ksp, &flg, KSPCG, KSPGROPPCG, KSPPIPECG, KSPPIPECGRR, KSPPIPELCG, KSPPIPEPRCG, KSPPIPECG2, KSPSTCG, KSPFCG, KSPPIPEFCG, KSPMINRES, KSPNASH, KSPSYMMLQ, ""));
665       if (!flg) {
666         PetscCall(PetscObjectTypeCompare((PetscObject)ksp, KSPHPDDM, &flg));
667         if (flg) {
668           KSPHPDDMType type;
669 
670           PetscCall(KSPHPDDMGetType(ksp, &type));
671           flg = (type == KSP_HPDDM_TYPE_CG || type == KSP_HPDDM_TYPE_BCG || type == KSP_HPDDM_TYPE_BFBCG ? PETSC_TRUE : PETSC_FALSE);
672         }
673       }
674     }
675     if (flg) {
676       if (data->correction == PC_HPDDM_COARSE_CORRECTION_DEFLATED) {
677         PetscCall(PetscOptionsHasName(((PetscObject)pc)->options, ((PetscObject)pc)->prefix, "-pc_hpddm_coarse_correction", &flg));
678         PetscCheck(flg, PetscObjectComm((PetscObject)pc), PETSC_ERR_ARG_INCOMP, "PCHPDDMCoarseCorrectionType %s is known to be not symmetric, but KSPType %s requires a symmetric PC, if you insist on using this configuration, use the additional option -%spc_hpddm_coarse_correction %s, or alternatively, switch to a symmetric PCHPDDMCoarseCorrectionType such as %s",
679                    PCHPDDMCoarseCorrectionTypes[data->correction], ((PetscObject)ksp)->type_name, ((PetscObject)pc)->prefix ? ((PetscObject)pc)->prefix : "", PCHPDDMCoarseCorrectionTypes[data->correction], PCHPDDMCoarseCorrectionTypes[PC_HPDDM_COARSE_CORRECTION_BALANCED]);
680       }
681       for (PetscInt n = 0; n < data->N; ++n) {
682         if (data->levels[n]->pc) {
683           PetscCall(PetscObjectTypeCompare((PetscObject)data->levels[n]->pc, PCASM, &flg));
684           if (flg) {
685             PCASMType type;
686 
687             PetscCall(PCASMGetType(data->levels[n]->pc, &type));
688             if (type == PC_ASM_RESTRICT || type == PC_ASM_INTERPOLATE) {
689               PetscCall(PetscOptionsHasName(((PetscObject)data->levels[n]->pc)->options, ((PetscObject)data->levels[n]->pc)->prefix, "-pc_asm_type", &flg));
690               PetscCheck(flg, PetscObjectComm((PetscObject)data->levels[n]->pc), PETSC_ERR_ARG_INCOMP, "PCASMType %s is known to be not symmetric, but KSPType %s requires a symmetric PC, if you insist on using this configuration, use the additional option -%spc_asm_type %s, or alternatively, switch to a symmetric PCASMType such as %s", PCASMTypes[type],
691                          ((PetscObject)ksp)->type_name, ((PetscObject)data->levels[n]->pc)->prefix, PCASMTypes[type], PCASMTypes[PC_ASM_BASIC]);
692             }
693           }
694         }
695       }
696     }
697   }
698   PetscFunctionReturn(PETSC_SUCCESS);
699 }
700 
701 static PetscErrorCode PCSetUp_HPDDMShell(PC pc)
702 {
703   PC_HPDDM_Level *ctx;
704   Mat             A, P;
705   Vec             x;
706   const char     *pcpre;
707 
708   PetscFunctionBegin;
709   PetscCall(PCShellGetContext(pc, &ctx));
710   PetscCall(KSPGetOptionsPrefix(ctx->ksp, &pcpre));
711   PetscCall(KSPGetOperators(ctx->ksp, &A, &P));
712   /* smoother */
713   PetscCall(PCSetOptionsPrefix(ctx->pc, pcpre));
714   PetscCall(PCSetOperators(ctx->pc, A, P));
715   if (!ctx->v[0]) {
716     PetscCall(VecDuplicateVecs(ctx->D, 1, &ctx->v[0]));
717     if (!std::is_same<PetscScalar, PetscReal>::value) PetscCall(VecDestroy(&ctx->D));
718     PetscCall(MatCreateVecs(A, &x, nullptr));
719     PetscCall(VecDuplicateVecs(x, 2, &ctx->v[1]));
720     PetscCall(VecDestroy(&x));
721   }
722   std::fill_n(ctx->V, 3, nullptr);
723   PetscFunctionReturn(PETSC_SUCCESS);
724 }
725 
726 template <class Type, typename std::enable_if<std::is_same<Type, Vec>::value>::type * = nullptr>
727 static inline PetscErrorCode PCHPDDMDeflate_Private(PC pc, Type x, Type y)
728 {
729   PC_HPDDM_Level *ctx;
730   PetscScalar    *out;
731 
732   PetscFunctionBegin;
733   PetscCall(PCShellGetContext(pc, &ctx));
734   /* going from PETSc to HPDDM numbering */
735   PetscCall(VecScatterBegin(ctx->scatter, x, ctx->v[0][0], INSERT_VALUES, SCATTER_FORWARD));
736   PetscCall(VecScatterEnd(ctx->scatter, x, ctx->v[0][0], INSERT_VALUES, SCATTER_FORWARD));
737   PetscCall(VecGetArrayWrite(ctx->v[0][0], &out));
738   ctx->P->deflation<false>(nullptr, out, 1); /* y = Q x */
739   PetscCall(VecRestoreArrayWrite(ctx->v[0][0], &out));
740   /* going from HPDDM to PETSc numbering */
741   PetscCall(VecScatterBegin(ctx->scatter, ctx->v[0][0], y, INSERT_VALUES, SCATTER_REVERSE));
742   PetscCall(VecScatterEnd(ctx->scatter, ctx->v[0][0], y, INSERT_VALUES, SCATTER_REVERSE));
743   PetscFunctionReturn(PETSC_SUCCESS);
744 }
745 
746 template <class Type, typename std::enable_if<std::is_same<Type, Mat>::value>::type * = nullptr>
747 static inline PetscErrorCode PCHPDDMDeflate_Private(PC pc, Type X, Type Y)
748 {
749   PC_HPDDM_Level *ctx;
750   Vec             vX, vY, vC;
751   PetscScalar    *out;
752   PetscInt        N;
753 
754   PetscFunctionBegin;
755   PetscCall(PCShellGetContext(pc, &ctx));
756   PetscCall(MatGetSize(X, nullptr, &N));
757   /* going from PETSc to HPDDM numbering */
758   for (PetscInt i = 0; i < N; ++i) {
759     PetscCall(MatDenseGetColumnVecRead(X, i, &vX));
760     PetscCall(MatDenseGetColumnVecWrite(ctx->V[0], i, &vC));
761     PetscCall(VecScatterBegin(ctx->scatter, vX, vC, INSERT_VALUES, SCATTER_FORWARD));
762     PetscCall(VecScatterEnd(ctx->scatter, vX, vC, INSERT_VALUES, SCATTER_FORWARD));
763     PetscCall(MatDenseRestoreColumnVecWrite(ctx->V[0], i, &vC));
764     PetscCall(MatDenseRestoreColumnVecRead(X, i, &vX));
765   }
766   PetscCall(MatDenseGetArrayWrite(ctx->V[0], &out));
767   ctx->P->deflation<false>(nullptr, out, N); /* Y = Q X */
768   PetscCall(MatDenseRestoreArrayWrite(ctx->V[0], &out));
769   /* going from HPDDM to PETSc numbering */
770   for (PetscInt i = 0; i < N; ++i) {
771     PetscCall(MatDenseGetColumnVecRead(ctx->V[0], i, &vC));
772     PetscCall(MatDenseGetColumnVecWrite(Y, i, &vY));
773     PetscCall(VecScatterBegin(ctx->scatter, vC, vY, INSERT_VALUES, SCATTER_REVERSE));
774     PetscCall(VecScatterEnd(ctx->scatter, vC, vY, INSERT_VALUES, SCATTER_REVERSE));
775     PetscCall(MatDenseRestoreColumnVecWrite(Y, i, &vY));
776     PetscCall(MatDenseRestoreColumnVecRead(ctx->V[0], i, &vC));
777   }
778   PetscFunctionReturn(PETSC_SUCCESS);
779 }
780 
781 /*
782      PCApply_HPDDMShell - Applies a (2) deflated, (1) additive, (3) balanced, or (4) no coarse correction. In what follows, E = Z Pmat Z^T and Q = Z^T E^-1 Z.
783 
784 .vb
785    (1) y =                Pmat^-1              x + Q x,
786    (2) y =                Pmat^-1 (I - Amat Q) x + Q x (default),
787    (3) y = (I - Q Amat^T) Pmat^-1 (I - Amat Q) x + Q x,
788    (4) y =                Pmat^-1              x      .
789 .ve
790 
791    Input Parameters:
792 +     pc - preconditioner context
793 -     x - input vector
794 
795    Output Parameter:
796 .     y - output vector
797 
798    Notes:
799      The options of Pmat^1 = pc(Pmat) are prefixed by -pc_hpddm_levels_1_pc_. Z is a tall-and-skiny matrix assembled by HPDDM. The number of processes on which (Z Pmat Z^T) is aggregated is set via -pc_hpddm_coarse_p.
800      The options of (Z Pmat Z^T)^-1 = ksp(Z Pmat Z^T) are prefixed by -pc_hpddm_coarse_ (`KSPPREONLY` and `PCCHOLESKY` by default), unless a multilevel correction is turned on, in which case, this function is called recursively at each level except the coarsest one.
801      (1) and (2) visit the "next" level (in terms of coarsening) once per application, while (3) visits it twice, so it is asymptotically twice costlier. (2) is not symmetric even if both Amat and Pmat are symmetric.
802 
803    Level: advanced
804 
805    Developer Note:
806    Since this is not an actual manual page the material below should be moved to an appropriate manual page with the appropriate context, i.e. explaining when it is used and how
807    to trigger it. Likely the manual page is `PCHPDDM`
808 
809 .seealso: [](ch_ksp), `PCHPDDM`, `PCHPDDMCoarseCorrectionType`
810 */
811 static PetscErrorCode PCApply_HPDDMShell(PC pc, Vec x, Vec y)
812 {
813   PC_HPDDM_Level *ctx;
814   Mat             A;
815 
816   PetscFunctionBegin;
817   PetscCall(PCShellGetContext(pc, &ctx));
818   PetscCheck(ctx->P, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCSHELL from PCHPDDM called with no HPDDM object");
819   PetscCall(KSPGetOperators(ctx->ksp, &A, nullptr));
820   if (ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_NONE) PetscCall(PCApply(ctx->pc, x, y)); /* y = M^-1 x */
821   else {
822     PetscCall(PCHPDDMDeflate_Private(pc, x, y)); /* y = Q x */
823     if (ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_DEFLATED || ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_BALANCED) {
824       if (!ctx->parent->normal || ctx != ctx->parent->levels[0]) PetscCall(MatMult(A, y, ctx->v[1][0])); /* y = A Q x     */
825       else { /* KSPLSQR and finest level */ PetscCall(MatMult(A, y, ctx->parent->normal));               /* y = A Q x     */
826         PetscCall(MatMultHermitianTranspose(A, ctx->parent->normal, ctx->v[1][0]));                      /* y = A^T A Q x */
827       }
828       PetscCall(VecWAXPY(ctx->v[1][1], -1.0, ctx->v[1][0], x)); /* y = (I - A Q) x                             */
829       PetscCall(PCApply(ctx->pc, ctx->v[1][1], ctx->v[1][0]));  /* y = M^-1 (I - A Q) x                        */
830       if (ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_BALANCED) {
831         if (!ctx->parent->normal || ctx != ctx->parent->levels[0]) PetscCall(MatMultHermitianTranspose(A, ctx->v[1][0], ctx->v[1][1])); /* z = A^T y */
832         else {
833           PetscCall(MatMult(A, ctx->v[1][0], ctx->parent->normal));
834           PetscCall(MatMultHermitianTranspose(A, ctx->parent->normal, ctx->v[1][1])); /* z = A^T A y           */
835         }
836         PetscCall(PCHPDDMDeflate_Private(pc, ctx->v[1][1], ctx->v[1][1]));
837         PetscCall(VecAXPBYPCZ(y, -1.0, 1.0, 1.0, ctx->v[1][1], ctx->v[1][0])); /* y = (I - Q A^T) y + Q x      */
838       } else PetscCall(VecAXPY(y, 1.0, ctx->v[1][0]));                         /* y = Q M^-1 (I - A Q) x + Q x */
839     } else {
840       PetscCheck(ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_ADDITIVE, PetscObjectComm((PetscObject)pc), PETSC_ERR_PLIB, "PCSHELL from PCHPDDM called with an unknown PCHPDDMCoarseCorrectionType %d", ctx->parent->correction);
841       PetscCall(PCApply(ctx->pc, x, ctx->v[1][0]));
842       PetscCall(VecAXPY(y, 1.0, ctx->v[1][0])); /* y = M^-1 x + Q x */
843     }
844   }
845   PetscFunctionReturn(PETSC_SUCCESS);
846 }
847 
848 /*
849      PCMatApply_HPDDMShell - Variant of PCApply_HPDDMShell() for blocks of vectors.
850 
851    Input Parameters:
852 +     pc - preconditioner context
853 -     X - block of input vectors
854 
855    Output Parameter:
856 .     Y - block of output vectors
857 
858    Level: advanced
859 
860 .seealso: [](ch_ksp), `PCHPDDM`, `PCApply_HPDDMShell()`, `PCHPDDMCoarseCorrectionType`
861 */
862 static PetscErrorCode PCMatApply_HPDDMShell(PC pc, Mat X, Mat Y)
863 {
864   PC_HPDDM_Level *ctx;
865   Mat             A, *ptr;
866   PetscContainer  container = nullptr;
867   PetscScalar    *array;
868   PetscInt        m, M, N, prev = 0;
869   PetscBool       reset = PETSC_FALSE;
870 
871   PetscFunctionBegin;
872   PetscCall(PCShellGetContext(pc, &ctx));
873   PetscCheck(ctx->P, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCSHELL from PCHPDDM called with no HPDDM object");
874   PetscCall(MatGetSize(X, nullptr, &N));
875   PetscCall(KSPGetOperators(ctx->ksp, &A, nullptr));
876   if (ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_NONE) PetscCall(PCMatApply(ctx->pc, X, Y));
877   else {
878     PetscCall(PetscObjectQuery((PetscObject)A, "_HPDDM_MatProduct", (PetscObject *)&container));
879     if (container) { /* MatProduct container already attached */
880       PetscCall(PetscContainerGetPointer(container, (void **)&ptr));
881       if (ptr[1] != ctx->V[2]) /* Mat has changed or may have been set first in KSPHPDDM */
882         for (m = 0; m < 2; ++m) {
883           PetscCall(MatDestroy(ctx->V + m + 1));
884           ctx->V[m + 1] = ptr[m];
885           PetscCall(PetscObjectReference((PetscObject)ctx->V[m + 1]));
886         }
887     }
888     if (ctx->V[1]) PetscCall(MatGetSize(ctx->V[1], nullptr, &prev));
889     if (N != prev || !ctx->V[0]) {
890       PetscCall(MatDestroy(ctx->V));
891       PetscCall(VecGetLocalSize(ctx->v[0][0], &m));
892       PetscCall(MatCreateDense(PetscObjectComm((PetscObject)pc), m, PETSC_DECIDE, PETSC_DECIDE, N, nullptr, ctx->V));
893       if (N != prev) {
894         PetscCall(MatDestroy(ctx->V + 1));
895         PetscCall(MatDestroy(ctx->V + 2));
896         PetscCall(MatGetLocalSize(X, &m, nullptr));
897         PetscCall(MatGetSize(X, &M, nullptr));
898         if (ctx->parent->correction != PC_HPDDM_COARSE_CORRECTION_BALANCED) PetscCall(MatDenseGetArrayWrite(ctx->V[0], &array));
899         else array = nullptr;
900         PetscCall(MatCreateDense(PetscObjectComm((PetscObject)pc), m, PETSC_DECIDE, M, N, array, ctx->V + 1));
901         if (ctx->parent->correction != PC_HPDDM_COARSE_CORRECTION_BALANCED) PetscCall(MatDenseRestoreArrayWrite(ctx->V[0], &array));
902         PetscCall(MatCreateDense(PetscObjectComm((PetscObject)pc), m, PETSC_DECIDE, M, N, nullptr, ctx->V + 2));
903         PetscCall(MatProductCreateWithMat(A, Y, nullptr, ctx->V[1]));
904         PetscCall(MatProductSetType(ctx->V[1], MATPRODUCT_AB));
905         PetscCall(MatProductSetFromOptions(ctx->V[1]));
906         PetscCall(MatProductSymbolic(ctx->V[1]));
907         if (!container) PetscCall(PetscObjectContainerCompose((PetscObject)A, "_HPDDM_MatProduct", ctx->V + 1, nullptr)); /* no MatProduct container attached, create one to be queried in KSPHPDDM or at the next call to PCMatApply() */
908         else PetscCall(PetscContainerSetPointer(container, ctx->V + 1));                                                  /* need to compose B and D from MatProductCreateWithMat(A, B, NULL, D), which are stored in the contiguous array ctx->V */
909       }
910       if (ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_BALANCED) {
911         PetscCall(MatProductCreateWithMat(A, ctx->V[1], nullptr, ctx->V[2]));
912         PetscCall(MatProductSetType(ctx->V[2], MATPRODUCT_AtB));
913         PetscCall(MatProductSetFromOptions(ctx->V[2]));
914         PetscCall(MatProductSymbolic(ctx->V[2]));
915       }
916       ctx->P->start(N);
917     }
918     if (N == prev || container) { /* when MatProduct container is attached, always need to MatProductReplaceMats() since KSPHPDDM may have replaced the Mat as well */
919       PetscCall(MatProductReplaceMats(nullptr, Y, nullptr, ctx->V[1]));
920       if (container && ctx->parent->correction != PC_HPDDM_COARSE_CORRECTION_BALANCED) {
921         PetscCall(MatDenseGetArrayWrite(ctx->V[0], &array));
922         PetscCall(MatDensePlaceArray(ctx->V[1], array));
923         PetscCall(MatDenseRestoreArrayWrite(ctx->V[0], &array));
924         reset = PETSC_TRUE;
925       }
926     }
927     PetscCall(PCHPDDMDeflate_Private(pc, X, Y));
928     if (ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_DEFLATED || ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_BALANCED) {
929       PetscCall(MatProductNumeric(ctx->V[1]));
930       PetscCall(MatCopy(ctx->V[1], ctx->V[2], SAME_NONZERO_PATTERN));
931       PetscCall(MatAXPY(ctx->V[2], -1.0, X, SAME_NONZERO_PATTERN));
932       PetscCall(PCMatApply(ctx->pc, ctx->V[2], ctx->V[1]));
933       if (ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_BALANCED) {
934         PetscCall(MatProductNumeric(ctx->V[2]));
935         PetscCall(PCHPDDMDeflate_Private(pc, ctx->V[2], ctx->V[2]));
936         PetscCall(MatAXPY(ctx->V[1], -1.0, ctx->V[2], SAME_NONZERO_PATTERN));
937       }
938       PetscCall(MatAXPY(Y, -1.0, ctx->V[1], SAME_NONZERO_PATTERN));
939     } else {
940       PetscCheck(ctx->parent->correction == PC_HPDDM_COARSE_CORRECTION_ADDITIVE, PetscObjectComm((PetscObject)pc), PETSC_ERR_PLIB, "PCSHELL from PCHPDDM called with an unknown PCHPDDMCoarseCorrectionType %d", ctx->parent->correction);
941       PetscCall(PCMatApply(ctx->pc, X, ctx->V[1]));
942       PetscCall(MatAXPY(Y, 1.0, ctx->V[1], SAME_NONZERO_PATTERN));
943     }
944     if (reset) PetscCall(MatDenseResetArray(ctx->V[1]));
945   }
946   PetscFunctionReturn(PETSC_SUCCESS);
947 }
948 
949 static PetscErrorCode PCDestroy_HPDDMShell(PC pc)
950 {
951   PC_HPDDM_Level *ctx;
952 
953   PetscFunctionBegin;
954   PetscCall(PCShellGetContext(pc, &ctx));
955   PetscCall(HPDDM::Schwarz<PetscScalar>::destroy(ctx, PETSC_TRUE));
956   PetscCall(VecDestroyVecs(1, &ctx->v[0]));
957   PetscCall(VecDestroyVecs(2, &ctx->v[1]));
958   PetscCall(PetscObjectCompose((PetscObject)ctx->pc->mat, "_HPDDM_MatProduct", nullptr));
959   PetscCall(MatDestroy(ctx->V));
960   PetscCall(MatDestroy(ctx->V + 1));
961   PetscCall(MatDestroy(ctx->V + 2));
962   PetscCall(VecDestroy(&ctx->D));
963   PetscCall(PetscSFDestroy(&ctx->scatter));
964   PetscCall(PCDestroy(&ctx->pc));
965   PetscFunctionReturn(PETSC_SUCCESS);
966 }
967 
968 template <class Type, bool T = false, typename std::enable_if<std::is_same<Type, Vec>::value>::type * = nullptr>
969 static inline PetscErrorCode PCApply_Schur_Private(std::tuple<KSP, IS, Vec[2]> *p, PC factor, Type x, Type y)
970 {
971   PetscFunctionBegin;
972   PetscCall(VecISCopy(std::get<2>(*p)[0], std::get<1>(*p), SCATTER_FORWARD, x));
973   if (!T) PetscCall(PCApply(factor, std::get<2>(*p)[0], std::get<2>(*p)[1]));
974   else PetscCall(PCApplyTranspose(factor, std::get<2>(*p)[0], std::get<2>(*p)[1]));
975   PetscCall(VecISCopy(std::get<2>(*p)[1], std::get<1>(*p), SCATTER_REVERSE, y));
976   PetscFunctionReturn(PETSC_SUCCESS);
977 }
978 
979 template <class Type, bool = false, typename std::enable_if<std::is_same<Type, Mat>::value>::type * = nullptr>
980 static inline PetscErrorCode PCApply_Schur_Private(std::tuple<KSP, IS, Vec[2]> *p, PC factor, Type X, Type Y)
981 {
982   Mat B[2];
983   Vec x, y;
984 
985   PetscFunctionBegin;
986   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, factor->mat->rmap->n, X->cmap->n, nullptr, B));
987   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, factor->mat->rmap->n, X->cmap->n, nullptr, B + 1));
988   for (PetscInt i = 0; i < X->cmap->n; ++i) {
989     PetscCall(MatDenseGetColumnVecRead(X, i, &x));
990     PetscCall(MatDenseGetColumnVecWrite(B[0], i, &y));
991     PetscCall(VecISCopy(y, std::get<1>(*p), SCATTER_FORWARD, x));
992     PetscCall(MatDenseRestoreColumnVecWrite(B[0], i, &y));
993     PetscCall(MatDenseRestoreColumnVecRead(X, i, &x));
994   }
995   PetscCall(PCMatApply(factor, B[0], B[1]));
996   PetscCall(MatDestroy(B));
997   for (PetscInt i = 0; i < X->cmap->n; ++i) {
998     PetscCall(MatDenseGetColumnVecRead(B[1], i, &x));
999     PetscCall(MatDenseGetColumnVecWrite(Y, i, &y));
1000     PetscCall(VecISCopy(x, std::get<1>(*p), SCATTER_REVERSE, y));
1001     PetscCall(MatDenseRestoreColumnVecWrite(Y, i, &y));
1002     PetscCall(MatDenseRestoreColumnVecRead(B[1], i, &x));
1003   }
1004   PetscCall(MatDestroy(B + 1));
1005   PetscFunctionReturn(PETSC_SUCCESS);
1006 }
1007 
1008 template <class Type = Vec, bool T = false>
1009 static PetscErrorCode PCApply_Schur(PC pc, Type x, Type y)
1010 {
1011   PC                           factor;
1012   Mat                          A;
1013   MatSolverType                type;
1014   PetscBool                    flg;
1015   std::tuple<KSP, IS, Vec[2]> *p;
1016 
1017   PetscFunctionBegin;
1018   PetscCall(PCShellGetContext(pc, &p));
1019   PetscCall(KSPGetPC(std::get<0>(*p), &factor));
1020   PetscCall(PCFactorGetMatSolverType(factor, &type));
1021   PetscCall(PCFactorGetMatrix(factor, &A));
1022   PetscCall(PetscStrcmp(type, MATSOLVERMUMPS, &flg));
1023   if (flg) {
1024     PetscCheck(PetscDefined(HAVE_MUMPS), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Inconsistent MatSolverType");
1025 #if PetscDefined(HAVE_MUMPS)
1026     PetscCall(MatMumpsSetIcntl(A, 26, 0));
1027 #endif
1028   } else {
1029     PetscCall(PetscStrcmp(type, MATSOLVERMKL_PARDISO, &flg));
1030     PetscCheck(flg && PetscDefined(HAVE_MKL_PARDISO), PETSC_COMM_SELF, PETSC_ERR_PLIB, "Inconsistent MatSolverType");
1031     flg = PETSC_FALSE;
1032 #if PetscDefined(HAVE_MKL_PARDISO)
1033     PetscCall(MatMkl_PardisoSetCntl(A, 70, 1));
1034 #endif
1035   }
1036   PetscCall(PCApply_Schur_Private<Type, T>(p, factor, x, y));
1037   if (flg) {
1038 #if PetscDefined(HAVE_MUMPS)
1039     PetscCall(MatMumpsSetIcntl(A, 26, -1));
1040 #endif
1041   } else {
1042 #if PetscDefined(HAVE_MKL_PARDISO)
1043     PetscCall(MatMkl_PardisoSetCntl(A, 70, 0));
1044 #endif
1045   }
1046   PetscFunctionReturn(PETSC_SUCCESS);
1047 }
1048 
1049 static PetscErrorCode PCDestroy_Schur(PC pc)
1050 {
1051   std::tuple<KSP, IS, Vec[2]> *p;
1052 
1053   PetscFunctionBegin;
1054   PetscCall(PCShellGetContext(pc, &p));
1055   PetscCall(ISDestroy(&std::get<1>(*p)));
1056   PetscCall(VecDestroy(std::get<2>(*p)));
1057   PetscCall(VecDestroy(std::get<2>(*p) + 1));
1058   PetscCall(PetscFree(p));
1059   PetscFunctionReturn(PETSC_SUCCESS);
1060 }
1061 
1062 static PetscErrorCode PCHPDDMSolve_Private(const PC_HPDDM_Level *ctx, PetscScalar *rhs, const unsigned short &mu)
1063 {
1064   Mat      B, X;
1065   PetscInt n, N, j = 0;
1066 
1067   PetscFunctionBegin;
1068   PetscCall(KSPGetOperators(ctx->ksp, &B, nullptr));
1069   PetscCall(MatGetLocalSize(B, &n, nullptr));
1070   PetscCall(MatGetSize(B, &N, nullptr));
1071   if (ctx->parent->log_separate) {
1072     j = std::distance(ctx->parent->levels, std::find(ctx->parent->levels, ctx->parent->levels + ctx->parent->N, ctx));
1073     PetscCall(PetscLogEventBegin(PC_HPDDM_Solve[j], ctx->ksp, nullptr, nullptr, nullptr));
1074   }
1075   if (mu == 1) {
1076     if (!ctx->ksp->vec_rhs) {
1077       PetscCall(VecCreateMPIWithArray(PetscObjectComm((PetscObject)ctx->ksp), 1, n, N, nullptr, &ctx->ksp->vec_rhs));
1078       PetscCall(VecCreateMPI(PetscObjectComm((PetscObject)ctx->ksp), n, N, &ctx->ksp->vec_sol));
1079     }
1080     PetscCall(VecPlaceArray(ctx->ksp->vec_rhs, rhs));
1081     PetscCall(KSPSolve(ctx->ksp, nullptr, nullptr));
1082     PetscCall(VecCopy(ctx->ksp->vec_sol, ctx->ksp->vec_rhs));
1083     PetscCall(VecResetArray(ctx->ksp->vec_rhs));
1084   } else {
1085     PetscCall(MatCreateDense(PetscObjectComm((PetscObject)ctx->ksp), n, PETSC_DECIDE, N, mu, rhs, &B));
1086     PetscCall(MatCreateDense(PetscObjectComm((PetscObject)ctx->ksp), n, PETSC_DECIDE, N, mu, nullptr, &X));
1087     PetscCall(KSPMatSolve(ctx->ksp, B, X));
1088     PetscCall(MatCopy(X, B, SAME_NONZERO_PATTERN));
1089     PetscCall(MatDestroy(&X));
1090     PetscCall(MatDestroy(&B));
1091   }
1092   if (ctx->parent->log_separate) PetscCall(PetscLogEventEnd(PC_HPDDM_Solve[j], ctx->ksp, nullptr, nullptr, nullptr));
1093   PetscFunctionReturn(PETSC_SUCCESS);
1094 }
1095 
1096 static PetscErrorCode PCHPDDMSetUpNeumannOverlap_Private(PC pc)
1097 {
1098   PC_HPDDM *data = (PC_HPDDM *)pc->data;
1099 
1100   PetscFunctionBegin;
1101   if (data->setup) {
1102     Mat       P;
1103     Vec       x, xt = nullptr;
1104     PetscReal t = 0.0, s = 0.0;
1105 
1106     PetscCall(PCGetOperators(pc, nullptr, &P));
1107     PetscCall(PetscObjectQuery((PetscObject)P, "__SNES_latest_X", (PetscObject *)&x));
1108     PetscCallBack("PCHPDDM Neumann callback", (*data->setup)(data->aux, t, x, xt, s, data->is, data->setup_ctx));
1109   }
1110   PetscFunctionReturn(PETSC_SUCCESS);
1111 }
1112 
1113 static PetscErrorCode PCHPDDMCreateSubMatrices_Private(Mat mat, PetscInt n, const IS *, const IS *, MatReuse scall, Mat *submat[])
1114 {
1115   Mat       A;
1116   PetscBool flg;
1117 
1118   PetscFunctionBegin;
1119   PetscCheck(n == 1, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "MatCreateSubMatrices() called to extract %" PetscInt_FMT " submatrices, which is different than 1", n);
1120   /* previously composed Mat */
1121   PetscCall(PetscObjectQuery((PetscObject)mat, "_PCHPDDM_SubMatrices", (PetscObject *)&A));
1122   PetscCheck(A, PETSC_COMM_SELF, PETSC_ERR_PLIB, "SubMatrices not found in Mat");
1123   PetscCall(PetscObjectTypeCompare((PetscObject)A, MATSCHURCOMPLEMENT, &flg)); /* MATSCHURCOMPLEMENT has neither a MatDuplicate() nor a MatCopy() implementation */
1124   if (scall == MAT_INITIAL_MATRIX) {
1125     PetscCall(PetscCalloc1(2, submat)); /* allocate an extra Mat to avoid errors in MatDestroySubMatrices_Dummy() */
1126     if (!flg) PetscCall(MatDuplicate(A, MAT_COPY_VALUES, *submat));
1127   } else if (!flg) PetscCall(MatCopy(A, (*submat)[0], SAME_NONZERO_PATTERN));
1128   if (flg) {
1129     PetscCall(MatDestroy(*submat)); /* previously created Mat has to be destroyed */
1130     (*submat)[0] = A;
1131     PetscCall(PetscObjectReference((PetscObject)A));
1132   }
1133   PetscFunctionReturn(PETSC_SUCCESS);
1134 }
1135 
1136 static PetscErrorCode PCHPDDMCommunicationAvoidingPCASM_Private(PC pc, Mat C, PetscBool sorted)
1137 {
1138   void (*op)(void);
1139 
1140   PetscFunctionBegin;
1141   /* previously-composed Mat */
1142   PetscCall(PetscObjectCompose((PetscObject)pc->pmat, "_PCHPDDM_SubMatrices", (PetscObject)C));
1143   PetscCall(MatGetOperation(pc->pmat, MATOP_CREATE_SUBMATRICES, &op));
1144   /* trick suggested by Barry https://lists.mcs.anl.gov/pipermail/petsc-dev/2020-January/025491.html */
1145   PetscCall(MatSetOperation(pc->pmat, MATOP_CREATE_SUBMATRICES, (void (*)(void))PCHPDDMCreateSubMatrices_Private));
1146   if (sorted) PetscCall(PCASMSetSortIndices(pc, PETSC_FALSE)); /* everything is already sorted */
1147   PetscCall(PCSetFromOptions(pc));                             /* otherwise -pc_hpddm_levels_1_pc_asm_sub_mat_type is not used */
1148   PetscCall(PCSetUp(pc));
1149   /* reset MatCreateSubMatrices() */
1150   PetscCall(MatSetOperation(pc->pmat, MATOP_CREATE_SUBMATRICES, op));
1151   PetscCall(PetscObjectCompose((PetscObject)pc->pmat, "_PCHPDDM_SubMatrices", nullptr));
1152   PetscFunctionReturn(PETSC_SUCCESS);
1153 }
1154 
1155 static PetscErrorCode PCHPDDMPermute_Private(IS is, IS in_is, IS *out_is, Mat in_C, Mat *out_C, IS *p)
1156 {
1157   IS                           perm;
1158   const PetscInt              *ptr;
1159   PetscInt                    *concatenate, size, bs;
1160   std::map<PetscInt, PetscInt> order;
1161   PetscBool                    sorted;
1162 
1163   PetscFunctionBegin;
1164   PetscValidHeaderSpecific(is, IS_CLASSID, 1);
1165   PetscValidHeaderSpecific(in_C, MAT_CLASSID, 4);
1166   PetscCall(ISSorted(is, &sorted));
1167   if (!sorted) {
1168     PetscCall(ISGetLocalSize(is, &size));
1169     PetscCall(ISGetIndices(is, &ptr));
1170     PetscCall(ISGetBlockSize(is, &bs));
1171     /* MatCreateSubMatrices(), called by PCASM, follows the global numbering of Pmat */
1172     for (PetscInt n = 0; n < size; n += bs) order.insert(std::make_pair(ptr[n] / bs, n / bs));
1173     PetscCall(ISRestoreIndices(is, &ptr));
1174     size /= bs;
1175     if (out_C) {
1176       PetscCall(PetscMalloc1(size, &concatenate));
1177       for (const std::pair<const PetscInt, PetscInt> &i : order) *concatenate++ = i.second;
1178       concatenate -= size;
1179       PetscCall(ISCreateBlock(PetscObjectComm((PetscObject)in_C), bs, size, concatenate, PETSC_OWN_POINTER, &perm));
1180       PetscCall(ISSetPermutation(perm));
1181       /* permute user-provided Mat so that it matches with MatCreateSubMatrices() numbering */
1182       PetscCall(MatPermute(in_C, perm, perm, out_C));
1183       if (p) *p = perm;
1184       else PetscCall(ISDestroy(&perm)); /* no need to save the permutation */
1185     }
1186     if (out_is) {
1187       PetscCall(PetscMalloc1(size, &concatenate));
1188       for (const std::pair<const PetscInt, PetscInt> &i : order) *concatenate++ = i.first;
1189       concatenate -= size;
1190       /* permute user-provided IS so that it matches with MatCreateSubMatrices() numbering */
1191       PetscCall(ISCreateBlock(PetscObjectComm((PetscObject)in_is), bs, size, concatenate, PETSC_OWN_POINTER, out_is));
1192     }
1193   } else { /* input IS is sorted, nothing to permute, simply duplicate inputs when needed */
1194     if (out_C) PetscCall(MatDuplicate(in_C, MAT_COPY_VALUES, out_C));
1195     if (out_is) PetscCall(ISDuplicate(in_is, out_is));
1196   }
1197   PetscFunctionReturn(PETSC_SUCCESS);
1198 }
1199 
1200 static PetscErrorCode PCHPDDMCheckSymmetry_Private(PC pc, Mat A01, Mat A10)
1201 {
1202   Mat       T, U = nullptr, B = nullptr;
1203   IS        z;
1204   PetscBool flg[2];
1205 
1206   PetscFunctionBegin;
1207   PetscCall(PetscObjectTypeCompare((PetscObject)A10, MATTRANSPOSEVIRTUAL, flg));
1208   if (flg[0]) {
1209     PetscCall(MatShellGetScalingShifts(A10, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Mat *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED));
1210     PetscCall(MatTransposeGetMat(A10, &U));
1211   } else {
1212     PetscCall(PetscObjectTypeCompare((PetscObject)A10, MATHERMITIANTRANSPOSEVIRTUAL, flg + 1));
1213     if (flg[1]) {
1214       PetscCall(MatShellGetScalingShifts(A10, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Mat *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED));
1215       PetscCall(MatHermitianTransposeGetMat(A10, &U));
1216     }
1217   }
1218   if (U) PetscCall(MatDuplicate(U, MAT_COPY_VALUES, &T));
1219   else PetscCall(MatHermitianTranspose(A10, MAT_INITIAL_MATRIX, &T));
1220   PetscCall(PetscObjectTypeCompare((PetscObject)A01, MATTRANSPOSEVIRTUAL, flg));
1221   if (flg[0]) {
1222     PetscCall(MatShellGetScalingShifts(A01, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Mat *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED));
1223     PetscCall(MatTransposeGetMat(A01, &A01));
1224     PetscCall(MatTranspose(A01, MAT_INITIAL_MATRIX, &B));
1225     A01 = B;
1226   } else {
1227     PetscCall(PetscObjectTypeCompare((PetscObject)A01, MATHERMITIANTRANSPOSEVIRTUAL, flg));
1228     if (flg[0]) {
1229       PetscCall(MatShellGetScalingShifts(A01, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Mat *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED));
1230       PetscCall(MatHermitianTransposeGetMat(A01, &A01));
1231       PetscCall(MatHermitianTranspose(A01, MAT_INITIAL_MATRIX, &B));
1232       A01 = B;
1233     }
1234   }
1235   PetscCall(PetscLayoutCompare(T->rmap, A01->rmap, flg));
1236   if (flg[0]) {
1237     PetscCall(PetscLayoutCompare(T->cmap, A01->cmap, flg));
1238     if (flg[0]) {
1239       PetscCall(MatFindZeroRows(A01, &z)); /* for essential boundary conditions, some implementations will */
1240       if (z) {                             /*  zero rows in [P00 A01] except for the diagonal of P00       */
1241         PetscCall(MatSetOption(T, MAT_NO_OFF_PROC_ZERO_ROWS, PETSC_TRUE));
1242         PetscCall(MatZeroRowsIS(T, z, 0.0, nullptr, nullptr)); /* corresponding zero rows from A01 */
1243         PetscCall(ISDestroy(&z));
1244       }
1245       PetscCall(MatMultEqual(A01, T, 20, flg));
1246       PetscCheck(flg[0], PetscObjectComm((PetscObject)pc), PETSC_ERR_SUP, "A01 != A10^T");
1247     } else PetscCall(PetscInfo(pc, "A01 and A10^T have non-congruent column layouts, cannot test for equality\n"));
1248   }
1249   PetscCall(MatDestroy(&B));
1250   PetscCall(MatDestroy(&T));
1251   PetscFunctionReturn(PETSC_SUCCESS);
1252 }
1253 
1254 static PetscErrorCode PCHPDDMCheckInclusion_Private(PC pc, IS is, IS is_local, PetscBool check)
1255 {
1256   IS          intersect;
1257   const char *str = "IS of the auxiliary Mat does not include all local rows of A";
1258   PetscBool   equal;
1259 
1260   PetscFunctionBegin;
1261   PetscCall(ISIntersect(is, is_local, &intersect));
1262   PetscCall(ISEqualUnsorted(is_local, intersect, &equal));
1263   PetscCall(ISDestroy(&intersect));
1264   if (check) PetscCheck(equal, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "%s", str);
1265   else if (!equal) PetscCall(PetscInfo(pc, "%s\n", str));
1266   PetscFunctionReturn(PETSC_SUCCESS);
1267 }
1268 
1269 static PetscErrorCode PCHPDDMDestroySubMatrices_Private(PetscBool flg, PetscBool algebraic, Mat *sub)
1270 {
1271   IS is;
1272 
1273   PetscFunctionBegin;
1274   if (!flg) {
1275     if (algebraic) {
1276       PetscCall(PetscObjectQuery((PetscObject)sub[0], "_PCHPDDM_Embed", (PetscObject *)&is));
1277       PetscCall(ISDestroy(&is));
1278       PetscCall(PetscObjectCompose((PetscObject)sub[0], "_PCHPDDM_Embed", nullptr));
1279       PetscCall(PetscObjectCompose((PetscObject)sub[0], "_PCHPDDM_Compact", nullptr));
1280     }
1281     PetscCall(MatDestroySubMatrices(algebraic ? 2 : 1, &sub));
1282   }
1283   PetscFunctionReturn(PETSC_SUCCESS);
1284 }
1285 
1286 static PetscErrorCode PCHPDDMAlgebraicAuxiliaryMat_Private(Mat P, IS *is, Mat *sub[], PetscBool block)
1287 {
1288   IS         icol[3], irow[2];
1289   Mat       *M, Q;
1290   PetscReal *ptr;
1291   PetscInt  *idx, p = 0, bs = PetscAbs(P->cmap->bs);
1292   PetscBool  flg;
1293 
1294   PetscFunctionBegin;
1295   PetscCall(ISCreateStride(PETSC_COMM_SELF, P->cmap->N, 0, 1, icol + 2));
1296   PetscCall(ISSetBlockSize(icol[2], bs));
1297   PetscCall(ISSetIdentity(icol[2]));
1298   PetscCall(PetscObjectTypeCompare((PetscObject)P, MATMPISBAIJ, &flg));
1299   if (flg) {
1300     /* MatCreateSubMatrices() does not handle MATMPISBAIJ properly when iscol != isrow, so convert first to MATMPIBAIJ */
1301     PetscCall(MatConvert(P, MATMPIBAIJ, MAT_INITIAL_MATRIX, &Q));
1302     std::swap(P, Q);
1303   }
1304   PetscCall(MatCreateSubMatrices(P, 1, is, icol + 2, MAT_INITIAL_MATRIX, &M));
1305   if (flg) {
1306     std::swap(P, Q);
1307     PetscCall(MatDestroy(&Q));
1308   }
1309   PetscCall(ISDestroy(icol + 2));
1310   PetscCall(ISCreateStride(PETSC_COMM_SELF, M[0]->rmap->N, 0, 1, irow));
1311   PetscCall(ISSetBlockSize(irow[0], bs));
1312   PetscCall(ISSetIdentity(irow[0]));
1313   if (!block) {
1314     PetscCall(PetscMalloc2(P->cmap->N, &ptr, P->cmap->N / bs, &idx));
1315     PetscCall(MatGetColumnNorms(M[0], NORM_INFINITY, ptr));
1316     /* check for nonzero columns so that M[0] may be expressed in compact form */
1317     for (PetscInt n = 0; n < P->cmap->N; n += bs) {
1318       if (std::find_if(ptr + n, ptr + n + bs, [](PetscReal v) { return v > PETSC_MACHINE_EPSILON; }) != ptr + n + bs) idx[p++] = n / bs;
1319     }
1320     PetscCall(ISCreateBlock(PETSC_COMM_SELF, bs, p, idx, PETSC_USE_POINTER, icol + 1));
1321     PetscCall(ISSetInfo(icol[1], IS_SORTED, IS_GLOBAL, PETSC_TRUE, PETSC_TRUE));
1322     PetscCall(ISEmbed(*is, icol[1], PETSC_FALSE, icol + 2));
1323     irow[1] = irow[0];
1324     /* first Mat will be used in PCASM (if it is used as a PC on this level) and as the left-hand side of GenEO */
1325     icol[0] = is[0];
1326     PetscCall(MatCreateSubMatrices(M[0], 2, irow, icol, MAT_INITIAL_MATRIX, sub));
1327     PetscCall(ISDestroy(icol + 1));
1328     PetscCall(PetscFree2(ptr, idx));
1329     /* IS used to go back and forth between the augmented and the original local linear system, see eq. (3.4) of [2022b] */
1330     PetscCall(PetscObjectCompose((PetscObject)(*sub)[0], "_PCHPDDM_Embed", (PetscObject)icol[2]));
1331     /* Mat used in eq. (3.1) of [2022b] */
1332     PetscCall(PetscObjectCompose((PetscObject)(*sub)[0], "_PCHPDDM_Compact", (PetscObject)(*sub)[1]));
1333   } else {
1334     Mat aux;
1335 
1336     PetscCall(MatSetOption(M[0], MAT_SUBMAT_SINGLEIS, PETSC_TRUE));
1337     /* diagonal block of the overlapping rows */
1338     PetscCall(MatCreateSubMatrices(M[0], 1, irow, is, MAT_INITIAL_MATRIX, sub));
1339     PetscCall(MatDuplicate((*sub)[0], MAT_COPY_VALUES, &aux));
1340     PetscCall(MatSetOption(aux, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_FALSE));
1341     if (bs == 1) { /* scalar case */
1342       Vec sum[2];
1343 
1344       PetscCall(MatCreateVecs(aux, sum, sum + 1));
1345       PetscCall(MatGetRowSum(M[0], sum[0]));
1346       PetscCall(MatGetRowSum(aux, sum[1]));
1347       /* off-diagonal block row sum (full rows - diagonal block rows) */
1348       PetscCall(VecAXPY(sum[0], -1.0, sum[1]));
1349       /* subdomain matrix plus off-diagonal block row sum */
1350       PetscCall(MatDiagonalSet(aux, sum[0], ADD_VALUES));
1351       PetscCall(VecDestroy(sum));
1352       PetscCall(VecDestroy(sum + 1));
1353     } else { /* vectorial case */
1354       /* TODO: missing MatGetValuesBlocked(), so the code below is     */
1355       /* an extension of the scalar case for when bs > 1, but it could */
1356       /* be more efficient by avoiding all these MatMatMult()          */
1357       Mat          sum[2], ones;
1358       PetscScalar *ptr;
1359 
1360       PetscCall(PetscCalloc1(M[0]->cmap->n * bs, &ptr));
1361       PetscCall(MatCreateDense(PETSC_COMM_SELF, M[0]->cmap->n, bs, M[0]->cmap->n, bs, ptr, &ones));
1362       for (PetscInt n = 0; n < M[0]->cmap->n; n += bs) {
1363         for (p = 0; p < bs; ++p) ptr[n + p * (M[0]->cmap->n + 1)] = 1.0;
1364       }
1365       PetscCall(MatMatMult(M[0], ones, MAT_INITIAL_MATRIX, PETSC_CURRENT, sum));
1366       PetscCall(MatDestroy(&ones));
1367       PetscCall(MatCreateDense(PETSC_COMM_SELF, aux->cmap->n, bs, aux->cmap->n, bs, ptr, &ones));
1368       PetscCall(MatDenseSetLDA(ones, M[0]->cmap->n));
1369       PetscCall(MatMatMult(aux, ones, MAT_INITIAL_MATRIX, PETSC_CURRENT, sum + 1));
1370       PetscCall(MatDestroy(&ones));
1371       PetscCall(PetscFree(ptr));
1372       /* off-diagonal block row sum (full rows - diagonal block rows) */
1373       PetscCall(MatAXPY(sum[0], -1.0, sum[1], SAME_NONZERO_PATTERN));
1374       PetscCall(MatDestroy(sum + 1));
1375       /* re-order values to be consistent with MatSetValuesBlocked()           */
1376       /* equivalent to MatTranspose() which does not truly handle              */
1377       /* MAT_INPLACE_MATRIX in the rectangular case, as it calls PetscMalloc() */
1378       PetscCall(MatDenseGetArrayWrite(sum[0], &ptr));
1379       HPDDM::Wrapper<PetscScalar>::imatcopy<'T'>(bs, sum[0]->rmap->n, ptr, sum[0]->rmap->n, bs);
1380       /* subdomain matrix plus off-diagonal block row sum */
1381       for (PetscInt n = 0; n < aux->cmap->n / bs; ++n) PetscCall(MatSetValuesBlocked(aux, 1, &n, 1, &n, ptr + n * bs * bs, ADD_VALUES));
1382       PetscCall(MatAssemblyBegin(aux, MAT_FINAL_ASSEMBLY));
1383       PetscCall(MatAssemblyEnd(aux, MAT_FINAL_ASSEMBLY));
1384       PetscCall(MatDenseRestoreArrayWrite(sum[0], &ptr));
1385       PetscCall(MatDestroy(sum));
1386     }
1387     PetscCall(MatSetOption(aux, MAT_NEW_NONZERO_ALLOCATION_ERR, PETSC_TRUE));
1388     /* left-hand side of GenEO, with the same sparsity pattern as PCASM subdomain solvers  */
1389     PetscCall(PetscObjectCompose((PetscObject)(*sub)[0], "_PCHPDDM_Neumann_Mat", (PetscObject)aux));
1390   }
1391   PetscCall(ISDestroy(irow));
1392   PetscCall(MatDestroySubMatrices(1, &M));
1393   PetscFunctionReturn(PETSC_SUCCESS);
1394 }
1395 
1396 static PetscErrorCode PCApply_Nest(PC pc, Vec x, Vec y)
1397 {
1398   Mat                    A;
1399   MatSolverType          type;
1400   IS                     is[2];
1401   PetscBool              flg;
1402   std::pair<PC, Vec[2]> *p;
1403 
1404   PetscFunctionBegin;
1405   PetscCall(PCShellGetContext(pc, &p));
1406   PetscCall(PCGetOperators(p->first, &A, nullptr));
1407   PetscCall(MatNestGetISs(A, is, nullptr));
1408   PetscCall(PCFactorGetMatSolverType(p->first, &type));
1409   PetscCall(PCFactorGetMatrix(p->first, &A));
1410   PetscCall(PetscStrcmp(type, MATSOLVERMUMPS, &flg));
1411   if (flg && A->schur) {
1412 #if PetscDefined(HAVE_MUMPS)
1413     PetscCall(MatMumpsSetIcntl(A, 26, 1)); /* reduction/condensation phase followed by Schur complement solve */
1414 #endif
1415   }
1416   PetscCall(VecISCopy(p->second[0], is[1], SCATTER_FORWARD, x)); /* assign the RHS associated to the Schur complement */
1417   PetscCall(PCApply(p->first, p->second[0], p->second[1]));
1418   PetscCall(VecISCopy(p->second[1], is[1], SCATTER_REVERSE, y)); /* retrieve the partial solution associated to the Schur complement */
1419   if (flg) {
1420 #if PetscDefined(HAVE_MUMPS)
1421     PetscCall(MatMumpsSetIcntl(A, 26, -1)); /* default ICNTL(26) value in PETSc */
1422 #endif
1423   }
1424   PetscFunctionReturn(PETSC_SUCCESS);
1425 }
1426 
1427 static PetscErrorCode PCView_Nest(PC pc, PetscViewer viewer)
1428 {
1429   std::pair<PC, Vec[2]> *p;
1430 
1431   PetscFunctionBegin;
1432   PetscCall(PCShellGetContext(pc, &p));
1433   PetscCall(PCView(p->first, viewer));
1434   PetscFunctionReturn(PETSC_SUCCESS);
1435 }
1436 
1437 static PetscErrorCode PCDestroy_Nest(PC pc)
1438 {
1439   std::pair<PC, Vec[2]> *p;
1440 
1441   PetscFunctionBegin;
1442   PetscCall(PCShellGetContext(pc, &p));
1443   PetscCall(VecDestroy(p->second));
1444   PetscCall(VecDestroy(p->second + 1));
1445   PetscCall(PCDestroy(&p->first));
1446   PetscCall(PetscFree(p));
1447   PetscFunctionReturn(PETSC_SUCCESS);
1448 }
1449 
1450 template <bool T = false>
1451 static PetscErrorCode MatMult_Schur(Mat A, Vec x, Vec y)
1452 {
1453   std::tuple<Mat, PetscSF, Vec[2]> *ctx;
1454 
1455   PetscFunctionBegin;
1456   PetscCall(MatShellGetContext(A, &ctx));
1457   PetscCall(VecScatterBegin(std::get<1>(*ctx), x, std::get<2>(*ctx)[0], INSERT_VALUES, SCATTER_FORWARD)); /* local Vec with overlap */
1458   PetscCall(VecScatterEnd(std::get<1>(*ctx), x, std::get<2>(*ctx)[0], INSERT_VALUES, SCATTER_FORWARD));
1459   if (!T) PetscCall(MatMult(std::get<0>(*ctx), std::get<2>(*ctx)[0], std::get<2>(*ctx)[1])); /* local Schur complement */
1460   else PetscCall(MatMultTranspose(std::get<0>(*ctx), std::get<2>(*ctx)[0], std::get<2>(*ctx)[1]));
1461   PetscCall(VecSet(y, 0.0));
1462   PetscCall(VecScatterBegin(std::get<1>(*ctx), std::get<2>(*ctx)[1], y, ADD_VALUES, SCATTER_REVERSE)); /* global Vec with summed up contributions on the overlap */
1463   PetscCall(VecScatterEnd(std::get<1>(*ctx), std::get<2>(*ctx)[1], y, ADD_VALUES, SCATTER_REVERSE));
1464   PetscFunctionReturn(PETSC_SUCCESS);
1465 }
1466 
1467 static PetscErrorCode MatDestroy_Schur(Mat A)
1468 {
1469   std::tuple<Mat, PetscSF, Vec[2]> *ctx;
1470 
1471   PetscFunctionBegin;
1472   PetscCall(MatShellGetContext(A, &ctx));
1473   PetscCall(VecDestroy(std::get<2>(*ctx)));
1474   PetscCall(VecDestroy(std::get<2>(*ctx) + 1));
1475   PetscCall(PetscFree(ctx));
1476   PetscFunctionReturn(PETSC_SUCCESS);
1477 }
1478 
1479 static PetscErrorCode MatMult_SchurCorrection(Mat A, Vec x, Vec y)
1480 {
1481   PC                                         pc;
1482   std::tuple<PC[2], Mat[2], PCSide, Vec[3]> *ctx;
1483 
1484   PetscFunctionBegin;
1485   PetscCall(MatShellGetContext(A, &ctx));
1486   pc = ((PC_HPDDM *)std::get<0>(*ctx)[0]->data)->levels[0]->ksp->pc;
1487   if (std::get<2>(*ctx) == PC_LEFT || std::get<2>(*ctx) == PC_SIDE_DEFAULT) {             /* Q_0 is the coarse correction associated to the A00 block from PCFIELDSPLIT */
1488     PetscCall(MatMult(std::get<1>(*ctx)[0], x, std::get<3>(*ctx)[1]));                    /*     A_01 x                 */
1489     PetscCall(PCHPDDMDeflate_Private(pc, std::get<3>(*ctx)[1], std::get<3>(*ctx)[1]));    /*     Q_0 A_01 x             */
1490     PetscCall(MatMult(std::get<1>(*ctx)[1], std::get<3>(*ctx)[1], std::get<3>(*ctx)[0])); /*     A_10 Q_0 A_01 x        */
1491     PetscCall(PCApply(std::get<0>(*ctx)[1], std::get<3>(*ctx)[0], y));                    /* y = M_S^-1 A_10 Q_0 A_01 x */
1492   } else {
1493     PetscCall(PCApply(std::get<0>(*ctx)[1], x, std::get<3>(*ctx)[0]));                    /*     M_S^-1 x               */
1494     PetscCall(MatMult(std::get<1>(*ctx)[0], std::get<3>(*ctx)[0], std::get<3>(*ctx)[1])); /*     A_01 M_S^-1 x          */
1495     PetscCall(PCHPDDMDeflate_Private(pc, std::get<3>(*ctx)[1], std::get<3>(*ctx)[1]));    /*     Q_0 A_01 M_S^-1 x      */
1496     PetscCall(MatMult(std::get<1>(*ctx)[1], std::get<3>(*ctx)[1], y));                    /* y = A_10 Q_0 A_01 M_S^-1 x */
1497   }
1498   PetscCall(VecAXPY(y, -1.0, x)); /* y -= x, preconditioned eq. (24) of https://hal.science/hal-02343808v6/document (with a sign flip) */
1499   PetscFunctionReturn(PETSC_SUCCESS);
1500 }
1501 
1502 static PetscErrorCode MatView_SchurCorrection(Mat A, PetscViewer viewer)
1503 {
1504   PetscBool                                  ascii;
1505   std::tuple<PC[2], Mat[2], PCSide, Vec[3]> *ctx;
1506 
1507   PetscFunctionBegin;
1508   PetscCall(PetscObjectTypeCompare((PetscObject)viewer, PETSCVIEWERASCII, &ascii));
1509   if (ascii) {
1510     PetscCall(MatShellGetContext(A, &ctx));
1511     PetscCall(PetscViewerASCIIPrintf(viewer, "action of %s\n", std::get<2>(*ctx) == PC_LEFT || std::get<2>(*ctx) == PC_SIDE_DEFAULT ? "(I - M_S^-1 A_10 Q_0 A_01)" : "(I - A_10 Q_0 A_01 M_S^-1)"));
1512     PetscCall(PCView(std::get<0>(*ctx)[1], viewer)); /* no need to PCView(Q_0) since it will be done by PCFIELDSPLIT */
1513   }
1514   PetscFunctionReturn(PETSC_SUCCESS);
1515 }
1516 
1517 static PetscErrorCode MatDestroy_SchurCorrection(Mat A)
1518 {
1519   std::tuple<PC[2], Mat[2], PCSide, Vec[3]> *ctx;
1520 
1521   PetscFunctionBegin;
1522   PetscCall(MatShellGetContext(A, &ctx));
1523   PetscCall(VecDestroy(std::get<3>(*ctx)));
1524   PetscCall(VecDestroy(std::get<3>(*ctx) + 1));
1525   PetscCall(VecDestroy(std::get<3>(*ctx) + 2));
1526   PetscCall(PCDestroy(std::get<0>(*ctx) + 1));
1527   PetscCall(PetscFree(ctx));
1528   PetscFunctionReturn(PETSC_SUCCESS);
1529 }
1530 
1531 static PetscErrorCode KSPPreSolve_SchurCorrection(KSP, Vec b, Vec, void *context)
1532 {
1533   std::tuple<PC[2], Mat[2], PCSide, Vec[3]> *ctx = reinterpret_cast<std::tuple<PC[2], Mat[2], PCSide, Vec[3]> *>(context);
1534 
1535   PetscFunctionBegin;
1536   if (std::get<2>(*ctx) == PC_LEFT || std::get<2>(*ctx) == PC_SIDE_DEFAULT) {
1537     PetscCall(PCApply(std::get<0>(*ctx)[1], b, std::get<3>(*ctx)[2]));
1538     std::swap(*b, *std::get<3>(*ctx)[2]); /* replace b by M^-1 b, but need to keep a copy of the original RHS, so swap it with the work Vec */
1539   }
1540   PetscFunctionReturn(PETSC_SUCCESS);
1541 }
1542 
1543 static PetscErrorCode KSPPostSolve_SchurCorrection(KSP, Vec b, Vec x, void *context)
1544 {
1545   std::tuple<PC[2], Mat[2], PCSide, Vec[3]> *ctx = reinterpret_cast<std::tuple<PC[2], Mat[2], PCSide, Vec[3]> *>(context);
1546 
1547   PetscFunctionBegin;
1548   if (std::get<2>(*ctx) == PC_LEFT || std::get<2>(*ctx) == PC_SIDE_DEFAULT) std::swap(*b, *std::get<3>(*ctx)[2]); /* put back the original RHS where it belongs */
1549   else {
1550     PetscCall(PCApply(std::get<0>(*ctx)[1], x, std::get<3>(*ctx)[2]));
1551     PetscCall(VecCopy(std::get<3>(*ctx)[2], x)); /* replace x by M^-1 x */
1552   }
1553   PetscFunctionReturn(PETSC_SUCCESS);
1554 }
1555 
1556 static PetscErrorCode MatMult_Harmonic(Mat, Vec, Vec);
1557 static PetscErrorCode MatMultTranspose_Harmonic(Mat, Vec, Vec);
1558 static PetscErrorCode MatProduct_AB_Harmonic(Mat, Mat, Mat, void *);
1559 static PetscErrorCode MatDestroy_Harmonic(Mat);
1560 
1561 static PetscErrorCode PCSetUp_HPDDM(PC pc)
1562 {
1563   PC_HPDDM                                  *data = (PC_HPDDM *)pc->data;
1564   PC                                         inner;
1565   KSP                                       *ksp;
1566   Mat                                       *sub, A, P, N, C = nullptr, uaux = nullptr, weighted, subA[2], S;
1567   Vec                                        xin, v;
1568   std::vector<Vec>                           initial;
1569   IS                                         is[1], loc, uis = data->is, unsorted = nullptr;
1570   ISLocalToGlobalMapping                     l2g;
1571   char                                       prefix[256];
1572   const char                                *pcpre;
1573   const PetscScalar *const                  *ev;
1574   PetscInt                                   n, requested = data->N, reused = 0, overlap = -1;
1575   MatStructure                               structure  = UNKNOWN_NONZERO_PATTERN;
1576   PetscBool                                  subdomains = PETSC_FALSE, flg = PETSC_FALSE, ismatis, swap = PETSC_FALSE, algebraic = PETSC_FALSE, block = PETSC_FALSE;
1577   DM                                         dm;
1578   std::tuple<PC[2], Mat[2], PCSide, Vec[3]> *ctx = nullptr;
1579 #if PetscDefined(USE_DEBUG)
1580   IS  dis  = nullptr;
1581   Mat daux = nullptr;
1582 #endif
1583 
1584   PetscFunctionBegin;
1585   PetscCheck(data->levels && data->levels[0], PETSC_COMM_SELF, PETSC_ERR_PLIB, "Not a single level allocated");
1586   PetscCall(PCGetOptionsPrefix(pc, &pcpre));
1587   PetscCall(PCGetOperators(pc, &A, &P));
1588   if (!data->levels[0]->ksp) {
1589     PetscCall(KSPCreate(PetscObjectComm((PetscObject)pc), &data->levels[0]->ksp));
1590     PetscCall(KSPSetNestLevel(data->levels[0]->ksp, pc->kspnestlevel));
1591     PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "%spc_hpddm_%s_", pcpre ? pcpre : "", data->N > 1 ? "levels_1" : "coarse"));
1592     PetscCall(KSPSetOptionsPrefix(data->levels[0]->ksp, prefix));
1593     PetscCall(KSPSetType(data->levels[0]->ksp, KSPPREONLY));
1594   } else if (data->levels[0]->ksp->pc && data->levels[0]->ksp->pc->setupcalled == 1 && data->levels[0]->ksp->pc->reusepreconditioner) {
1595     /* if the fine-level PCSHELL exists, its setup has succeeded, and one wants to reuse it, */
1596     /* then just propagate the appropriate flag to the coarser levels                        */
1597     for (n = 0; n < PETSC_PCHPDDM_MAXLEVELS && data->levels[n]; ++n) {
1598       /* the following KSP and PC may be NULL for some processes, hence the check            */
1599       if (data->levels[n]->ksp) PetscCall(KSPSetReusePreconditioner(data->levels[n]->ksp, PETSC_TRUE));
1600       if (data->levels[n]->pc) PetscCall(PCSetReusePreconditioner(data->levels[n]->pc, PETSC_TRUE));
1601     }
1602     /* early bail out because there is nothing to do */
1603     PetscFunctionReturn(PETSC_SUCCESS);
1604   } else {
1605     /* reset coarser levels */
1606     for (n = 1; n < PETSC_PCHPDDM_MAXLEVELS && data->levels[n]; ++n) {
1607       if (data->levels[n]->ksp && data->levels[n]->ksp->pc && data->levels[n]->ksp->pc->setupcalled == 1 && data->levels[n]->ksp->pc->reusepreconditioner && n < data->N) {
1608         reused = data->N - n;
1609         break;
1610       }
1611       PetscCall(KSPDestroy(&data->levels[n]->ksp));
1612       PetscCall(PCDestroy(&data->levels[n]->pc));
1613     }
1614     /* check if some coarser levels are being reused */
1615     PetscCallMPI(MPIU_Allreduce(MPI_IN_PLACE, &reused, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)pc)));
1616     const int *addr = data->levels[0]->P ? data->levels[0]->P->getAddrLocal() : &HPDDM::i__0;
1617 
1618     if (addr != &HPDDM::i__0 && reused != data->N - 1) {
1619       /* reuse previously computed eigenvectors */
1620       ev = data->levels[0]->P->getVectors();
1621       if (ev) {
1622         initial.reserve(*addr);
1623         PetscCall(VecCreateSeqWithArray(PETSC_COMM_SELF, 1, data->levels[0]->P->getDof(), ev[0], &xin));
1624         for (n = 0; n < *addr; ++n) {
1625           PetscCall(VecDuplicate(xin, &v));
1626           PetscCall(VecPlaceArray(xin, ev[n]));
1627           PetscCall(VecCopy(xin, v));
1628           initial.emplace_back(v);
1629           PetscCall(VecResetArray(xin));
1630         }
1631         PetscCall(VecDestroy(&xin));
1632       }
1633     }
1634   }
1635   data->N -= reused;
1636   PetscCall(KSPSetOperators(data->levels[0]->ksp, A, P));
1637 
1638   PetscCall(PetscObjectTypeCompare((PetscObject)P, MATIS, &ismatis));
1639   if (!data->is && !ismatis) {
1640     PetscErrorCode (*create)(DM, IS *, Mat *, PetscErrorCode (**)(Mat, PetscReal, Vec, Vec, PetscReal, IS, void *), void **) = nullptr;
1641     PetscErrorCode (*usetup)(Mat, PetscReal, Vec, Vec, PetscReal, IS, void *)                                                = nullptr;
1642     void *uctx                                                                                                               = nullptr;
1643 
1644     /* first see if we can get the data from the DM */
1645     PetscCall(MatGetDM(P, &dm));
1646     if (!dm) PetscCall(MatGetDM(A, &dm));
1647     if (!dm) PetscCall(PCGetDM(pc, &dm));
1648     if (dm) { /* this is the hook for DMPLEX for which the auxiliary Mat is the local Neumann matrix */
1649       PetscCall(PetscObjectQueryFunction((PetscObject)dm, "DMCreateNeumannOverlap_C", &create));
1650       if (create) {
1651         PetscCall((*create)(dm, &uis, &uaux, &usetup, &uctx));
1652         if (data->Neumann == PETSC_BOOL3_UNKNOWN) data->Neumann = PETSC_BOOL3_TRUE; /* set the value only if it was not already provided by the user */
1653       }
1654     }
1655     if (!create) {
1656       if (!uis) {
1657         PetscCall(PetscObjectQuery((PetscObject)pc, "_PCHPDDM_Neumann_IS", (PetscObject *)&uis));
1658         PetscCall(PetscObjectReference((PetscObject)uis));
1659       }
1660       if (!uaux) {
1661         PetscCall(PetscObjectQuery((PetscObject)pc, "_PCHPDDM_Neumann_Mat", (PetscObject *)&uaux));
1662         PetscCall(PetscObjectReference((PetscObject)uaux));
1663       }
1664       /* look inside the Pmat instead of the PC, needed for MatSchurComplementComputeExplicitOperator() */
1665       if (!uis) {
1666         PetscCall(PetscObjectQuery((PetscObject)P, "_PCHPDDM_Neumann_IS", (PetscObject *)&uis));
1667         PetscCall(PetscObjectReference((PetscObject)uis));
1668       }
1669       if (!uaux) {
1670         PetscCall(PetscObjectQuery((PetscObject)P, "_PCHPDDM_Neumann_Mat", (PetscObject *)&uaux));
1671         PetscCall(PetscObjectReference((PetscObject)uaux));
1672       }
1673     }
1674     PetscCall(PCHPDDMSetAuxiliaryMat(pc, uis, uaux, usetup, uctx));
1675     PetscCall(MatDestroy(&uaux));
1676     PetscCall(ISDestroy(&uis));
1677   }
1678 
1679   if (!ismatis) {
1680     PetscCall(PCHPDDMSetUpNeumannOverlap_Private(pc));
1681     PetscCall(PetscOptionsGetBool(nullptr, pcpre, "-pc_hpddm_block_splitting", &block, nullptr));
1682     PetscCall(PetscOptionsGetInt(nullptr, pcpre, "-pc_hpddm_harmonic_overlap", &overlap, nullptr));
1683     PetscCall(PetscObjectTypeCompare((PetscObject)P, MATSCHURCOMPLEMENT, &flg));
1684     if (data->is || (data->N > 1 && flg)) {
1685       if (block || overlap != -1) {
1686         PetscCall(ISDestroy(&data->is));
1687         PetscCall(MatDestroy(&data->aux));
1688       } else if (data->N > 1 && flg) {
1689         PCHPDDMSchurPreType type = PC_HPDDM_SCHUR_PRE_GENEO;
1690 
1691         PetscCall(PetscOptionsGetEnum(nullptr, pcpre, "-pc_hpddm_schur_precondition", PCHPDDMSchurPreTypes, (PetscEnum *)&type, &flg));
1692         if (type == PC_HPDDM_SCHUR_PRE_LEAST_SQUARES) {
1693           PetscCall(ISDestroy(&data->is)); /* destroy any previously user-set objects since they will be set automatically */
1694           PetscCall(MatDestroy(&data->aux));
1695         } else if (type == PC_HPDDM_SCHUR_PRE_GENEO) {
1696           PetscContainer container = nullptr;
1697 
1698           PetscCall(PetscObjectQuery((PetscObject)pc, "_PCHPDDM_Schur", (PetscObject *)&container));
1699           if (!container) { /* first call to PCSetUp() on the PC associated to the Schur complement */
1700             PC_HPDDM *data_00;
1701             KSP       ksp, inner_ksp;
1702             PC        pc_00;
1703             Mat       A11 = nullptr;
1704             Vec       d   = nullptr;
1705             char     *prefix;
1706 
1707             PetscCall(MatSchurComplementGetKSP(P, &ksp));
1708             PetscCall(KSPGetPC(ksp, &pc_00));
1709             PetscCall(PetscObjectTypeCompare((PetscObject)pc_00, PCHPDDM, &flg));
1710             PetscCheck(flg, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-%spc_hpddm_schur_precondition %s and -%spc_type %s (!= %s)", pcpre ? pcpre : "", PCHPDDMSchurPreTypes[type], ((PetscObject)pc_00)->prefix ? ((PetscObject)pc_00)->prefix : "",
1711                        ((PetscObject)pc_00)->type_name, PCHPDDM);
1712             data_00 = (PC_HPDDM *)pc_00->data;
1713             PetscCheck(data_00->N == 2, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-%spc_hpddm_schur_precondition %s and %" PetscInt_FMT " level%s instead of 2 for the A00 block -%s", pcpre ? pcpre : "", PCHPDDMSchurPreTypes[type],
1714                        data_00->N, data_00->N > 1 ? "s" : "", ((PetscObject)pc_00)->prefix);
1715             PetscCall(PetscObjectTypeCompare((PetscObject)data_00->levels[0]->pc, PCASM, &flg));
1716             PetscCheck(flg, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-%spc_hpddm_schur_precondition %s and -%spc_type %s (!= %s)", pcpre ? pcpre : "", PCHPDDMSchurPreTypes[type], ((PetscObject)data_00->levels[0]->pc)->prefix,
1717                        ((PetscObject)data_00->levels[0]->pc)->type_name, PCASM);
1718             PetscCall(MatSchurComplementGetSubMatrices(P, nullptr, nullptr, nullptr, nullptr, &A11));
1719             if (PetscDefined(USE_DEBUG) || !data->is) {
1720               Mat A01, A10, B = nullptr, C = nullptr, *sub;
1721 
1722               PetscCall(MatSchurComplementGetSubMatrices(P, &A, nullptr, &A01, &A10, nullptr));
1723               PetscCall(PetscObjectTypeCompare((PetscObject)A10, MATTRANSPOSEVIRTUAL, &flg));
1724               if (flg) {
1725                 PetscCall(MatTransposeGetMat(A10, &C));
1726                 PetscCall(MatTranspose(C, MAT_INITIAL_MATRIX, &B));
1727               } else {
1728                 PetscCall(PetscObjectTypeCompare((PetscObject)A10, MATHERMITIANTRANSPOSEVIRTUAL, &flg));
1729                 if (flg) {
1730                   PetscCall(MatHermitianTransposeGetMat(A10, &C));
1731                   PetscCall(MatHermitianTranspose(C, MAT_INITIAL_MATRIX, &B));
1732                 }
1733               }
1734               if (flg)
1735                 PetscCall(MatShellGetScalingShifts(A10, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Mat *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED));
1736               if (!B) {
1737                 B = A10;
1738                 PetscCall(PetscObjectReference((PetscObject)B));
1739               } else if (!data->is) {
1740                 PetscCall(PetscObjectTypeCompareAny((PetscObject)A01, &flg, MATTRANSPOSEVIRTUAL, MATHERMITIANTRANSPOSEVIRTUAL, ""));
1741                 if (!flg) C = A01;
1742                 else
1743                   PetscCall(MatShellGetScalingShifts(A01, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (PetscScalar *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Vec *)MAT_SHELL_NOT_ALLOWED, (Mat *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED, (IS *)MAT_SHELL_NOT_ALLOWED));
1744               }
1745               PetscCall(ISCreateStride(PETSC_COMM_SELF, B->rmap->N, 0, 1, &uis));
1746               PetscCall(ISSetIdentity(uis));
1747               if (!data->is) {
1748                 if (C) PetscCall(PetscObjectReference((PetscObject)C));
1749                 else PetscCall(MatTranspose(B, MAT_INITIAL_MATRIX, &C));
1750                 PetscCall(ISDuplicate(data_00->is, is));
1751                 PetscCall(MatIncreaseOverlap(A, 1, is, 1));
1752                 PetscCall(MatSetOption(C, MAT_SUBMAT_SINGLEIS, PETSC_TRUE));
1753                 PetscCall(MatCreateSubMatrices(C, 1, is, &uis, MAT_INITIAL_MATRIX, &sub));
1754                 PetscCall(MatDestroy(&C));
1755                 PetscCall(MatTranspose(sub[0], MAT_INITIAL_MATRIX, &C));
1756                 PetscCall(MatDestroySubMatrices(1, &sub));
1757                 PetscCall(MatFindNonzeroRows(C, &data->is));
1758                 PetscCall(MatDestroy(&C));
1759                 PetscCall(ISDestroy(is));
1760                 PetscCall(ISCreateStride(PetscObjectComm((PetscObject)data->is), A11->rmap->n, A11->rmap->rstart, 1, &loc));
1761                 if (PetscDefined(USE_DEBUG)) PetscCall(PCHPDDMCheckInclusion_Private(pc, data->is, loc, PETSC_FALSE));
1762                 PetscCall(ISExpand(data->is, loc, is));
1763                 PetscCall(ISDestroy(&loc));
1764                 PetscCall(ISDestroy(&data->is));
1765                 data->is = is[0];
1766                 is[0]    = nullptr;
1767               }
1768               if (PetscDefined(USE_DEBUG)) {
1769                 PetscCall(PCHPDDMCheckSymmetry_Private(pc, A01, A10));
1770                 PetscCall(MatCreateSubMatrices(B, 1, &uis, &data_00->is, MAT_INITIAL_MATRIX, &sub)); /* expensive check since all processes fetch all rows (but only some columns) of the constraint matrix */
1771                 PetscCall(ISDestroy(&uis));
1772                 PetscCall(ISDuplicate(data->is, &uis));
1773                 PetscCall(ISSort(uis));
1774                 PetscCall(ISComplement(uis, 0, B->rmap->N, is));
1775                 PetscCall(MatDuplicate(sub[0], MAT_COPY_VALUES, &C));
1776                 PetscCall(MatZeroRowsIS(C, is[0], 0.0, nullptr, nullptr));
1777                 PetscCall(ISDestroy(is));
1778                 PetscCall(MatMultEqual(sub[0], C, 20, &flg));
1779                 PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "The image of A_10 (R_i^p)^T from the local primal (e.g., velocity) space to the full dual (e.g., pressure) space is not restricted to the local dual space: A_10 (R_i^p)^T != R_i^d (R_i^d)^T A_10 (R_i^p)^T"); /* cf. eq. (9) of https://hal.science/hal-02343808v6/document */
1780                 PetscCall(MatDestroy(&C));
1781                 PetscCall(MatDestroySubMatrices(1, &sub));
1782               }
1783               PetscCall(ISDestroy(&uis));
1784               PetscCall(MatDestroy(&B));
1785             }
1786             flg = PETSC_FALSE;
1787             if (!data->aux) {
1788               Mat D;
1789 
1790               PetscCall(MatCreateVecs(A11, &d, nullptr));
1791               PetscCall(MatGetDiagonal(A11, d));
1792               PetscCall(PetscObjectTypeCompareAny((PetscObject)A11, &flg, MATDIAGONAL, MATCONSTANTDIAGONAL, ""));
1793               if (!flg) {
1794                 PetscCall(MatCreateDiagonal(d, &D));
1795                 PetscCall(MatMultEqual(A11, D, 20, &flg));
1796                 PetscCall(MatDestroy(&D));
1797               }
1798               if (flg) PetscCall(PetscInfo(pc, "A11 block is likely diagonal so the PC will build an auxiliary Mat (which was not initially provided by the user)\n"));
1799             }
1800             if (data->Neumann != PETSC_BOOL3_TRUE && !flg && A11) {
1801               PetscReal norm;
1802 
1803               PetscCall(MatNorm(A11, NORM_INFINITY, &norm));
1804               PetscCheck(norm < PETSC_MACHINE_EPSILON * static_cast<PetscReal>(10.0), PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-%spc_hpddm_schur_precondition geneo and -%spc_hpddm_has_neumann != true with a nonzero or non-diagonal A11 block", pcpre ? pcpre : "", pcpre ? pcpre : "");
1805               PetscCall(PetscInfo(pc, "A11 block is likely zero so the PC will build an auxiliary Mat (which was%s initially provided by the user)\n", data->aux ? "" : " not"));
1806               PetscCall(MatDestroy(&data->aux));
1807               flg = PETSC_TRUE;
1808             }
1809             if (!data->aux) { /* if A11 is near zero, e.g., Stokes equation, or diagonal, build an auxiliary (Neumann) Mat which is a (possibly slightly shifted) diagonal weighted by the inverse of the multiplicity */
1810               PetscSF            scatter;
1811               const PetscScalar *read;
1812               PetscScalar       *write, *diagonal = nullptr;
1813 
1814               PetscCall(MatDestroy(&data->aux));
1815               PetscCall(ISGetLocalSize(data->is, &n));
1816               PetscCall(VecCreateMPI(PetscObjectComm((PetscObject)P), n, PETSC_DECIDE, &xin));
1817               PetscCall(VecDuplicate(xin, &v));
1818               PetscCall(VecScatterCreate(xin, data->is, v, nullptr, &scatter));
1819               PetscCall(VecSet(v, 1.0));
1820               PetscCall(VecSet(xin, 1.0));
1821               PetscCall(VecScatterBegin(scatter, v, xin, ADD_VALUES, SCATTER_REVERSE));
1822               PetscCall(VecScatterEnd(scatter, v, xin, ADD_VALUES, SCATTER_REVERSE)); /* v has the multiplicity of all unknowns on the overlap */
1823               PetscCall(PetscSFDestroy(&scatter));
1824               if (d) {
1825                 PetscCall(VecScatterCreate(d, data->is, v, nullptr, &scatter));
1826                 PetscCall(VecScatterBegin(scatter, d, v, INSERT_VALUES, SCATTER_FORWARD));
1827                 PetscCall(VecScatterEnd(scatter, d, v, INSERT_VALUES, SCATTER_FORWARD));
1828                 PetscCall(PetscSFDestroy(&scatter));
1829                 PetscCall(VecDestroy(&d));
1830                 PetscCall(PetscMalloc1(n, &diagonal));
1831                 PetscCall(VecGetArrayRead(v, &read));
1832                 PetscCallCXX(std::copy_n(read, n, diagonal));
1833                 PetscCall(VecRestoreArrayRead(v, &read));
1834               }
1835               PetscCall(VecDestroy(&v));
1836               PetscCall(VecCreateSeq(PETSC_COMM_SELF, n, &v));
1837               PetscCall(VecGetArrayRead(xin, &read));
1838               PetscCall(VecGetArrayWrite(v, &write));
1839               for (PetscInt i = 0; i < n; ++i) write[i] = (!diagonal || std::abs(diagonal[i]) < PETSC_MACHINE_EPSILON) ? PETSC_SMALL / (static_cast<PetscReal>(1000.0) * read[i]) : diagonal[i] / read[i];
1840               PetscCall(PetscFree(diagonal));
1841               PetscCall(VecRestoreArrayRead(xin, &read));
1842               PetscCall(VecRestoreArrayWrite(v, &write));
1843               PetscCall(VecDestroy(&xin));
1844               PetscCall(MatCreateDiagonal(v, &data->aux));
1845               PetscCall(VecDestroy(&v));
1846             }
1847             uis  = data->is;
1848             uaux = data->aux;
1849             PetscCall(PetscObjectReference((PetscObject)uis));
1850             PetscCall(PetscObjectReference((PetscObject)uaux));
1851             PetscCall(PetscStrallocpy(pcpre, &prefix));
1852             PetscCall(PCSetOptionsPrefix(pc, nullptr));
1853             PetscCall(PCSetType(pc, PCKSP));                                    /* replace the PC associated to the Schur complement by PCKSP */
1854             PetscCall(KSPCreate(PetscObjectComm((PetscObject)pc), &inner_ksp)); /* new KSP that will be attached to the previously set PC */
1855             pc->ops->setup = PCSetUp_KSP;
1856             PetscCall(PetscObjectGetTabLevel((PetscObject)pc, &n));
1857             PetscCall(PetscObjectSetTabLevel((PetscObject)inner_ksp, n + 2));
1858             PetscCall(KSPSetOperators(inner_ksp, pc->mat, pc->pmat));
1859             PetscCall(KSPSetOptionsPrefix(inner_ksp, std::string(std::string(prefix) + "pc_hpddm_").c_str()));
1860             PetscCall(KSPSetSkipPCSetFromOptions(inner_ksp, PETSC_TRUE));
1861             PetscCall(KSPSetFromOptions(inner_ksp));
1862             PetscCall(KSPGetPC(inner_ksp, &inner));
1863             PetscCall(PCSetOptionsPrefix(inner, nullptr));
1864             PetscCall(PCSetType(inner, PCNONE)); /* no preconditioner since the action of M^-1 A or A M^-1 will be computed by the Amat */
1865             PetscCall(PCKSPSetKSP(pc, inner_ksp));
1866             PetscCall(PetscNew(&ctx));    /* context to pass data around for the inner-most PC, which will be a proper PCHPDDM */
1867             std::get<0>(*ctx)[0] = pc_00; /* for coarse correction on the primal (e.g., velocity) space */
1868             PetscCall(PCCreate(PetscObjectComm((PetscObject)pc), &std::get<0>(*ctx)[1]));
1869             PetscCall(PCSetOptionsPrefix(std::get<0>(*ctx)[1], prefix));
1870             PetscCall(PetscFree(prefix));
1871             PetscCall(PCSetOperators(std::get<0>(*ctx)[1], pc->mat, pc->pmat));
1872             PetscCall(PCSetType(std::get<0>(*ctx)[1], PCHPDDM));
1873             PetscCall(PCHPDDMSetAuxiliaryMat(std::get<0>(*ctx)[1], uis, uaux, nullptr, nullptr)); /* transfer ownership of the auxiliary inputs from the inner (PCKSP) to the inner-most (PCHPDDM) PC */
1874             if (flg) static_cast<PC_HPDDM *>(std::get<0>(*ctx)[1]->data)->Neumann = PETSC_BOOL3_TRUE;
1875             PetscCall(PCSetFromOptions(std::get<0>(*ctx)[1]));
1876             PetscCall(PetscObjectDereference((PetscObject)uis));
1877             PetscCall(PetscObjectDereference((PetscObject)uaux));
1878             PetscCall(MatCreateShell(PetscObjectComm((PetscObject)pc), inner->mat->rmap->n, inner->mat->cmap->n, inner->mat->rmap->N, inner->mat->cmap->N, ctx, &S)); /* MatShell computing the action of M^-1 A or A M^-1 */
1879             PetscCall(MatShellSetOperation(S, MATOP_MULT, (void (*)(void))MatMult_SchurCorrection));
1880             PetscCall(MatShellSetOperation(S, MATOP_VIEW, (void (*)(void))MatView_SchurCorrection));
1881             PetscCall(MatShellSetOperation(S, MATOP_DESTROY, (void (*)(void))MatDestroy_SchurCorrection));
1882             PetscCall(KSPGetPCSide(inner_ksp, &(std::get<2>(*ctx))));
1883             if (std::get<2>(*ctx) == PC_LEFT || std::get<2>(*ctx) == PC_SIDE_DEFAULT) {
1884               PetscCall(KSPSetPreSolve(inner_ksp, KSPPreSolve_SchurCorrection, ctx));
1885             } else { /* no support for PC_SYMMETRIC */
1886               PetscCheck(std::get<2>(*ctx) == PC_RIGHT, PetscObjectComm((PetscObject)pc), PETSC_ERR_SUP, "PCSide %s (!= %s or %s or %s)", PCSides[std::get<2>(*ctx)], PCSides[PC_SIDE_DEFAULT], PCSides[PC_LEFT], PCSides[PC_RIGHT]);
1887             }
1888             PetscCall(KSPSetPostSolve(inner_ksp, KSPPostSolve_SchurCorrection, ctx));
1889             PetscCall(PetscObjectContainerCompose((PetscObject)std::get<0>(*ctx)[1], "_PCHPDDM_Schur", ctx, nullptr));
1890             PetscCall(PCSetUp(std::get<0>(*ctx)[1]));
1891             PetscCall(KSPSetOperators(inner_ksp, S, S));
1892             PetscCall(MatCreateVecs(std::get<1>(*ctx)[0], std::get<3>(*ctx), std::get<3>(*ctx) + 1));
1893             PetscCall(VecDuplicate(std::get<3>(*ctx)[0], std::get<3>(*ctx) + 2));
1894             PetscCall(PetscObjectDereference((PetscObject)inner_ksp));
1895             PetscCall(PetscObjectDereference((PetscObject)S));
1896             for (std::vector<Vec>::iterator it = initial.begin(); it != initial.end(); ++it) PetscCall(VecDestroy(&*it));
1897             PetscFunctionReturn(PETSC_SUCCESS);
1898           } else { /* second call to PCSetUp() on the PC associated to the Schur complement, retrieve previously set context */
1899             PetscCall(PetscContainerGetPointer(container, (void **)&ctx));
1900           }
1901         }
1902       }
1903     }
1904     if (!data->is && data->N > 1) {
1905       char type[256] = {}; /* same size as in src/ksp/pc/interface/pcset.c */
1906 
1907       PetscCall(PetscObjectTypeCompareAny((PetscObject)P, &flg, MATNORMAL, MATNORMALHERMITIAN, ""));
1908       if (flg || (A->rmap->N != A->cmap->N && P->rmap->N == P->cmap->N && P->rmap->N == A->cmap->N)) {
1909         Mat B;
1910 
1911         PetscCall(PCHPDDMSetAuxiliaryMatNormal_Private(pc, A, P, &B, pcpre));
1912         if (data->correction == PC_HPDDM_COARSE_CORRECTION_DEFLATED) data->correction = PC_HPDDM_COARSE_CORRECTION_BALANCED;
1913         PetscCall(MatDestroy(&B));
1914       } else {
1915         PetscCall(PetscObjectTypeCompare((PetscObject)P, MATSCHURCOMPLEMENT, &flg));
1916         if (flg) {
1917           Mat                 A00, P00, A01, A10, A11, B, N;
1918           PCHPDDMSchurPreType type = PC_HPDDM_SCHUR_PRE_LEAST_SQUARES;
1919 
1920           PetscCall(MatSchurComplementGetSubMatrices(P, &A00, &P00, &A01, &A10, &A11));
1921           if (PetscDefined(USE_DEBUG)) PetscCall(PCHPDDMCheckSymmetry_Private(pc, A01, A10));
1922           PetscCall(PetscOptionsGetEnum(nullptr, pcpre, "-pc_hpddm_schur_precondition", PCHPDDMSchurPreTypes, (PetscEnum *)&type, &flg));
1923           if (type == PC_HPDDM_SCHUR_PRE_LEAST_SQUARES) {
1924             Vec                        diagonal = nullptr;
1925             const PetscScalar         *array;
1926             MatSchurComplementAinvType type;
1927 
1928             if (A11) {
1929               PetscCall(MatCreateVecs(A11, &diagonal, nullptr));
1930               PetscCall(MatGetDiagonal(A11, diagonal));
1931             }
1932             PetscCall(MatCreateVecs(P00, &v, nullptr));
1933             PetscCall(MatSchurComplementGetAinvType(P, &type));
1934             PetscCheck(type == MAT_SCHUR_COMPLEMENT_AINV_DIAG || type == MAT_SCHUR_COMPLEMENT_AINV_LUMP, PetscObjectComm((PetscObject)P), PETSC_ERR_SUP, "-%smat_schur_complement_ainv_type %s", ((PetscObject)P)->prefix ? ((PetscObject)P)->prefix : "", MatSchurComplementAinvTypes[type]);
1935             if (type == MAT_SCHUR_COMPLEMENT_AINV_LUMP) {
1936               PetscCall(MatGetRowSum(P00, v));
1937               if (A00 == P00) PetscCall(PetscObjectReference((PetscObject)A00));
1938               PetscCall(MatDestroy(&P00));
1939               PetscCall(VecGetArrayRead(v, &array));
1940               PetscCall(MatCreateAIJ(PetscObjectComm((PetscObject)A00), A00->rmap->n, A00->cmap->n, A00->rmap->N, A00->cmap->N, 1, nullptr, 0, nullptr, &P00));
1941               PetscCall(MatSetOption(P00, MAT_NO_OFF_PROC_ENTRIES, PETSC_TRUE));
1942               for (n = A00->rmap->rstart; n < A00->rmap->rend; ++n) PetscCall(MatSetValue(P00, n, n, array[n - A00->rmap->rstart], INSERT_VALUES));
1943               PetscCall(MatAssemblyBegin(P00, MAT_FINAL_ASSEMBLY));
1944               PetscCall(MatAssemblyEnd(P00, MAT_FINAL_ASSEMBLY));
1945               PetscCall(VecRestoreArrayRead(v, &array));
1946               PetscCall(MatSchurComplementUpdateSubMatrices(P, A00, P00, A01, A10, A11)); /* replace P00 by diag(sum of each row of P00) */
1947               PetscCall(MatDestroy(&P00));
1948             } else PetscCall(MatGetDiagonal(P00, v));
1949             PetscCall(VecReciprocal(v)); /* inv(diag(P00))       */
1950             PetscCall(VecSqrtAbs(v));    /* sqrt(inv(diag(P00))) */
1951             PetscCall(MatDuplicate(A01, MAT_COPY_VALUES, &B));
1952             PetscCall(MatDiagonalScale(B, v, nullptr));
1953             PetscCall(VecDestroy(&v));
1954             PetscCall(MatCreateNormalHermitian(B, &N));
1955             PetscCall(PCHPDDMSetAuxiliaryMatNormal_Private(pc, B, N, &P, pcpre, &diagonal));
1956             PetscCall(PetscObjectTypeCompare((PetscObject)data->aux, MATSEQAIJ, &flg));
1957             if (!flg) {
1958               PetscCall(MatDestroy(&P));
1959               P = N;
1960               PetscCall(PetscObjectReference((PetscObject)P));
1961             } else PetscCall(MatScale(P, -1.0));
1962             if (diagonal) {
1963               PetscCall(MatDiagonalSet(P, diagonal, ADD_VALUES));
1964               PetscCall(PCSetOperators(pc, P, P)); /* replace P by diag(P11) - A01^T inv(diag(P00)) A01 */
1965               PetscCall(VecDestroy(&diagonal));
1966             } else {
1967               PetscCall(MatScale(N, -1.0));
1968               PetscCall(PCSetOperators(pc, N, P)); /* replace P by - A01^T inv(diag(P00)) A01 */
1969             }
1970             PetscCall(MatDestroy(&N));
1971             PetscCall(MatDestroy(&P));
1972             PetscCall(MatDestroy(&B));
1973           } else
1974             PetscCheck(type != PC_HPDDM_SCHUR_PRE_GENEO, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-%spc_hpddm_schur_precondition %s without a prior call to PCHPDDMSetAuxiliaryMat() on the A11 block%s%s", pcpre ? pcpre : "", PCHPDDMSchurPreTypes[type], pcpre ? " -" : "", pcpre ? pcpre : "");
1975           for (std::vector<Vec>::iterator it = initial.begin(); it != initial.end(); ++it) PetscCall(VecDestroy(&*it));
1976           PetscFunctionReturn(PETSC_SUCCESS);
1977         } else {
1978           PetscCall(PetscOptionsGetString(nullptr, pcpre, "-pc_hpddm_levels_1_st_pc_type", type, sizeof(type), nullptr));
1979           PetscCall(PetscStrcmp(type, PCMAT, &algebraic));
1980           PetscCheck(!algebraic || !block, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-pc_hpddm_levels_1_st_pc_type mat and -pc_hpddm_block_splitting");
1981           if (overlap != -1) {
1982             PetscCheck(!block && !algebraic, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-pc_hpddm_%s and -pc_hpddm_harmonic_overlap", block ? "block_splitting" : "levels_1_st_pc_type mat");
1983             PetscCheck(overlap >= 1, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_WRONG, "-pc_hpddm_harmonic_overlap %" PetscInt_FMT " < 1", overlap);
1984           }
1985           if (block || overlap != -1) algebraic = PETSC_TRUE;
1986           if (algebraic) {
1987             PetscCall(ISCreateStride(PETSC_COMM_SELF, P->rmap->n, P->rmap->rstart, 1, &data->is));
1988             PetscCall(MatIncreaseOverlap(P, 1, &data->is, 1));
1989             PetscCall(ISSort(data->is));
1990           } else
1991             PetscCall(PetscInfo(pc, "Cannot assemble a fully-algebraic coarse operator with an assembled Pmat and -%spc_hpddm_levels_1_st_pc_type != mat and -%spc_hpddm_block_splitting != true and -%spc_hpddm_harmonic_overlap < 1\n", pcpre ? pcpre : "", pcpre ? pcpre : "", pcpre ? pcpre : ""));
1992         }
1993       }
1994     }
1995   }
1996 #if PetscDefined(USE_DEBUG)
1997   if (data->is) PetscCall(ISDuplicate(data->is, &dis));
1998   if (data->aux) PetscCall(MatDuplicate(data->aux, MAT_COPY_VALUES, &daux));
1999 #endif
2000   if (data->is || (ismatis && data->N > 1)) {
2001     if (ismatis) {
2002       std::initializer_list<std::string> list = {MATSEQBAIJ, MATSEQSBAIJ};
2003       PetscCall(MatISGetLocalMat(P, &N));
2004       std::initializer_list<std::string>::const_iterator it = std::find(list.begin(), list.end(), ((PetscObject)N)->type_name);
2005       PetscCall(MatISRestoreLocalMat(P, &N));
2006       switch (std::distance(list.begin(), it)) {
2007       case 0:
2008         PetscCall(MatConvert(P, MATMPIBAIJ, MAT_INITIAL_MATRIX, &C));
2009         break;
2010       case 1:
2011         /* MatCreateSubMatrices() does not work with MATSBAIJ and unsorted ISes, so convert to MPIBAIJ */
2012         PetscCall(MatConvert(P, MATMPIBAIJ, MAT_INITIAL_MATRIX, &C));
2013         PetscCall(MatSetOption(C, MAT_SYMMETRIC, PETSC_TRUE));
2014         break;
2015       default:
2016         PetscCall(MatConvert(P, MATMPIAIJ, MAT_INITIAL_MATRIX, &C));
2017       }
2018       PetscCall(MatISGetLocalToGlobalMapping(P, &l2g, nullptr));
2019       PetscCall(PetscObjectReference((PetscObject)P));
2020       PetscCall(KSPSetOperators(data->levels[0]->ksp, A, C));
2021       std::swap(C, P);
2022       PetscCall(ISLocalToGlobalMappingGetSize(l2g, &n));
2023       PetscCall(ISCreateStride(PETSC_COMM_SELF, n, 0, 1, &loc));
2024       PetscCall(ISLocalToGlobalMappingApplyIS(l2g, loc, &is[0]));
2025       PetscCall(ISDestroy(&loc));
2026       /* the auxiliary Mat is _not_ the local Neumann matrix                                */
2027       /* it is the local Neumann matrix augmented (with zeros) through MatIncreaseOverlap() */
2028       data->Neumann = PETSC_BOOL3_FALSE;
2029       structure     = SAME_NONZERO_PATTERN;
2030     } else {
2031       is[0] = data->is;
2032       if (algebraic || ctx) subdomains = PETSC_TRUE;
2033       PetscCall(PetscOptionsGetBool(nullptr, pcpre, "-pc_hpddm_define_subdomains", &subdomains, nullptr));
2034       if (ctx) PetscCheck(subdomains, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-%spc_hpddm_schur_precondition geneo and -%spc_hpddm_define_subdomains false", pcpre, pcpre);
2035       if (PetscBool3ToBool(data->Neumann)) {
2036         PetscCheck(!block, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-pc_hpddm_block_splitting and -pc_hpddm_has_neumann");
2037         PetscCheck(overlap == -1, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-pc_hpddm_harmonic_overlap %" PetscInt_FMT " and -pc_hpddm_has_neumann", overlap);
2038         PetscCheck(!algebraic, PetscObjectComm((PetscObject)P), PETSC_ERR_ARG_INCOMP, "-pc_hpddm_levels_1_st_pc_type mat and -pc_hpddm_has_neumann");
2039       }
2040       if (PetscBool3ToBool(data->Neumann) || block) structure = SAME_NONZERO_PATTERN;
2041       PetscCall(ISCreateStride(PetscObjectComm((PetscObject)data->is), P->rmap->n, P->rmap->rstart, 1, &loc));
2042     }
2043     PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "%spc_hpddm_levels_1_", pcpre ? pcpre : ""));
2044     PetscCall(PetscOptionsGetEnum(nullptr, prefix, "-st_matstructure", MatStructures, (PetscEnum *)&structure, &flg)); /* if not user-provided, force its value when possible */
2045     if (!flg && structure == SAME_NONZERO_PATTERN) {                                                                   /* cannot call STSetMatStructure() yet, insert the appropriate option in the database, parsed by STSetFromOptions() */
2046       PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "-%spc_hpddm_levels_1_st_matstructure", pcpre ? pcpre : ""));
2047       PetscCall(PetscOptionsSetValue(nullptr, prefix, MatStructures[structure]));
2048     }
2049     flg = PETSC_FALSE;
2050     if (data->share) {
2051       data->share = PETSC_FALSE; /* will be reset to PETSC_TRUE if none of the conditions below are true */
2052       if (!subdomains) PetscCall(PetscInfo(pc, "Cannot share subdomain KSP between SLEPc and PETSc since -%spc_hpddm_define_subdomains is not true\n", pcpre ? pcpre : ""));
2053       else if (data->deflation) PetscCall(PetscInfo(pc, "Nothing to share since PCHPDDMSetDeflationMat() has been called\n"));
2054       else if (ismatis) PetscCall(PetscInfo(pc, "Cannot share subdomain KSP between SLEPc and PETSc with a Pmat of type MATIS\n"));
2055       else if (!algebraic && structure != SAME_NONZERO_PATTERN)
2056         PetscCall(PetscInfo(pc, "Cannot share subdomain KSP between SLEPc and PETSc since -%spc_hpddm_levels_1_st_matstructure %s (!= %s)\n", pcpre ? pcpre : "", MatStructures[structure], MatStructures[SAME_NONZERO_PATTERN]));
2057       else data->share = PETSC_TRUE;
2058     }
2059     if (!ismatis) {
2060       if (data->share || (!PetscBool3ToBool(data->Neumann) && subdomains)) PetscCall(ISDuplicate(is[0], &unsorted));
2061       else unsorted = is[0];
2062     }
2063     if (data->N > 1 && (data->aux || ismatis || algebraic)) {
2064       PetscCheck(loadedSym, PETSC_COMM_SELF, PETSC_ERR_PLIB, "HPDDM library not loaded, cannot use more than one level");
2065       PetscCall(MatSetOption(P, MAT_SUBMAT_SINGLEIS, PETSC_TRUE));
2066       if (ismatis) {
2067         /* needed by HPDDM (currently) so that the partition of unity is 0 on subdomain interfaces */
2068         PetscCall(MatIncreaseOverlap(P, 1, is, 1));
2069         PetscCall(ISDestroy(&data->is));
2070         data->is = is[0];
2071       } else {
2072         if (PetscDefined(USE_DEBUG)) PetscCall(PCHPDDMCheckInclusion_Private(pc, data->is, loc, PETSC_TRUE));
2073         if (overlap == -1) PetscCall(PetscObjectComposeFunction((PetscObject)pc->pmat, "PCHPDDMAlgebraicAuxiliaryMat_Private_C", PCHPDDMAlgebraicAuxiliaryMat_Private));
2074         if (!PetscBool3ToBool(data->Neumann) && (!algebraic || overlap != -1)) {
2075           PetscCall(PetscObjectTypeCompare((PetscObject)P, MATMPISBAIJ, &flg));
2076           if (flg) {
2077             /* maybe better to ISSort(is[0]), MatCreateSubMatrices(), and then MatPermute() */
2078             /* but there is no MatPermute_SeqSBAIJ(), so as before, just use MATMPIBAIJ     */
2079             PetscCall(MatConvert(P, MATMPIBAIJ, MAT_INITIAL_MATRIX, &uaux));
2080             flg = PETSC_FALSE;
2081           }
2082         }
2083       }
2084       if (algebraic && overlap == -1) {
2085         PetscUseMethod(pc->pmat, "PCHPDDMAlgebraicAuxiliaryMat_Private_C", (Mat, IS *, Mat *[], PetscBool), (P, is, &sub, block));
2086         if (block) {
2087           PetscCall(PetscObjectQuery((PetscObject)sub[0], "_PCHPDDM_Neumann_Mat", (PetscObject *)&data->aux));
2088           PetscCall(PetscObjectCompose((PetscObject)sub[0], "_PCHPDDM_Neumann_Mat", nullptr));
2089         }
2090       } else if (!uaux || overlap != -1) {
2091         if (!ctx) {
2092           if (PetscBool3ToBool(data->Neumann)) sub = &data->aux;
2093           else {
2094             PetscBool flg;
2095             if (overlap != -1) {
2096               Harmonic              h;
2097               Mat                   A0, *a;                           /* with an SVD: [ A_00  A_01       ] */
2098               IS                    ov[2], rows, cols, stride;        /*              [ A_10  A_11  A_12 ] */
2099               const PetscInt       *i[2], bs = PetscAbs(P->cmap->bs); /* with a GEVP: [ A_00  A_01       ] */
2100               PetscInt              n[2];                             /*              [ A_10  A_11  A_12 ] */
2101               std::vector<PetscInt> v[2];                             /*              [       A_21  A_22 ] */
2102 
2103               PetscCall(ISDuplicate(data->is, ov));
2104               if (overlap > 1) PetscCall(MatIncreaseOverlap(P, 1, ov, overlap - 1));
2105               PetscCall(ISDuplicate(ov[0], ov + 1));
2106               PetscCall(MatIncreaseOverlap(P, 1, ov + 1, 1));
2107               PetscCall(PetscNew(&h));
2108               h->ksp = nullptr;
2109               PetscCall(PetscCalloc1(2, &h->A));
2110               PetscCall(PetscOptionsHasName(nullptr, prefix, "-svd_nsv", &flg));
2111               if (!flg) PetscCall(PetscOptionsHasName(nullptr, prefix, "-svd_relative_threshold", &flg));
2112               PetscCall(ISSort(ov[0]));
2113               if (!flg) PetscCall(ISSort(ov[1]));
2114               PetscCall(PetscCalloc1(5, &h->is));
2115               PetscCall(MatCreateSubMatrices(uaux ? uaux : P, 1, ov + !flg, ov + 1, MAT_INITIAL_MATRIX, &a)); /* submatrix from above, either square (!flg) or rectangular (flg) */
2116               for (PetscInt j = 0; j < 2; ++j) {
2117                 PetscCall(ISGetIndices(ov[j], i + j));
2118                 PetscCall(ISGetLocalSize(ov[j], n + j));
2119               }
2120               v[1].reserve((n[1] - n[0]) / bs);
2121               for (PetscInt j = 0; j < n[1]; j += bs) { /* indices of the (2,2) block */
2122                 PetscInt location;
2123                 PetscCall(ISLocate(ov[0], i[1][j], &location));
2124                 if (location < 0) v[1].emplace_back(j / bs);
2125               }
2126               if (!flg) {
2127                 h->A[1] = a[0];
2128                 PetscCall(PetscObjectReference((PetscObject)h->A[1]));
2129                 v[0].reserve((n[0] - P->rmap->n) / bs);
2130                 for (PetscInt j = 0; j < n[1]; j += bs) { /* row indices of the (1,2) block */
2131                   PetscInt location;
2132                   PetscCall(ISLocate(loc, i[1][j], &location));
2133                   if (location < 0) {
2134                     PetscCall(ISLocate(ov[0], i[1][j], &location));
2135                     if (location >= 0) v[0].emplace_back(j / bs);
2136                   }
2137                 }
2138                 PetscCall(ISCreateBlock(PETSC_COMM_SELF, bs, v[0].size(), v[0].data(), PETSC_USE_POINTER, &rows));
2139                 PetscCall(ISCreateBlock(PETSC_COMM_SELF, bs, v[1].size(), v[1].data(), PETSC_COPY_VALUES, h->is + 4));
2140                 PetscCall(MatCreateSubMatrix(a[0], rows, h->is[4], MAT_INITIAL_MATRIX, h->A)); /* A_12 submatrix from above */
2141                 PetscCall(ISDestroy(&rows));
2142                 if (uaux) PetscCall(MatConvert(a[0], MATSEQSBAIJ, MAT_INPLACE_MATRIX, a)); /* initial Pmat was MATSBAIJ, convert back to the same format since the rectangular A_12 submatrix has been created */
2143                 PetscCall(ISEmbed(ov[0], ov[1], PETSC_TRUE, &rows));
2144                 PetscCall(MatCreateSubMatrix(a[0], rows, cols = rows, MAT_INITIAL_MATRIX, &A0)); /* [ A_00  A_01 ; A_10  A_11 ] submatrix from above */
2145                 PetscCall(ISDestroy(&rows));
2146                 v[0].clear();
2147                 PetscCall(ISEmbed(loc, ov[1], PETSC_TRUE, h->is + 3));
2148                 PetscCall(ISEmbed(data->is, ov[1], PETSC_TRUE, h->is + 2));
2149               }
2150               v[0].reserve((n[0] - P->rmap->n) / bs);
2151               for (PetscInt j = 0; j < n[0]; j += bs) {
2152                 PetscInt location;
2153                 PetscCall(ISLocate(loc, i[0][j], &location));
2154                 if (location < 0) v[0].emplace_back(j / bs);
2155               }
2156               PetscCall(ISCreateBlock(PETSC_COMM_SELF, bs, v[0].size(), v[0].data(), PETSC_USE_POINTER, &rows));
2157               for (PetscInt j = 0; j < 2; ++j) PetscCall(ISRestoreIndices(ov[j], i + j));
2158               if (flg) {
2159                 IS is;
2160                 PetscCall(ISCreateStride(PETSC_COMM_SELF, a[0]->rmap->n, 0, 1, &is));
2161                 PetscCall(ISEmbed(ov[0], ov[1], PETSC_TRUE, &cols));
2162                 PetscCall(MatCreateSubMatrix(a[0], is, cols, MAT_INITIAL_MATRIX, &A0)); /* [ A_00  A_01 ; A_10  A_11 ] submatrix from above */
2163                 PetscCall(ISDestroy(&cols));
2164                 PetscCall(ISDestroy(&is));
2165                 if (uaux) PetscCall(MatConvert(A0, MATSEQSBAIJ, MAT_INPLACE_MATRIX, &A0)); /* initial Pmat was MATSBAIJ, convert back to the same format since this submatrix is square */
2166                 PetscCall(ISEmbed(loc, data->is, PETSC_TRUE, h->is + 2));
2167                 PetscCall(ISCreateBlock(PETSC_COMM_SELF, bs, v[1].size(), v[1].data(), PETSC_USE_POINTER, &cols));
2168                 PetscCall(MatCreateSubMatrix(a[0], rows, cols, MAT_INITIAL_MATRIX, h->A)); /* A_12 submatrix from above */
2169                 PetscCall(ISDestroy(&cols));
2170               }
2171               PetscCall(ISCreateStride(PETSC_COMM_SELF, A0->rmap->n, 0, 1, &stride));
2172               PetscCall(ISEmbed(rows, stride, PETSC_TRUE, h->is));
2173               PetscCall(ISDestroy(&stride));
2174               PetscCall(ISDestroy(&rows));
2175               PetscCall(ISEmbed(loc, ov[0], PETSC_TRUE, h->is + 1));
2176               if (subdomains) {
2177                 if (!data->levels[0]->pc) {
2178                   PetscCall(PCCreate(PetscObjectComm((PetscObject)pc), &data->levels[0]->pc));
2179                   PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "%spc_hpddm_levels_1_", pcpre ? pcpre : ""));
2180                   PetscCall(PCSetOptionsPrefix(data->levels[0]->pc, prefix));
2181                   PetscCall(PCSetOperators(data->levels[0]->pc, A, P));
2182                 }
2183                 PetscCall(PCSetType(data->levels[0]->pc, PCASM));
2184                 if (!data->levels[0]->pc->setupcalled) PetscCall(PCASMSetLocalSubdomains(data->levels[0]->pc, 1, ov + !flg, &loc));
2185                 PetscCall(PCHPDDMCommunicationAvoidingPCASM_Private(data->levels[0]->pc, flg ? A0 : a[0], PETSC_TRUE));
2186                 if (!flg) ++overlap;
2187                 if (data->share) {
2188                   PetscInt n = -1;
2189                   PetscTryMethod(data->levels[0]->pc, "PCASMGetSubKSP_C", (PC, PetscInt *, PetscInt *, KSP **), (data->levels[0]->pc, &n, nullptr, &ksp));
2190                   PetscCheck(n == 1, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of subdomain solver %" PetscInt_FMT " != 1", n);
2191                   if (flg) {
2192                     h->ksp = ksp[0];
2193                     PetscCall(PetscObjectReference((PetscObject)h->ksp));
2194                   }
2195                 }
2196               }
2197               if (!h->ksp) {
2198                 PetscBool share = data->share;
2199                 PetscCall(KSPCreate(PETSC_COMM_SELF, &h->ksp));
2200                 PetscCall(KSPSetType(h->ksp, KSPPREONLY));
2201                 PetscCall(KSPSetOperators(h->ksp, A0, A0));
2202                 do {
2203                   if (!data->share) {
2204                     share = PETSC_FALSE;
2205                     PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "%spc_hpddm_levels_1_%s", pcpre ? pcpre : "", flg ? "svd_" : "eps_"));
2206                     PetscCall(KSPSetOptionsPrefix(h->ksp, prefix));
2207                     PetscCall(KSPSetFromOptions(h->ksp));
2208                   } else {
2209                     MatSolverType type;
2210                     PetscCall(KSPGetPC(ksp[0], &pc));
2211                     PetscCall(PetscObjectTypeCompareAny((PetscObject)pc, &data->share, PCLU, PCCHOLESKY, ""));
2212                     if (data->share) {
2213                       PetscCall(PCFactorGetMatSolverType(pc, &type));
2214                       if (!type) {
2215                         if (PetscDefined(HAVE_MUMPS)) PetscCall(PCFactorSetMatSolverType(pc, MATSOLVERMUMPS));
2216                         else if (PetscDefined(HAVE_MKL_PARDISO)) PetscCall(PCFactorSetMatSolverType(pc, MATSOLVERMKL_PARDISO));
2217                         else data->share = PETSC_FALSE;
2218                         if (data->share) PetscCall(PCSetFromOptions(pc));
2219                       } else {
2220                         PetscCall(PetscStrcmp(type, MATSOLVERMUMPS, &data->share));
2221                         if (!data->share) PetscCall(PetscStrcmp(type, MATSOLVERMKL_PARDISO, &data->share));
2222                       }
2223                       if (data->share) {
2224                         std::tuple<KSP, IS, Vec[2]> *p;
2225                         PetscCall(PCFactorGetMatrix(pc, &A));
2226                         PetscCall(MatFactorSetSchurIS(A, h->is[4]));
2227                         PetscCall(KSPSetUp(ksp[0]));
2228                         PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "%spc_hpddm_levels_1_eps_shell_", pcpre ? pcpre : ""));
2229                         PetscCall(KSPSetOptionsPrefix(h->ksp, prefix));
2230                         PetscCall(KSPSetFromOptions(h->ksp));
2231                         PetscCall(KSPGetPC(h->ksp, &pc));
2232                         PetscCall(PCSetType(pc, PCSHELL));
2233                         PetscCall(PetscNew(&p));
2234                         std::get<0>(*p) = ksp[0];
2235                         PetscCall(ISEmbed(ov[0], ov[1], PETSC_TRUE, &std::get<1>(*p)));
2236                         PetscCall(MatCreateVecs(A, std::get<2>(*p), std::get<2>(*p) + 1));
2237                         PetscCall(PCShellSetContext(pc, p));
2238                         PetscCall(PCShellSetApply(pc, PCApply_Schur));
2239                         PetscCall(PCShellSetApplyTranspose(pc, PCApply_Schur<Vec, true>));
2240                         PetscCall(PCShellSetMatApply(pc, PCApply_Schur<Mat>));
2241                         PetscCall(PCShellSetDestroy(pc, PCDestroy_Schur));
2242                       }
2243                     }
2244                     if (!data->share) PetscCall(PetscInfo(pc, "Cannot share subdomain KSP between SLEPc and PETSc since neither MUMPS nor MKL PARDISO is used\n"));
2245                   }
2246                 } while (!share != !data->share); /* if data->share is initially PETSC_TRUE, but then reset to PETSC_FALSE, then go back to the beginning of the do loop */
2247               }
2248               PetscCall(ISDestroy(ov));
2249               PetscCall(ISDestroy(ov + 1));
2250               if (overlap == 1 && subdomains && flg) {
2251                 *subA = A0;
2252                 sub   = subA;
2253                 if (uaux) PetscCall(MatDestroy(&uaux));
2254               } else PetscCall(MatDestroy(&A0));
2255               PetscCall(MatCreateShell(PETSC_COMM_SELF, P->rmap->n, n[1] - n[0], P->rmap->n, n[1] - n[0], h, &data->aux));
2256               PetscCall(KSPSetErrorIfNotConverged(h->ksp, PETSC_TRUE)); /* bail out as early as possible to avoid (apparently) unrelated error messages */
2257               PetscCall(MatCreateVecs(h->ksp->pc->pmat, &h->v, nullptr));
2258               PetscCall(MatShellSetOperation(data->aux, MATOP_MULT, (void (*)(void))MatMult_Harmonic));
2259               PetscCall(MatShellSetOperation(data->aux, MATOP_MULT_TRANSPOSE, (void (*)(void))MatMultTranspose_Harmonic));
2260               PetscCall(MatShellSetMatProductOperation(data->aux, MATPRODUCT_AB, nullptr, MatProduct_AB_Harmonic, nullptr, MATDENSE, MATDENSE));
2261               PetscCall(MatShellSetOperation(data->aux, MATOP_DESTROY, (void (*)(void))MatDestroy_Harmonic));
2262               PetscCall(MatDestroySubMatrices(1, &a));
2263             }
2264             if (overlap != 1 || !subdomains) {
2265               PetscCall(MatCreateSubMatrices(uaux ? uaux : P, 1, is, is, MAT_INITIAL_MATRIX, &sub));
2266               if (ismatis) {
2267                 PetscCall(MatISGetLocalMat(C, &N));
2268                 PetscCall(PetscObjectTypeCompare((PetscObject)N, MATSEQSBAIJ, &flg));
2269                 if (flg) PetscCall(MatConvert(sub[0], MATSEQSBAIJ, MAT_INPLACE_MATRIX, sub));
2270                 PetscCall(MatISRestoreLocalMat(C, &N));
2271               }
2272             }
2273             if (uaux) {
2274               PetscCall(MatDestroy(&uaux));
2275               PetscCall(MatConvert(sub[0], MATSEQSBAIJ, MAT_INPLACE_MATRIX, sub));
2276             }
2277           }
2278         }
2279       } else {
2280         PetscCall(MatCreateSubMatrices(uaux, 1, is, is, MAT_INITIAL_MATRIX, &sub));
2281         PetscCall(MatDestroy(&uaux));
2282         PetscCall(MatConvert(sub[0], MATSEQSBAIJ, MAT_INPLACE_MATRIX, sub));
2283       }
2284       /* Vec holding the partition of unity */
2285       if (!data->levels[0]->D) {
2286         PetscCall(ISGetLocalSize(data->is, &n));
2287         PetscCall(VecCreateMPI(PETSC_COMM_SELF, n, PETSC_DETERMINE, &data->levels[0]->D));
2288       }
2289       if (data->share && overlap == -1) {
2290         Mat      D;
2291         IS       perm = nullptr;
2292         PetscInt size = -1;
2293 
2294         if (!data->levels[0]->pc) {
2295           PetscCall(PetscSNPrintf(prefix, sizeof(prefix), "%spc_hpddm_levels_1_", pcpre ? pcpre : ""));
2296           PetscCall(PCCreate(PetscObjectComm((PetscObject)pc), &data->levels[0]->pc));
2297           PetscCall(PCSetOptionsPrefix(data->levels[0]->pc, prefix));
2298           PetscCall(PCSetOperators(data->levels[0]->pc, A, P));
2299         }
2300         PetscCall(PCSetType(data->levels[0]->pc, PCASM));
2301         if (!ctx) {
2302           if (!data->levels[0]->pc->setupcalled) {
2303             IS sorted; /* PCASM will sort the input IS, duplicate it to return an unmodified (PCHPDDM) input IS */
2304             PetscCall(ISDuplicate(is[0], &sorted));
2305             PetscCall(PCASMSetLocalSubdomains(data->levels[0]->pc, 1, &sorted, &loc));
2306             PetscCall(PetscObjectDereference((PetscObject)sorted));
2307           }
2308           PetscCall(PCSetFromOptions(data->levels[0]->pc));
2309           if (block) {
2310             PetscCall(PCHPDDMPermute_Private(unsorted, data->is, &uis, sub[0], &C, &perm));
2311             PetscCall(PCHPDDMCommunicationAvoidingPCASM_Private(data->levels[0]->pc, C, algebraic));
2312           } else PetscCall(PCSetUp(data->levels[0]->pc));
2313           PetscTryMethod(data->levels[0]->pc, "PCASMGetSubKSP_C", (PC, PetscInt *, PetscInt *, KSP **), (data->levels[0]->pc, &size, nullptr, &ksp));
2314           if (size != 1) {
2315             data->share = PETSC_FALSE;
2316             PetscCheck(size == -1, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of subdomain solver %" PetscInt_FMT " != 1", size);
2317             PetscCall(PetscInfo(pc, "Cannot share subdomain KSP between SLEPc and PETSc since PCASMGetSubKSP() not found in fine-level PC\n"));
2318             PetscCall(ISDestroy(&unsorted));
2319             unsorted = is[0];
2320           } else {
2321             const char *matpre;
2322             PetscBool   cmp[4];
2323 
2324             if (!block && !ctx) PetscCall(PCHPDDMPermute_Private(unsorted, data->is, &uis, PetscBool3ToBool(data->Neumann) ? sub[0] : data->aux, &C, &perm));
2325             if (!PetscBool3ToBool(data->Neumann) && !block) {
2326               PetscCall(MatPermute(sub[0], perm, perm, &D)); /* permute since PCASM will call ISSort() */
2327               PetscCall(MatHeaderReplace(sub[0], &D));
2328             }
2329             if (data->B) { /* see PCHPDDMSetRHSMat() */
2330               PetscCall(MatPermute(data->B, perm, perm, &D));
2331               PetscCall(MatHeaderReplace(data->B, &D));
2332             }
2333             PetscCall(ISDestroy(&perm));
2334             PetscCall(KSPGetOperators(ksp[0], subA, subA + 1));
2335             PetscCall(PetscObjectReference((PetscObject)subA[0]));
2336             PetscCall(MatDuplicate(subA[1], MAT_SHARE_NONZERO_PATTERN, &D));
2337             PetscCall(MatGetOptionsPrefix(subA[1], &matpre));
2338             PetscCall(MatSetOptionsPrefix(D, matpre));
2339             PetscCall(PetscObjectTypeCompare((PetscObject)D, MATNORMAL, cmp));
2340             PetscCall(PetscObjectTypeCompare((PetscObject)C, MATNORMAL, cmp + 1));
2341             if (!cmp[0]) PetscCall(PetscObjectTypeCompare((PetscObject)D, MATNORMALHERMITIAN, cmp + 2));
2342             else cmp[2] = PETSC_FALSE;
2343             if (!cmp[1]) PetscCall(PetscObjectTypeCompare((PetscObject)C, MATNORMALHERMITIAN, cmp + 3));
2344             else cmp[3] = PETSC_FALSE;
2345             PetscCheck(cmp[0] == cmp[1] && cmp[2] == cmp[3], PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "-%spc_hpddm_levels_1_pc_asm_sub_mat_type %s and auxiliary Mat of type %s", pcpre ? pcpre : "", ((PetscObject)D)->type_name, ((PetscObject)C)->type_name);
2346             if (!cmp[0] && !cmp[2]) {
2347               if (!block) PetscCall(MatAXPY(D, 1.0, C, SUBSET_NONZERO_PATTERN));
2348               else {
2349                 PetscCall(MatMissingDiagonal(D, cmp, nullptr));
2350                 if (cmp[0]) structure = DIFFERENT_NONZERO_PATTERN; /* data->aux has no missing diagonal entry */
2351                 PetscCall(MatAXPY(D, 1.0, data->aux, structure));
2352               }
2353             } else {
2354               Mat mat[2];
2355 
2356               if (cmp[0]) {
2357                 PetscCall(MatNormalGetMat(D, mat));
2358                 PetscCall(MatNormalGetMat(C, mat + 1));
2359               } else {
2360                 PetscCall(MatNormalHermitianGetMat(D, mat));
2361                 PetscCall(MatNormalHermitianGetMat(C, mat + 1));
2362               }
2363               PetscCall(MatAXPY(mat[0], 1.0, mat[1], SUBSET_NONZERO_PATTERN));
2364             }
2365             PetscCall(MatPropagateSymmetryOptions(C, D));
2366             PetscCall(MatDestroy(&C));
2367             C = D;
2368             /* swap pointers so that variables stay consistent throughout PCSetUp() */
2369             std::swap(C, data->aux);
2370             std::swap(uis, data->is);
2371             swap = PETSC_TRUE;
2372           }
2373         }
2374       }
2375       if (ctx) {
2376         PC_HPDDM              *data_00 = (PC_HPDDM *)std::get<0>(*ctx)[0]->data;
2377         PC                     s;
2378         Mat                    A00, P00, A01 = nullptr, A10, A11, N, b[4];
2379         IS                     sorted, is[2], *is_00;
2380         MatSolverType          type;
2381         std::pair<PC, Vec[2]> *p;
2382 
2383         n = -1;
2384         PetscTryMethod(data_00->levels[0]->pc, "PCASMGetSubKSP_C", (PC, PetscInt *, PetscInt *, KSP **), (data_00->levels[0]->pc, &n, nullptr, &ksp));
2385         PetscCheck(n == 1, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of subdomain solver %" PetscInt_FMT " != 1", n);
2386         PetscCall(KSPGetOperators(ksp[0], subA, subA + 1));
2387         PetscCall(ISGetLocalSize(data_00->is, &n));
2388         if (n != subA[0]->rmap->n || n != subA[0]->cmap->n) {
2389           PetscCall(PCASMGetLocalSubdomains(data_00->levels[0]->pc, &n, &is_00, nullptr));
2390           PetscCall(ISGetLocalSize(*is_00, &n));
2391           PetscCheck(n == subA[0]->rmap->n && n == subA[0]->cmap->n, PETSC_COMM_SELF, PETSC_ERR_ARG_INCOMP, "-%spc_hpddm_schur_precondition geneo and -%spc_hpddm_define_subdomains false", pcpre ? pcpre : "", ((PetscObject)pc)->prefix);
2392         } else is_00 = &data_00->is;
2393         PetscCall(PCHPDDMPermute_Private(unsorted, data->is, &uis, data->aux, &C, nullptr)); /* permute since PCASM works with a sorted IS */
2394         std::swap(C, data->aux);
2395         std::swap(uis, data->is);
2396         swap = PETSC_TRUE;
2397         PetscCall(PCASMSetType(data->levels[0]->pc, PC_ASM_NONE)); /* "Neumann--Neumann" preconditioning with overlap and a Boolean partition of unity */
2398         PetscCall(PCASMSetLocalSubdomains(data->levels[0]->pc, 1, &data->is, &loc));
2399         PetscCall(PCSetFromOptions(data->levels[0]->pc)); /* action of eq. (15) of https://hal.science/hal-02343808v6/document (with a sign flip) */
2400         PetscCall(MatSchurComplementGetSubMatrices(P, &A00, &P00, std::get<1>(*ctx), &A10, &A11));
2401         std::get<1>(*ctx)[1] = A10;
2402         PetscCall(PetscObjectTypeCompare((PetscObject)A10, MATTRANSPOSEVIRTUAL, &flg));
2403         if (flg) PetscCall(MatTransposeGetMat(A10, &A01));
2404         else {
2405           PetscBool flg;
2406 
2407           PetscCall(PetscObjectTypeCompare((PetscObject)A10, MATHERMITIANTRANSPOSEVIRTUAL, &flg));
2408           if (flg) PetscCall(MatHermitianTransposeGetMat(A10, &A01));
2409         }
2410         PetscCall(ISDuplicate(*is_00, &sorted)); /* during setup of the PC associated to the A00 block, this IS has already been sorted, but it's put back to its original state at the end of PCSetUp_HPDDM(), which may be unsorted */
2411         PetscCall(ISSort(sorted));               /* this is to avoid changing users inputs, but it requires a new call to ISSort() here                                                                                               */
2412         if (!A01) {
2413           PetscCall(MatSetOption(A10, MAT_SUBMAT_SINGLEIS, PETSC_TRUE));
2414           PetscCall(MatCreateSubMatrices(A10, 1, &data->is, &sorted, MAT_INITIAL_MATRIX, &sub));
2415           b[2] = sub[0];
2416           PetscCall(PetscObjectReference((PetscObject)sub[0]));
2417           PetscCall(MatDestroySubMatrices(1, &sub));
2418           PetscCall(PetscObjectTypeCompare((PetscObject)std::get<1>(*ctx)[0], MATTRANSPOSEVIRTUAL, &flg));
2419           A10 = nullptr;
2420           if (flg) PetscCall(MatTransposeGetMat(std::get<1>(*ctx)[0], &A10));
2421           else {
2422             PetscBool flg;
2423 
2424             PetscCall(PetscObjectTypeCompare((PetscObject)std::get<1>(*ctx)[0], MATHERMITIANTRANSPOSEVIRTUAL, &flg));
2425             if (flg) PetscCall(MatHermitianTransposeGetMat(std::get<1>(*ctx)[0], &A10));
2426           }
2427           if (!A10) PetscCall(MatCreateSubMatrices(std::get<1>(*ctx)[0], 1, &sorted, &data->is, MAT_INITIAL_MATRIX, &sub));
2428           else {
2429             if (flg) PetscCall(MatCreateTranspose(b[2], b + 1));
2430             else PetscCall(MatCreateHermitianTranspose(b[2], b + 1));
2431           }
2432         } else {
2433           PetscCall(MatSetOption(A01, MAT_SUBMAT_SINGLEIS, PETSC_TRUE));
2434           PetscCall(MatCreateSubMatrices(A01, 1, &sorted, &data->is, MAT_INITIAL_MATRIX, &sub));
2435           if (flg) PetscCall(MatCreateTranspose(*sub, b + 2));
2436           else PetscCall(MatCreateHermitianTranspose(*sub, b + 2));
2437         }
2438         if (A01 || !A10) {
2439           b[1] = sub[0];
2440           PetscCall(PetscObjectReference((PetscObject)sub[0]));
2441         }
2442         PetscCall(MatDestroySubMatrices(1, &sub));
2443         PetscCall(ISDestroy(&sorted));
2444         PetscCall(MatCreateSchurComplement(subA[0], subA[1], b[1], b[2], data->aux, &S));
2445         PetscCall(MatSchurComplementSetKSP(S, ksp[0]));
2446         PetscCall(PCHPDDMCommunicationAvoidingPCASM_Private(data->levels[0]->pc, S, PETSC_TRUE)); /* the subdomain Mat is already known and the input IS of PCASMSetLocalSubdomains() is already sorted */
2447         PetscTryMethod(data->levels[0]->pc, "PCASMGetSubKSP_C", (PC, PetscInt *, PetscInt *, KSP **), (data->levels[0]->pc, &n, nullptr, &ksp));
2448         PetscCheck(n == 1, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Number of subdomain solver %" PetscInt_FMT " != 1", n);
2449         PetscCall(KSPGetPC(ksp[0], &inner));
2450         PetscCall(PCSetType(inner, PCSHELL)); /* compute the action of the inverse of the local Schur complement with a PCSHELL */
2451         b[0] = subA[0];
2452         b[3] = data->aux;
2453         PetscCall(MatCreateNest(PETSC_COMM_SELF, 2, nullptr, 2, nullptr, b, &N)); /* instead of computing inv(A11 - A10 inv(A00) A01), compute inv([A00, A01; A10, A11]) followed by a partial solution associated to the A11 block */
2454         PetscCall(PetscObjectDereference((PetscObject)b[1]));
2455         PetscCall(PetscObjectDereference((PetscObject)b[2]));
2456         PetscCall(PCCreate(PETSC_COMM_SELF, &s));
2457         PetscCall(PCSetOptionsPrefix(s, ((PetscObject)inner)->prefix));
2458         PetscCall(PCSetOptionsPrefix(inner, nullptr));
2459         PetscCall(KSPSetSkipPCSetFromOptions(ksp[0], PETSC_TRUE));
2460         PetscCall(PCSetType(s, PCLU));
2461         if (PetscDefined(HAVE_MUMPS)) { /* only MATSOLVERMUMPS handles MATNEST, so for the others, e.g., MATSOLVERPETSC or MATSOLVERMKL_PARDISO, convert to plain MATAIJ */
2462           PetscCall(PCFactorSetMatSolverType(s, MATSOLVERMUMPS));
2463         }
2464         PetscCall(PCSetFromOptions(s));
2465         PetscCall(PCFactorGetMatSolverType(s, &type));
2466         PetscCall(PetscStrcmp(type, MATSOLVERMUMPS, &flg));
2467         if (flg) {
2468           PetscCall(PCSetOperators(s, N, N));
2469           PetscCall(PCFactorGetMatrix(s, b));
2470           PetscCall(MatSetOptionsPrefix(*b, ((PetscObject)s)->prefix));
2471           n = -1;
2472           PetscCall(PetscOptionsGetInt(nullptr, ((PetscObject)s)->prefix, "-mat_mumps_icntl_26", &n, nullptr));
2473           if (n == 1) {                                /* allocates a square MatDense of size is[1]->map->n, so one */
2474             PetscCall(MatNestGetISs(N, is, nullptr));  /*  needs to be able to deactivate this path when dealing    */
2475             PetscCall(MatFactorSetSchurIS(*b, is[1])); /*  with a large constraint space in order to avoid OOM      */
2476           }
2477         } else {
2478           PetscCall(MatConvert(N, MATAIJ, MAT_INITIAL_MATRIX, b));
2479           PetscCall(PCSetOperators(s, N, *b));
2480           PetscCall(PetscObjectDereference((PetscObject)*b));
2481           PetscCall(PCFactorGetMatrix(s, b)); /* MATSOLVERMKL_PARDISO cannot compute in PETSc (yet) a partial solution associated to the A11 block, only partial solution associated to the A00 block or full solution */
2482         }
2483         PetscCall(PetscNew(&p));
2484         p->first = s;
2485         PetscCall(MatCreateVecs(*b, p->second, p->second + 1));
2486         PetscCall(PCShellSetContext(inner, p));
2487         PetscCall(PCShellSetApply(inner, PCApply_Nest));
2488         PetscCall(PCShellSetView(inner, PCView_Nest));
2489         PetscCall(PCShellSetDestroy(inner, PCDestroy_Nest));
2490         PetscCall(PetscObjectDereference((PetscObject)N));
2491       }
2492       if (!data->levels[0]->scatter) {
2493         PetscCall(MatCreateVecs(P, &xin, nullptr));
2494         if (ismatis) PetscCall(MatDestroy(&P));
2495         PetscCall(VecScatterCreate(xin, data->is, data->levels[0]->D, nullptr, &data->levels[0]->scatter));
2496         PetscCall(VecDestroy(&xin));
2497       }
2498       if (data->levels[0]->P) {
2499         /* if the pattern is the same and PCSetUp() has previously succeeded, reuse HPDDM buffers and connectivity */
2500         PetscCall(HPDDM::Schwarz<PetscScalar>::destroy(data->levels[0], pc->setupcalled < 1 || pc->flag == DIFFERENT_NONZERO_PATTERN ? PETSC_TRUE : PETSC_FALSE));
2501       }
2502       if (!data->levels[0]->P) data->levels[0]->P = new HPDDM::Schwarz<PetscScalar>();
2503       if (data->log_separate) PetscCall(PetscLogEventBegin(PC_HPDDM_SetUp[0], data->levels[0]->ksp, nullptr, nullptr, nullptr));
2504       else PetscCall(PetscLogEventBegin(PC_HPDDM_Strc, data->levels[0]->ksp, nullptr, nullptr, nullptr));
2505       /* HPDDM internal data structure */
2506       PetscCall(data->levels[0]->P->structure(loc, data->is, !ctx ? sub[0] : nullptr, ismatis ? C : data->aux, data->levels));
2507       if (!data->log_separate) PetscCall(PetscLogEventEnd(PC_HPDDM_Strc, data->levels[0]->ksp, nullptr, nullptr, nullptr));
2508       /* matrix pencil of the generalized eigenvalue problem on the overlap (GenEO) */
2509       if (!ctx) {
2510         if (data->deflation || overlap != -1) weighted = data->aux;
2511         else if (!data->B) {
2512           PetscBool cmp;
2513 
2514           PetscCall(MatDuplicate(sub[0], MAT_COPY_VALUES, &weighted));
2515           PetscCall(PetscObjectTypeCompareAny((PetscObject)weighted, &cmp, MATNORMAL, MATNORMALHERMITIAN, ""));
2516           if (cmp) flg = PETSC_FALSE;
2517           PetscCall(MatDiagonalScale(weighted, data->levels[0]->D, data->levels[0]->D));
2518           /* neither MatDuplicate() nor MatDiagonalScale() handles the symmetry options, so propagate the options explicitly */
2519           /* only useful for -mat_type baij -pc_hpddm_levels_1_st_pc_type cholesky (no problem with MATAIJ or MATSBAIJ)      */
2520           PetscCall(MatPropagateSymmetryOptions(sub[0], weighted));
2521         } else weighted = data->B;
2522       } else weighted = nullptr;
2523       /* SLEPc is used inside the loaded symbol */
2524       PetscCall((*loadedSym)(data->levels[0]->P, data->is, ismatis ? C : (algebraic && !block && overlap == -1 ? sub[0] : (!ctx ? data->aux : S)), weighted, data->B, initial, data->levels));
2525       if (!ctx && data->share && overlap == -1) {
2526         Mat st[2];
2527         PetscCall(KSPGetOperators(ksp[0], st, st + 1));
2528         PetscCall(MatCopy(subA[0], st[0], structure));
2529         if (subA[1] != subA[0] || st[1] != st[0]) PetscCall(MatCopy(subA[1], st[1], SAME_NONZERO_PATTERN));
2530         PetscCall(PetscObjectDereference((PetscObject)subA[0]));
2531       }
2532       if (data->log_separate) PetscCall(PetscLogEventEnd(PC_HPDDM_SetUp[0], data->levels[0]->ksp, nullptr, nullptr, nullptr));
2533       if (ismatis) PetscCall(MatISGetLocalMat(C, &N));
2534       else N = data->aux;
2535       if (!ctx) P = sub[0];
2536       else P = S;
2537       /* going through the grid hierarchy */
2538       for (n = 1; n < data->N; ++n) {
2539         if (data->log_separate) PetscCall(PetscLogEventBegin(PC_HPDDM_SetUp[n], data->levels[n]->ksp, nullptr, nullptr, nullptr));
2540         /* method composed in the loaded symbol since there, SLEPc is used as well */
2541         PetscTryMethod(data->levels[0]->ksp, "PCHPDDMSetUp_Private_C", (Mat *, Mat *, PetscInt, PetscInt *const, PC_HPDDM_Level **const), (&P, &N, n, &data->N, data->levels));
2542         if (data->log_separate) PetscCall(PetscLogEventEnd(PC_HPDDM_SetUp[n], data->levels[n]->ksp, nullptr, nullptr, nullptr));
2543       }
2544       /* reset to NULL to avoid any faulty use */
2545       PetscCall(PetscObjectComposeFunction((PetscObject)data->levels[0]->ksp, "PCHPDDMSetUp_Private_C", nullptr));
2546       if (!ismatis) PetscCall(PetscObjectComposeFunction((PetscObject)pc->pmat, "PCHPDDMAlgebraicAuxiliaryMat_C", nullptr));
2547       else PetscCall(PetscObjectDereference((PetscObject)C)); /* matching PetscObjectReference() above */
2548       for (n = 0; n < data->N - 1; ++n)
2549         if (data->levels[n]->P) {
2550           /* HPDDM internal work buffers */
2551           data->levels[n]->P->setBuffer();
2552           data->levels[n]->P->super::start();
2553         }
2554       if (ismatis || !subdomains) PetscCall(PCHPDDMDestroySubMatrices_Private(PetscBool3ToBool(data->Neumann), PetscBool(algebraic && !block && overlap == -1), sub));
2555       if (ismatis) data->is = nullptr;
2556       for (n = 0; n < data->N - 1 + (reused > 0); ++n) {
2557         if (data->levels[n]->P) {
2558           PC spc;
2559 
2560           /* force the PC to be PCSHELL to do the coarse grid corrections */
2561           PetscCall(KSPSetSkipPCSetFromOptions(data->levels[n]->ksp, PETSC_TRUE));
2562           PetscCall(KSPGetPC(data->levels[n]->ksp, &spc));
2563           PetscCall(PCSetType(spc, PCSHELL));
2564           PetscCall(PCShellSetContext(spc, data->levels[n]));
2565           PetscCall(PCShellSetSetUp(spc, PCSetUp_HPDDMShell));
2566           PetscCall(PCShellSetApply(spc, PCApply_HPDDMShell));
2567           PetscCall(PCShellSetMatApply(spc, PCMatApply_HPDDMShell));
2568           if (ctx && n == 0) {
2569             Mat                               Amat, Pmat;
2570             PetscInt                          m, M;
2571             std::tuple<Mat, PetscSF, Vec[2]> *ctx;
2572 
2573             PetscCall(KSPGetOperators(data->levels[n]->ksp, nullptr, &Pmat));
2574             PetscCall(MatGetLocalSize(Pmat, &m, nullptr));
2575             PetscCall(MatGetSize(Pmat, &M, nullptr));
2576             PetscCall(PetscNew(&ctx));
2577             std::get<0>(*ctx) = S;
2578             std::get<1>(*ctx) = data->levels[n]->scatter;
2579             PetscCall(MatCreateShell(PetscObjectComm((PetscObject)data->levels[n]->ksp), m, m, M, M, ctx, &Amat));
2580             PetscCall(MatShellSetOperation(Amat, MATOP_MULT, (void (*)(void))MatMult_Schur<false>));
2581             PetscCall(MatShellSetOperation(Amat, MATOP_MULT_TRANSPOSE, (void (*)(void))MatMult_Schur<true>));
2582             PetscCall(MatShellSetOperation(Amat, MATOP_DESTROY, (void (*)(void))MatDestroy_Schur));
2583             PetscCall(MatCreateVecs(S, std::get<2>(*ctx), std::get<2>(*ctx) + 1));
2584             PetscCall(KSPSetOperators(data->levels[n]->ksp, Amat, Pmat));
2585             PetscCall(PetscObjectDereference((PetscObject)Amat));
2586           }
2587           PetscCall(PCShellSetDestroy(spc, PCDestroy_HPDDMShell));
2588           if (!data->levels[n]->pc) PetscCall(PCCreate(PetscObjectComm((PetscObject)data->levels[n]->ksp), &data->levels[n]->pc));
2589           if (n < reused) {
2590             PetscCall(PCSetReusePreconditioner(spc, PETSC_TRUE));
2591             PetscCall(PCSetReusePreconditioner(data->levels[n]->pc, PETSC_TRUE));
2592           }
2593           PetscCall(PCSetUp(spc));
2594         }
2595       }
2596       if (ctx) PetscCall(MatDestroy(&S));
2597       if (overlap == -1) PetscCall(PetscObjectComposeFunction((PetscObject)pc->pmat, "PCHPDDMAlgebraicAuxiliaryMat_Private_C", nullptr));
2598     } else flg = reused ? PETSC_FALSE : PETSC_TRUE;
2599     if (!ismatis && subdomains) {
2600       if (flg) PetscCall(KSPGetPC(data->levels[0]->ksp, &inner));
2601       else inner = data->levels[0]->pc;
2602       if (inner) {
2603         if (!inner->setupcalled) PetscCall(PCSetType(inner, PCASM));
2604         PetscCall(PCSetFromOptions(inner));
2605         PetscCall(PetscStrcmp(((PetscObject)inner)->type_name, PCASM, &flg));
2606         if (flg) {
2607           if (!inner->setupcalled) { /* evaluates to PETSC_FALSE when -pc_hpddm_block_splitting */
2608             IS sorted;               /* PCASM will sort the input IS, duplicate it to return an unmodified (PCHPDDM) input IS */
2609 
2610             PetscCall(ISDuplicate(is[0], &sorted));
2611             PetscCall(PCASMSetLocalSubdomains(inner, 1, &sorted, &loc));
2612             PetscCall(PetscObjectDereference((PetscObject)sorted));
2613           }
2614           if (!PetscBool3ToBool(data->Neumann) && data->N > 1) { /* subdomain matrices are already created for the eigenproblem, reuse them for the fine-level PC */
2615             PetscCall(PCHPDDMPermute_Private(*is, nullptr, nullptr, sub[0], &P, nullptr));
2616             PetscCall(PCHPDDMCommunicationAvoidingPCASM_Private(inner, P, algebraic));
2617             PetscCall(PetscObjectDereference((PetscObject)P));
2618           }
2619         }
2620       }
2621       if (data->N > 1) {
2622         if (overlap != 1) PetscCall(PCHPDDMDestroySubMatrices_Private(PetscBool3ToBool(data->Neumann), PetscBool(algebraic && !block && overlap == -1), sub));
2623         if (overlap == 1) PetscCall(MatDestroy(subA));
2624       }
2625     }
2626     PetscCall(ISDestroy(&loc));
2627   } else data->N = 1 + reused; /* enforce this value to 1 + reused if there is no way to build another level */
2628   if (requested != data->N + reused) {
2629     PetscCall(PetscInfo(pc, "%" PetscInt_FMT " levels requested, only %" PetscInt_FMT " built + %" PetscInt_FMT " reused. Options for level(s) > %" PetscInt_FMT ", including -%spc_hpddm_coarse_ will not be taken into account\n", requested, data->N, reused,
2630                         data->N, pcpre ? pcpre : ""));
2631     PetscCall(PetscInfo(pc, "It is best to tune parameters, e.g., a higher value for -%spc_hpddm_levels_%" PetscInt_FMT "_eps_threshold so that at least one local deflation vector will be selected\n", pcpre ? pcpre : "", data->N));
2632     /* cannot use PCDestroy_HPDDMShell() because PCSHELL not set for unassembled levels */
2633     for (n = data->N - 1; n < requested - 1; ++n) {
2634       if (data->levels[n]->P) {
2635         PetscCall(HPDDM::Schwarz<PetscScalar>::destroy(data->levels[n], PETSC_TRUE));
2636         PetscCall(VecDestroyVecs(1, &data->levels[n]->v[0]));
2637         PetscCall(VecDestroyVecs(2, &data->levels[n]->v[1]));
2638         PetscCall(MatDestroy(data->levels[n]->V));
2639         PetscCall(MatDestroy(data->levels[n]->V + 1));
2640         PetscCall(MatDestroy(data->levels[n]->V + 2));
2641         PetscCall(VecDestroy(&data->levels[n]->D));
2642         PetscCall(PetscSFDestroy(&data->levels[n]->scatter));
2643       }
2644     }
2645     if (reused) {
2646       for (n = reused; n < PETSC_PCHPDDM_MAXLEVELS && data->levels[n]; ++n) {
2647         PetscCall(KSPDestroy(&data->levels[n]->ksp));
2648         PetscCall(PCDestroy(&data->levels[n]->pc));
2649       }
2650     }
2651     PetscCheck(!PetscDefined(USE_DEBUG), PetscObjectComm((PetscObject)pc), PETSC_ERR_ARG_WRONG, "%" PetscInt_FMT " levels requested, only %" PetscInt_FMT " built + %" PetscInt_FMT " reused. Options for level(s) > %" PetscInt_FMT ", including -%spc_hpddm_coarse_ will not be taken into account. It is best to tune parameters, e.g., a higher value for -%spc_hpddm_levels_%" PetscInt_FMT "_eps_threshold so that at least one local deflation vector will be selected. If you don't want this to error out, compile --with-debugging=0", requested,
2652                data->N, reused, data->N, pcpre ? pcpre : "", pcpre ? pcpre : "", data->N);
2653   }
2654   /* these solvers are created after PCSetFromOptions() is called */
2655   if (pc->setfromoptionscalled) {
2656     for (n = 0; n < data->N; ++n) {
2657       if (data->levels[n]->ksp) PetscCall(KSPSetFromOptions(data->levels[n]->ksp));
2658       if (data->levels[n]->pc) PetscCall(PCSetFromOptions(data->levels[n]->pc));
2659     }
2660     pc->setfromoptionscalled = 0;
2661   }
2662   data->N += reused;
2663   if (data->share && swap) {
2664     /* swap back pointers so that variables follow the user-provided numbering */
2665     std::swap(C, data->aux);
2666     std::swap(uis, data->is);
2667     PetscCall(MatDestroy(&C));
2668     PetscCall(ISDestroy(&uis));
2669   }
2670   if (algebraic) PetscCall(MatDestroy(&data->aux));
2671   if (unsorted && unsorted != is[0]) {
2672     PetscCall(ISCopy(unsorted, data->is));
2673     PetscCall(ISDestroy(&unsorted));
2674   }
2675 #if PetscDefined(USE_DEBUG)
2676   PetscCheck((data->is && dis) || (!data->is && !dis), PETSC_COMM_SELF, PETSC_ERR_PLIB, "An IS pointer is NULL but not the other: input IS pointer (%p) v. output IS pointer (%p)", (void *)dis, (void *)data->is);
2677   if (data->is) {
2678     PetscCall(ISEqualUnsorted(data->is, dis, &flg));
2679     PetscCall(ISDestroy(&dis));
2680     PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Input IS and output IS are not equal");
2681   }
2682   PetscCheck((data->aux && daux) || (!data->aux && !daux), PETSC_COMM_SELF, PETSC_ERR_PLIB, "A Mat pointer is NULL but not the other: input Mat pointer (%p) v. output Mat pointer (%p)", (void *)daux, (void *)data->aux);
2683   if (data->aux) {
2684     PetscCall(MatMultEqual(data->aux, daux, 20, &flg));
2685     PetscCall(MatDestroy(&daux));
2686     PetscCheck(flg, PETSC_COMM_SELF, PETSC_ERR_PLIB, "Input Mat and output Mat are not equal");
2687   }
2688 #endif
2689   PetscFunctionReturn(PETSC_SUCCESS);
2690 }
2691 
2692 /*@
2693   PCHPDDMSetCoarseCorrectionType - Sets the coarse correction type.
2694 
2695   Collective
2696 
2697   Input Parameters:
2698 + pc   - preconditioner context
2699 - type - `PC_HPDDM_COARSE_CORRECTION_DEFLATED`, `PC_HPDDM_COARSE_CORRECTION_ADDITIVE`, `PC_HPDDM_COARSE_CORRECTION_BALANCED`, or `PC_HPDDM_COARSE_CORRECTION_NONE`
2700 
2701   Options Database Key:
2702 . -pc_hpddm_coarse_correction <deflated, additive, balanced, none> - type of coarse correction to apply
2703 
2704   Level: intermediate
2705 
2706 .seealso: [](ch_ksp), `PCHPDDMGetCoarseCorrectionType()`, `PCHPDDM`, `PCHPDDMCoarseCorrectionType`
2707 @*/
2708 PetscErrorCode PCHPDDMSetCoarseCorrectionType(PC pc, PCHPDDMCoarseCorrectionType type)
2709 {
2710   PetscFunctionBegin;
2711   PetscValidHeaderSpecific(pc, PC_CLASSID, 1);
2712   PetscValidLogicalCollectiveEnum(pc, type, 2);
2713   PetscTryMethod(pc, "PCHPDDMSetCoarseCorrectionType_C", (PC, PCHPDDMCoarseCorrectionType), (pc, type));
2714   PetscFunctionReturn(PETSC_SUCCESS);
2715 }
2716 
2717 /*@
2718   PCHPDDMGetCoarseCorrectionType - Gets the coarse correction type.
2719 
2720   Input Parameter:
2721 . pc - preconditioner context
2722 
2723   Output Parameter:
2724 . type - `PC_HPDDM_COARSE_CORRECTION_DEFLATED`, `PC_HPDDM_COARSE_CORRECTION_ADDITIVE`, `PC_HPDDM_COARSE_CORRECTION_BALANCED`, or `PC_HPDDM_COARSE_CORRECTION_NONE`
2725 
2726   Level: intermediate
2727 
2728 .seealso: [](ch_ksp), `PCHPDDMSetCoarseCorrectionType()`, `PCHPDDM`, `PCHPDDMCoarseCorrectionType`
2729 @*/
2730 PetscErrorCode PCHPDDMGetCoarseCorrectionType(PC pc, PCHPDDMCoarseCorrectionType *type)
2731 {
2732   PetscFunctionBegin;
2733   PetscValidHeaderSpecific(pc, PC_CLASSID, 1);
2734   if (type) {
2735     PetscAssertPointer(type, 2);
2736     PetscUseMethod(pc, "PCHPDDMGetCoarseCorrectionType_C", (PC, PCHPDDMCoarseCorrectionType *), (pc, type));
2737   }
2738   PetscFunctionReturn(PETSC_SUCCESS);
2739 }
2740 
2741 static PetscErrorCode PCHPDDMSetCoarseCorrectionType_HPDDM(PC pc, PCHPDDMCoarseCorrectionType type)
2742 {
2743   PC_HPDDM *data = (PC_HPDDM *)pc->data;
2744 
2745   PetscFunctionBegin;
2746   data->correction = type;
2747   PetscFunctionReturn(PETSC_SUCCESS);
2748 }
2749 
2750 static PetscErrorCode PCHPDDMGetCoarseCorrectionType_HPDDM(PC pc, PCHPDDMCoarseCorrectionType *type)
2751 {
2752   PC_HPDDM *data = (PC_HPDDM *)pc->data;
2753 
2754   PetscFunctionBegin;
2755   *type = data->correction;
2756   PetscFunctionReturn(PETSC_SUCCESS);
2757 }
2758 
2759 /*@
2760   PCHPDDMSetSTShareSubKSP - Sets whether the `KSP` in SLEPc `ST` and the fine-level subdomain solver should be shared.
2761 
2762   Input Parameters:
2763 + pc    - preconditioner context
2764 - share - whether the `KSP` should be shared or not
2765 
2766   Note:
2767   This is not the same as `PCSetReusePreconditioner()`. Given certain conditions (visible using -info), a symbolic factorization can be skipped
2768   when using a subdomain `PCType` such as `PCLU` or `PCCHOLESKY`.
2769 
2770   Level: advanced
2771 
2772 .seealso: [](ch_ksp), `PCHPDDM`, `PCHPDDMGetSTShareSubKSP()`
2773 @*/
2774 PetscErrorCode PCHPDDMSetSTShareSubKSP(PC pc, PetscBool share)
2775 {
2776   PetscFunctionBegin;
2777   PetscValidHeaderSpecific(pc, PC_CLASSID, 1);
2778   PetscTryMethod(pc, "PCHPDDMSetSTShareSubKSP_C", (PC, PetscBool), (pc, share));
2779   PetscFunctionReturn(PETSC_SUCCESS);
2780 }
2781 
2782 /*@
2783   PCHPDDMGetSTShareSubKSP - Gets whether the `KSP` in SLEPc `ST` and the fine-level subdomain solver is shared.
2784 
2785   Input Parameter:
2786 . pc - preconditioner context
2787 
2788   Output Parameter:
2789 . share - whether the `KSP` is shared or not
2790 
2791   Note:
2792   This is not the same as `PCGetReusePreconditioner()`. The return value is unlikely to be true, but when it is, a symbolic factorization can be skipped
2793   when using a subdomain `PCType` such as `PCLU` or `PCCHOLESKY`.
2794 
2795   Level: advanced
2796 
2797 .seealso: [](ch_ksp), `PCHPDDM`, `PCHPDDMSetSTShareSubKSP()`
2798 @*/
2799 PetscErrorCode PCHPDDMGetSTShareSubKSP(PC pc, PetscBool *share)
2800 {
2801   PetscFunctionBegin;
2802   PetscValidHeaderSpecific(pc, PC_CLASSID, 1);
2803   if (share) {
2804     PetscAssertPointer(share, 2);
2805     PetscUseMethod(pc, "PCHPDDMGetSTShareSubKSP_C", (PC, PetscBool *), (pc, share));
2806   }
2807   PetscFunctionReturn(PETSC_SUCCESS);
2808 }
2809 
2810 static PetscErrorCode PCHPDDMSetSTShareSubKSP_HPDDM(PC pc, PetscBool share)
2811 {
2812   PC_HPDDM *data = (PC_HPDDM *)pc->data;
2813 
2814   PetscFunctionBegin;
2815   data->share = share;
2816   PetscFunctionReturn(PETSC_SUCCESS);
2817 }
2818 
2819 static PetscErrorCode PCHPDDMGetSTShareSubKSP_HPDDM(PC pc, PetscBool *share)
2820 {
2821   PC_HPDDM *data = (PC_HPDDM *)pc->data;
2822 
2823   PetscFunctionBegin;
2824   *share = data->share;
2825   PetscFunctionReturn(PETSC_SUCCESS);
2826 }
2827 
2828 /*@
2829   PCHPDDMSetDeflationMat - Sets the deflation space used to assemble a coarser operator.
2830 
2831   Input Parameters:
2832 + pc - preconditioner context
2833 . is - index set of the local deflation matrix
2834 - U  - deflation sequential matrix stored as a `MATSEQDENSE`
2835 
2836   Level: advanced
2837 
2838 .seealso: [](ch_ksp), `PCHPDDM`, `PCDeflationSetSpace()`, `PCMGSetRestriction()`
2839 @*/
2840 PetscErrorCode PCHPDDMSetDeflationMat(PC pc, IS is, Mat U)
2841 {
2842   PetscFunctionBegin;
2843   PetscValidHeaderSpecific(pc, PC_CLASSID, 1);
2844   PetscValidHeaderSpecific(is, IS_CLASSID, 2);
2845   PetscValidHeaderSpecific(U, MAT_CLASSID, 3);
2846   PetscTryMethod(pc, "PCHPDDMSetDeflationMat_C", (PC, IS, Mat), (pc, is, U));
2847   PetscFunctionReturn(PETSC_SUCCESS);
2848 }
2849 
2850 static PetscErrorCode PCHPDDMSetDeflationMat_HPDDM(PC pc, IS is, Mat U)
2851 {
2852   PetscFunctionBegin;
2853   PetscCall(PCHPDDMSetAuxiliaryMat_Private(pc, is, U, PETSC_TRUE));
2854   PetscFunctionReturn(PETSC_SUCCESS);
2855 }
2856 
2857 PetscErrorCode HPDDMLoadDL_Private(PetscBool *found)
2858 {
2859   PetscBool flg;
2860   char      lib[PETSC_MAX_PATH_LEN], dlib[PETSC_MAX_PATH_LEN], dir[PETSC_MAX_PATH_LEN];
2861 
2862   PetscFunctionBegin;
2863   PetscAssertPointer(found, 1);
2864   PetscCall(PetscStrncpy(dir, "${PETSC_LIB_DIR}", sizeof(dir)));
2865   PetscCall(PetscOptionsGetString(nullptr, nullptr, "-hpddm_dir", dir, sizeof(dir), nullptr));
2866   PetscCall(PetscSNPrintf(lib, sizeof(lib), "%s/libhpddm_petsc", dir));
2867   PetscCall(PetscDLLibraryRetrieve(PETSC_COMM_SELF, lib, dlib, 1024, found));
2868 #if defined(SLEPC_LIB_DIR) /* this variable is passed during SLEPc ./configure when PETSc has not been configured   */
2869   if (!*found) {           /* with --download-hpddm since slepcconf.h is not yet built (and thus can't be included) */
2870     PetscCall(PetscStrncpy(dir, HPDDM_STR(SLEPC_LIB_DIR), sizeof(dir)));
2871     PetscCall(PetscSNPrintf(lib, sizeof(lib), "%s/libhpddm_petsc", dir));
2872     PetscCall(PetscDLLibraryRetrieve(PETSC_COMM_SELF, lib, dlib, 1024, found));
2873   }
2874 #endif
2875   if (!*found) { /* probable options for this to evaluate to PETSC_TRUE: system inconsistency (libhpddm_petsc moved by user?) or PETSc configured without --download-slepc */
2876     PetscCall(PetscOptionsGetenv(PETSC_COMM_SELF, "SLEPC_DIR", dir, sizeof(dir), &flg));
2877     if (flg) { /* if both PETSc and SLEPc are configured with --download-hpddm but PETSc has been configured without --download-slepc, one must ensure that libslepc is loaded before libhpddm_petsc */
2878       PetscCall(PetscSNPrintf(lib, sizeof(lib), "%s/lib/libslepc", dir));
2879       PetscCall(PetscDLLibraryRetrieve(PETSC_COMM_SELF, lib, dlib, 1024, found));
2880       PetscCheck(*found, PETSC_COMM_SELF, PETSC_ERR_PLIB, "%s not found but SLEPC_DIR=%s", lib, dir);
2881       PetscCall(PetscDLLibraryAppend(PETSC_COMM_SELF, &PetscDLLibrariesLoaded, dlib));
2882       PetscCall(PetscSNPrintf(lib, sizeof(lib), "%s/lib/libhpddm_petsc", dir)); /* libhpddm_petsc is always in the same directory as libslepc */
2883       PetscCall(PetscDLLibraryRetrieve(PETSC_COMM_SELF, lib, dlib, 1024, found));
2884     }
2885   }
2886   PetscCheck(*found, PETSC_COMM_SELF, PETSC_ERR_PLIB, "%s not found", lib);
2887   PetscCall(PetscDLLibraryAppend(PETSC_COMM_SELF, &PetscDLLibrariesLoaded, dlib));
2888   PetscFunctionReturn(PETSC_SUCCESS);
2889 }
2890 
2891 /*MC
2892    PCHPDDM - Interface with the HPDDM library.
2893 
2894    This `PC` may be used to build multilevel spectral domain decomposition methods based on the GenEO framework {cite}`spillane2011robust` {cite}`al2021multilevel`.
2895    It may be viewed as an alternative to spectral
2896    AMGe or `PCBDDC` with adaptive selection of constraints. The interface is explained in details in {cite}`jolivetromanzampini2020`
2897 
2898    The matrix used for building the preconditioner (Pmat) may be unassembled (`MATIS`), assembled (`MATAIJ`, `MATBAIJ`, or `MATSBAIJ`), hierarchical (`MATHTOOL`), `MATNORMAL`, `MATNORMALHERMITIAN`, or `MATSCHURCOMPLEMENT` (when `PCHPDDM` is used as part of an outer `PCFIELDSPLIT`).
2899 
2900    For multilevel preconditioning, when using an assembled or hierarchical Pmat, one must provide an auxiliary local `Mat` (unassembled local operator for GenEO) using
2901    `PCHPDDMSetAuxiliaryMat()`. Calling this routine is not needed when using a `MATIS` Pmat, assembly is done internally using `MatConvert()`.
2902 
2903    Options Database Keys:
2904 +   -pc_hpddm_define_subdomains <true, default=false>    - on the finest level, calls `PCASMSetLocalSubdomains()` with the `IS` supplied in `PCHPDDMSetAuxiliaryMat()`
2905                                                          (not relevant with an unassembled Pmat)
2906 .   -pc_hpddm_has_neumann <true, default=false>          - on the finest level, informs the `PC` that the local Neumann matrix is supplied in `PCHPDDMSetAuxiliaryMat()`
2907 -   -pc_hpddm_coarse_correction <type, default=deflated> - determines the `PCHPDDMCoarseCorrectionType` when calling `PCApply()`
2908 
2909    Options for subdomain solvers, subdomain eigensolvers (for computing deflation vectors), and the coarse solver can be set using the following options database prefixes.
2910 .vb
2911       -pc_hpddm_levels_%d_pc_
2912       -pc_hpddm_levels_%d_ksp_
2913       -pc_hpddm_levels_%d_eps_
2914       -pc_hpddm_levels_%d_p
2915       -pc_hpddm_levels_%d_mat_type
2916       -pc_hpddm_coarse_
2917       -pc_hpddm_coarse_p
2918       -pc_hpddm_coarse_mat_type
2919       -pc_hpddm_coarse_mat_filter
2920 .ve
2921 
2922    E.g., -pc_hpddm_levels_1_sub_pc_type lu -pc_hpddm_levels_1_eps_nev 10 -pc_hpddm_levels_2_p 4 -pc_hpddm_levels_2_sub_pc_type lu -pc_hpddm_levels_2_eps_nev 10
2923     -pc_hpddm_coarse_p 2 -pc_hpddm_coarse_mat_type baij will use 10 deflation vectors per subdomain on the fine "level 1",
2924     aggregate the fine subdomains into 4 "level 2" subdomains, then use 10 deflation vectors per subdomain on "level 2",
2925     and assemble the coarse matrix (of dimension 4 x 10 = 40) on two processes as a `MATBAIJ` (default is `MATSBAIJ`).
2926 
2927    In order to activate a "level N+1" coarse correction, it is mandatory to call -pc_hpddm_levels_N_eps_nev <nu> or -pc_hpddm_levels_N_eps_threshold <val>. The default -pc_hpddm_coarse_p value is 1, meaning that the coarse operator is aggregated on a single process.
2928 
2929    Level: intermediate
2930 
2931    Notes:
2932    This preconditioner requires that PETSc is built with SLEPc (``--download-slepc``).
2933 
2934    By default, the underlying concurrent eigenproblems
2935    are solved using SLEPc shift-and-invert spectral transformation. This is usually what gives the best performance for GenEO, cf.
2936    {cite}`spillane2011robust` {cite}`jolivet2013scalabledd`. As
2937    stated above, SLEPc options are available through -pc_hpddm_levels_%d_, e.g., -pc_hpddm_levels_1_eps_type arpack -pc_hpddm_levels_1_eps_nev 10
2938    -pc_hpddm_levels_1_st_type sinvert. There are furthermore three options related to the (subdomain-wise local) eigensolver that are not described in
2939    SLEPc documentation since they are specific to `PCHPDDM`.
2940 .vb
2941       -pc_hpddm_levels_1_st_share_sub_ksp
2942       -pc_hpddm_levels_%d_eps_threshold
2943       -pc_hpddm_levels_1_eps_use_inertia
2944 .ve
2945 
2946    The first option from the list only applies to the fine-level eigensolver, see `PCHPDDMSetSTShareSubKSP()`. The second option from the list is
2947    used to filter eigenmodes retrieved after convergence of `EPSSolve()` at "level N" such that eigenvectors used to define a "level N+1" coarse
2948    correction are associated to eigenvalues whose magnitude are lower or equal than -pc_hpddm_levels_N_eps_threshold. When using an `EPS` which cannot
2949    determine a priori the proper -pc_hpddm_levels_N_eps_nev such that all wanted eigenmodes are retrieved, it is possible to get an estimation of the
2950    correct value using the third option from the list, -pc_hpddm_levels_1_eps_use_inertia, see `MatGetInertia()`. In that case, there is no need
2951    to supply -pc_hpddm_levels_1_eps_nev. This last option also only applies to the fine-level (N = 1) eigensolver.
2952 
2953    See also {cite}`dolean2015introduction`, {cite}`al2022robust`, {cite}`al2022robustpd`, and {cite}`nataf2022recent`
2954 
2955 .seealso: [](ch_ksp), `PCCreate()`, `PCSetType()`, `PCType`, `PC`, `PCHPDDMSetAuxiliaryMat()`, `MATIS`, `PCBDDC`, `PCDEFLATION`, `PCTELESCOPE`, `PCASM`,
2956           `PCHPDDMSetCoarseCorrectionType()`, `PCHPDDMHasNeumannMat()`, `PCHPDDMSetRHSMat()`, `PCHPDDMSetDeflationMat()`, `PCHPDDMSetSTShareSubKSP()`,
2957           `PCHPDDMGetSTShareSubKSP()`, `PCHPDDMGetCoarseCorrectionType()`, `PCHPDDMGetComplexities()`
2958 M*/
2959 PETSC_EXTERN PetscErrorCode PCCreate_HPDDM(PC pc)
2960 {
2961   PC_HPDDM *data;
2962   PetscBool found;
2963 
2964   PetscFunctionBegin;
2965   if (!loadedSym) {
2966     PetscCall(HPDDMLoadDL_Private(&found));
2967     if (found) PetscCall(PetscDLLibrarySym(PETSC_COMM_SELF, &PetscDLLibrariesLoaded, nullptr, "PCHPDDM_Internal", (void **)&loadedSym));
2968   }
2969   PetscCheck(loadedSym, PETSC_COMM_SELF, PETSC_ERR_PLIB, "PCHPDDM_Internal symbol not found in loaded libhpddm_petsc");
2970   PetscCall(PetscNew(&data));
2971   pc->data                = data;
2972   data->Neumann           = PETSC_BOOL3_UNKNOWN;
2973   pc->ops->reset          = PCReset_HPDDM;
2974   pc->ops->destroy        = PCDestroy_HPDDM;
2975   pc->ops->setfromoptions = PCSetFromOptions_HPDDM;
2976   pc->ops->setup          = PCSetUp_HPDDM;
2977   pc->ops->apply          = PCApply_HPDDM;
2978   pc->ops->matapply       = PCMatApply_HPDDM;
2979   pc->ops->view           = PCView_HPDDM;
2980   pc->ops->presolve       = PCPreSolve_HPDDM;
2981 
2982   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetAuxiliaryMat_C", PCHPDDMSetAuxiliaryMat_HPDDM));
2983   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMHasNeumannMat_C", PCHPDDMHasNeumannMat_HPDDM));
2984   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetRHSMat_C", PCHPDDMSetRHSMat_HPDDM));
2985   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetCoarseCorrectionType_C", PCHPDDMSetCoarseCorrectionType_HPDDM));
2986   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMGetCoarseCorrectionType_C", PCHPDDMGetCoarseCorrectionType_HPDDM));
2987   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetSTShareSubKSP_C", PCHPDDMSetSTShareSubKSP_HPDDM));
2988   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMGetSTShareSubKSP_C", PCHPDDMGetSTShareSubKSP_HPDDM));
2989   PetscCall(PetscObjectComposeFunction((PetscObject)pc, "PCHPDDMSetDeflationMat_C", PCHPDDMSetDeflationMat_HPDDM));
2990   PetscFunctionReturn(PETSC_SUCCESS);
2991 }
2992 
2993 /*@C
2994   PCHPDDMInitializePackage - This function initializes everything in the `PCHPDDM` package. It is called from `PCInitializePackage()`.
2995 
2996   Level: developer
2997 
2998 .seealso: [](ch_ksp), `PetscInitialize()`
2999 @*/
3000 PetscErrorCode PCHPDDMInitializePackage(void)
3001 {
3002   char ename[32];
3003 
3004   PetscFunctionBegin;
3005   if (PCHPDDMPackageInitialized) PetscFunctionReturn(PETSC_SUCCESS);
3006   PCHPDDMPackageInitialized = PETSC_TRUE;
3007   PetscCall(PetscRegisterFinalize(PCHPDDMFinalizePackage));
3008   /* general events registered once during package initialization */
3009   /* some of these events are not triggered in libpetsc,          */
3010   /* but rather directly in libhpddm_petsc,                       */
3011   /* which is in charge of performing the following operations    */
3012 
3013   /* domain decomposition structure from Pmat sparsity pattern    */
3014   PetscCall(PetscLogEventRegister("PCHPDDMStrc", PC_CLASSID, &PC_HPDDM_Strc));
3015   /* Galerkin product, redistribution, and setup (not triggered in libpetsc)                */
3016   PetscCall(PetscLogEventRegister("PCHPDDMPtAP", PC_CLASSID, &PC_HPDDM_PtAP));
3017   /* Galerkin product with summation, redistribution, and setup (not triggered in libpetsc) */
3018   PetscCall(PetscLogEventRegister("PCHPDDMPtBP", PC_CLASSID, &PC_HPDDM_PtBP));
3019   /* next level construction using PtAP and PtBP (not triggered in libpetsc)                */
3020   PetscCall(PetscLogEventRegister("PCHPDDMNext", PC_CLASSID, &PC_HPDDM_Next));
3021   static_assert(PETSC_PCHPDDM_MAXLEVELS <= 9, "PETSC_PCHPDDM_MAXLEVELS value is too high");
3022   for (PetscInt i = 1; i < PETSC_PCHPDDM_MAXLEVELS; ++i) {
3023     PetscCall(PetscSNPrintf(ename, sizeof(ename), "PCHPDDMSetUp L%1" PetscInt_FMT, i));
3024     /* events during a PCSetUp() at level #i _except_ the assembly */
3025     /* of the Galerkin operator of the coarser level #(i + 1)      */
3026     PetscCall(PetscLogEventRegister(ename, PC_CLASSID, &PC_HPDDM_SetUp[i - 1]));
3027     PetscCall(PetscSNPrintf(ename, sizeof(ename), "PCHPDDMSolve L%1" PetscInt_FMT, i));
3028     /* events during a PCApply() at level #i _except_              */
3029     /* the KSPSolve() of the coarser level #(i + 1)                */
3030     PetscCall(PetscLogEventRegister(ename, PC_CLASSID, &PC_HPDDM_Solve[i - 1]));
3031   }
3032   PetscFunctionReturn(PETSC_SUCCESS);
3033 }
3034 
3035 /*@C
3036   PCHPDDMFinalizePackage - This function frees everything from the `PCHPDDM` package. It is called from `PetscFinalize()`.
3037 
3038   Level: developer
3039 
3040 .seealso: [](ch_ksp), `PetscFinalize()`
3041 @*/
3042 PetscErrorCode PCHPDDMFinalizePackage(void)
3043 {
3044   PetscFunctionBegin;
3045   PCHPDDMPackageInitialized = PETSC_FALSE;
3046   PetscFunctionReturn(PETSC_SUCCESS);
3047 }
3048 
3049 static PetscErrorCode MatMult_Harmonic(Mat A, Vec x, Vec y)
3050 {
3051   Harmonic h; /* [ A_00  A_01       ], furthermore, A_00 = [ A_loc,loc  A_loc,ovl ], thus, A_01 = [         ] */
3052               /* [ A_10  A_11  A_12 ]                      [ A_ovl,loc  A_ovl,ovl ]               [ A_ovl,1 ] */
3053   Vec sub;    /*  y = A x = R_loc R_0 [ A_00  A_01 ]^-1                                   R_loc = [  I_loc  ] */
3054               /*                      [ A_10  A_11 ]    R_1^T A_12 x                              [         ] */
3055   PetscFunctionBegin;
3056   PetscCall(MatShellGetContext(A, &h));
3057   PetscCall(VecSet(h->v, 0.0));
3058   PetscCall(VecGetSubVector(h->v, h->is[0], &sub));
3059   PetscCall(MatMult(h->A[0], x, sub));
3060   PetscCall(VecRestoreSubVector(h->v, h->is[0], &sub));
3061   PetscCall(KSPSolve(h->ksp, h->v, h->v));
3062   PetscCall(VecISCopy(h->v, h->is[1], SCATTER_REVERSE, y));
3063   PetscFunctionReturn(PETSC_SUCCESS);
3064 }
3065 
3066 static PetscErrorCode MatMultTranspose_Harmonic(Mat A, Vec y, Vec x)
3067 {
3068   Harmonic h;   /* x = A^T y =            [ A_00  A_01 ]^-T R_0^T R_loc^T y */
3069   Vec      sub; /*             A_12^T R_1 [ A_10  A_11 ]                    */
3070 
3071   PetscFunctionBegin;
3072   PetscCall(MatShellGetContext(A, &h));
3073   PetscCall(VecSet(h->v, 0.0));
3074   PetscCall(VecISCopy(h->v, h->is[1], SCATTER_FORWARD, y));
3075   PetscCall(KSPSolveTranspose(h->ksp, h->v, h->v));
3076   PetscCall(VecGetSubVector(h->v, h->is[0], &sub));
3077   PetscCall(MatMultTranspose(h->A[0], sub, x));
3078   PetscCall(VecRestoreSubVector(h->v, h->is[0], &sub));
3079   PetscFunctionReturn(PETSC_SUCCESS);
3080 }
3081 
3082 static PetscErrorCode MatProduct_AB_Harmonic(Mat S, Mat X, Mat Y, void *)
3083 {
3084   Harmonic h;
3085   Mat      A, B;
3086   Vec      a, b;
3087 
3088   PetscFunctionBegin;
3089   PetscCall(MatShellGetContext(S, &h));
3090   PetscCall(MatMatMult(h->A[0], X, MAT_INITIAL_MATRIX, PETSC_CURRENT, &A));
3091   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, h->ksp->pc->mat->rmap->n, A->cmap->n, nullptr, &B));
3092   for (PetscInt i = 0; i < A->cmap->n; ++i) {
3093     PetscCall(MatDenseGetColumnVecRead(A, i, &a));
3094     PetscCall(MatDenseGetColumnVecWrite(B, i, &b));
3095     PetscCall(VecISCopy(b, h->is[0], SCATTER_FORWARD, a));
3096     PetscCall(MatDenseRestoreColumnVecWrite(B, i, &b));
3097     PetscCall(MatDenseRestoreColumnVecRead(A, i, &a));
3098   }
3099   PetscCall(MatDestroy(&A));
3100   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF, h->ksp->pc->mat->rmap->n, B->cmap->n, nullptr, &A));
3101   PetscCall(KSPMatSolve(h->ksp, B, A));
3102   PetscCall(MatDestroy(&B));
3103   for (PetscInt i = 0; i < A->cmap->n; ++i) {
3104     PetscCall(MatDenseGetColumnVecRead(A, i, &a));
3105     PetscCall(MatDenseGetColumnVecWrite(Y, i, &b));
3106     PetscCall(VecISCopy(a, h->is[1], SCATTER_REVERSE, b));
3107     PetscCall(MatDenseRestoreColumnVecWrite(Y, i, &b));
3108     PetscCall(MatDenseRestoreColumnVecRead(A, i, &a));
3109   }
3110   PetscCall(MatDestroy(&A));
3111   PetscFunctionReturn(PETSC_SUCCESS);
3112 }
3113 
3114 static PetscErrorCode MatDestroy_Harmonic(Mat A)
3115 {
3116   Harmonic h;
3117 
3118   PetscFunctionBegin;
3119   PetscCall(MatShellGetContext(A, &h));
3120   for (PetscInt i = 0; i < 5; ++i) PetscCall(ISDestroy(h->is + i));
3121   PetscCall(PetscFree(h->is));
3122   PetscCall(VecDestroy(&h->v));
3123   for (PetscInt i = 0; i < 2; ++i) PetscCall(MatDestroy(h->A + i));
3124   PetscCall(PetscFree(h->A));
3125   PetscCall(KSPDestroy(&h->ksp));
3126   PetscCall(PetscFree(h));
3127   PetscFunctionReturn(PETSC_SUCCESS);
3128 }
3129