xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 5cb80ecd61fc93edbe681011dc160a66bbda2b5d)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <petsc/private/pcbddcimpl.h>
3 #include <petsc/private/pcbddcprivateimpl.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17   PetscScalar    *uwork,*data,*U, ds = 0.;
18   PetscReal      *sing;
19   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
20   PetscInt       ulw,i,nr,nc,n;
21 #if defined(PETSC_USE_COMPLEX)
22   PetscReal      *rwork2;
23 #endif
24 
25   PetscFunctionBegin;
26   PetscCall(MatGetSize(A,&nr,&nc));
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     PetscCall(PetscMalloc1(ulw,&uwork));
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     PetscCall(PetscMalloc1(n,&sing));
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   PetscCall(PetscMalloc1(nr*nr,&U));
46   PetscCall(PetscBLASIntCast(nr,&bM));
47   PetscCall(PetscBLASIntCast(nc,&bN));
48   PetscCall(PetscBLASIntCast(ulw,&lwork));
49   PetscCall(MatDenseGetArray(A,&data));
50   PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
51 #if !defined(PETSC_USE_COMPLEX)
52   PetscCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
53 #else
54   PetscCall(PetscMalloc1(5*n,&rwork2));
55   PetscCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,rwork2,&lierr));
56   PetscCall(PetscFree(rwork2));
57 #endif
58   PetscCall(PetscFPTrapPop());
59   PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
60   PetscCall(MatDenseRestoreArray(A,&data));
61   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
62   if (!rwork) {
63     PetscCall(PetscFree(sing));
64   }
65   if (!work) {
66     PetscCall(PetscFree(uwork));
67   }
68   /* create B */
69   if (!range) {
70     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B));
71     PetscCall(MatDenseGetArray(*B,&data));
72     PetscCall(PetscArraycpy(data,U+nr*i,(nr-i)*nr));
73   } else {
74     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B));
75     PetscCall(MatDenseGetArray(*B,&data));
76     PetscCall(PetscArraycpy(data,U,i*nr));
77   }
78   PetscCall(MatDenseRestoreArray(*B,&data));
79   PetscCall(PetscFree(U));
80   PetscFunctionReturn(0);
81 }
82 
83 /* TODO REMOVE */
84 #if defined(PRINT_GDET)
85 static int inc = 0;
86 static int lev = 0;
87 #endif
88 
89 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
90 {
91   Mat            GE,GEd;
92   PetscInt       rsize,csize,esize;
93   PetscScalar    *ptr;
94 
95   PetscFunctionBegin;
96   PetscCall(ISGetSize(edge,&esize));
97   if (!esize) PetscFunctionReturn(0);
98   PetscCall(ISGetSize(extrow,&rsize));
99   PetscCall(ISGetSize(extcol,&csize));
100 
101   /* gradients */
102   ptr  = work + 5*esize;
103   PetscCall(MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE));
104   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins));
105   PetscCall(MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins));
106   PetscCall(MatDestroy(&GE));
107 
108   /* constants */
109   ptr += rsize*csize;
110   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd));
111   PetscCall(MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE));
112   PetscCall(MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd));
113   PetscCall(MatDestroy(&GE));
114   PetscCall(MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins));
115   PetscCall(MatDestroy(&GEd));
116 
117   if (corners) {
118     Mat               GEc;
119     const PetscScalar *vals;
120     PetscScalar       v;
121 
122     PetscCall(MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc));
123     PetscCall(MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd));
124     PetscCall(MatDenseGetArrayRead(GEd,&vals));
125     /* v    = PetscAbsScalar(vals[0]) */;
126     v    = 1.;
127     cvals[0] = vals[0]/v;
128     cvals[1] = vals[1]/v;
129     PetscCall(MatDenseRestoreArrayRead(GEd,&vals));
130     PetscCall(MatScale(*GKins,1./v));
131 #if defined(PRINT_GDET)
132     {
133       PetscViewer viewer;
134       char filename[256];
135       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
136       PetscCall(PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer));
137       PetscCall(PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB));
138       PetscCall(PetscObjectSetName((PetscObject)GEc,"GEc"));
139       PetscCall(MatView(GEc,viewer));
140       PetscCall(PetscObjectSetName((PetscObject)(*GKins),"GK"));
141       PetscCall(MatView(*GKins,viewer));
142       PetscCall(PetscObjectSetName((PetscObject)GEd,"Gproj"));
143       PetscCall(MatView(GEd,viewer));
144       PetscCall(PetscViewerDestroy(&viewer));
145     }
146 #endif
147     PetscCall(MatDestroy(&GEd));
148     PetscCall(MatDestroy(&GEc));
149   }
150 
151   PetscFunctionReturn(0);
152 }
153 
154 PetscErrorCode PCBDDCNedelecSupport(PC pc)
155 {
156   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
157   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
158   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
159   Vec                    tvec;
160   PetscSF                sfv;
161   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
162   MPI_Comm               comm;
163   IS                     lned,primals,allprimals,nedfieldlocal;
164   IS                     *eedges,*extrows,*extcols,*alleedges;
165   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
166   PetscScalar            *vals,*work;
167   PetscReal              *rwork;
168   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
169   PetscInt               ne,nv,Lv,order,n,field;
170   PetscInt               n_neigh,*neigh,*n_shared,**shared;
171   PetscInt               i,j,extmem,cum,maxsize,nee;
172   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
173   PetscInt               *sfvleaves,*sfvroots;
174   PetscInt               *corners,*cedges;
175   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
176   PetscInt               *emarks;
177   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
178 
179   PetscFunctionBegin;
180   /* If the discrete gradient is defined for a subset of dofs and global is true,
181      it assumes G is given in global ordering for all the dofs.
182      Otherwise, the ordering is global for the Nedelec field */
183   order      = pcbddc->nedorder;
184   conforming = pcbddc->conforming;
185   field      = pcbddc->nedfield;
186   global     = pcbddc->nedglobal;
187   setprimal  = PETSC_FALSE;
188   print      = PETSC_FALSE;
189   singular   = PETSC_FALSE;
190 
191   /* Command line customization */
192   PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");
193   PetscCall(PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL));
194   PetscCall(PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL));
195   PetscCall(PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL));
196   /* print debug info TODO: to be removed */
197   PetscCall(PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL));
198   PetscOptionsEnd();
199 
200   /* Return if there are no edges in the decomposition and the problem is not singular */
201   PetscCall(MatISGetLocalToGlobalMapping(pc->pmat,&al2g,NULL));
202   PetscCall(ISLocalToGlobalMappingGetSize(al2g,&n));
203   PetscCall(PetscObjectGetComm((PetscObject)pc,&comm));
204   if (!singular) {
205     PetscCall(VecGetArrayRead(matis->counter,(const PetscScalar**)&vals));
206     lrc[0] = PETSC_FALSE;
207     for (i=0;i<n;i++) {
208       if (PetscRealPart(vals[i]) > 2.) {
209         lrc[0] = PETSC_TRUE;
210         break;
211       }
212     }
213     PetscCall(VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals));
214     PetscCall(MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm));
215     if (!lrc[1]) PetscFunctionReturn(0);
216   }
217 
218   /* Get Nedelec field */
219   PetscCheck(!pcbddc->n_ISForDofsLocal || field < pcbddc->n_ISForDofsLocal,comm,PETSC_ERR_USER,"Invalid field for Nedelec %" PetscInt_FMT ": number of fields is %" PetscInt_FMT,field,pcbddc->n_ISForDofsLocal);
220   if (pcbddc->n_ISForDofsLocal && field >= 0) {
221     PetscCall(PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]));
222     nedfieldlocal = pcbddc->ISForDofsLocal[field];
223     PetscCall(ISGetLocalSize(nedfieldlocal,&ne));
224   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
225     ne            = n;
226     nedfieldlocal = NULL;
227     global        = PETSC_TRUE;
228   } else if (field == PETSC_DECIDE) {
229     PetscInt rst,ren,*idx;
230 
231     PetscCall(PetscArrayzero(matis->sf_leafdata,n));
232     PetscCall(PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n));
233     PetscCall(MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren));
234     for (i=rst;i<ren;i++) {
235       PetscInt nc;
236 
237       PetscCall(MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL));
238       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
239       PetscCall(MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL));
240     }
241     PetscCall(PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE));
242     PetscCall(PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE));
243     PetscCall(PetscMalloc1(n,&idx));
244     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
245     PetscCall(ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal));
246   } else {
247     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
248   }
249 
250   /* Sanity checks */
251   PetscCheck(order || conforming,comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
252   PetscCheck(!pcbddc->user_ChangeOfBasisMatrix,comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
253   PetscCheck(!order || (ne%order == 0),PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %" PetscInt_FMT " is not a multiple of the order %" PetscInt_FMT,ne,order);
254 
255   /* Just set primal dofs and return */
256   if (setprimal) {
257     IS       enedfieldlocal;
258     PetscInt *eidxs;
259 
260     PetscCall(PetscMalloc1(ne,&eidxs));
261     PetscCall(VecGetArrayRead(matis->counter,(const PetscScalar**)&vals));
262     if (nedfieldlocal) {
263       PetscCall(ISGetIndices(nedfieldlocal,&idxs));
264       for (i=0,cum=0;i<ne;i++) {
265         if (PetscRealPart(vals[idxs[i]]) > 2.) {
266           eidxs[cum++] = idxs[i];
267         }
268       }
269       PetscCall(ISRestoreIndices(nedfieldlocal,&idxs));
270     } else {
271       for (i=0,cum=0;i<ne;i++) {
272         if (PetscRealPart(vals[i]) > 2.) {
273           eidxs[cum++] = i;
274         }
275       }
276     }
277     PetscCall(VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals));
278     PetscCall(ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal));
279     PetscCall(PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal));
280     PetscCall(PetscFree(eidxs));
281     PetscCall(ISDestroy(&nedfieldlocal));
282     PetscCall(ISDestroy(&enedfieldlocal));
283     PetscFunctionReturn(0);
284   }
285 
286   /* Compute some l2g maps */
287   if (nedfieldlocal) {
288     IS is;
289 
290     /* need to map from the local Nedelec field to local numbering */
291     PetscCall(ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g));
292     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
293     PetscCall(ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is));
294     PetscCall(ISLocalToGlobalMappingCreateIS(is,&al2g));
295     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
296     if (global) {
297       PetscCall(PetscObjectReference((PetscObject)al2g));
298       el2g = al2g;
299     } else {
300       IS gis;
301 
302       PetscCall(ISRenumber(is,NULL,NULL,&gis));
303       PetscCall(ISLocalToGlobalMappingCreateIS(gis,&el2g));
304       PetscCall(ISDestroy(&gis));
305     }
306     PetscCall(ISDestroy(&is));
307   } else {
308     /* restore default */
309     pcbddc->nedfield = -1;
310     /* one ref for the destruction of al2g, one for el2g */
311     PetscCall(PetscObjectReference((PetscObject)al2g));
312     PetscCall(PetscObjectReference((PetscObject)al2g));
313     el2g = al2g;
314     fl2g = NULL;
315   }
316 
317   /* Start communication to drop connections for interior edges (for cc analysis only) */
318   PetscCall(PetscArrayzero(matis->sf_leafdata,n));
319   PetscCall(PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n));
320   if (nedfieldlocal) {
321     PetscCall(ISGetIndices(nedfieldlocal,&idxs));
322     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
323     PetscCall(ISRestoreIndices(nedfieldlocal,&idxs));
324   } else {
325     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
326   }
327   PetscCall(PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM));
328   PetscCall(PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM));
329 
330   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
331     PetscCall(MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G));
332     PetscCall(MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE));
333     if (global) {
334       PetscInt rst;
335 
336       PetscCall(MatGetOwnershipRange(G,&rst,NULL));
337       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
338         if (matis->sf_rootdata[i] < 2) {
339           matis->sf_rootdata[cum++] = i + rst;
340         }
341       }
342       PetscCall(MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE));
343       PetscCall(MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL));
344     } else {
345       PetscInt *tbz;
346 
347       PetscCall(PetscMalloc1(ne,&tbz));
348       PetscCall(PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE));
349       PetscCall(PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE));
350       PetscCall(ISGetIndices(nedfieldlocal,&idxs));
351       for (i=0,cum=0;i<ne;i++)
352         if (matis->sf_leafdata[idxs[i]] == 1)
353           tbz[cum++] = i;
354       PetscCall(ISRestoreIndices(nedfieldlocal,&idxs));
355       PetscCall(ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz));
356       PetscCall(MatZeroRows(G,cum,tbz,0.,NULL,NULL));
357       PetscCall(PetscFree(tbz));
358     }
359   } else { /* we need the entire G to infer the nullspace */
360     PetscCall(PetscObjectReference((PetscObject)pcbddc->discretegradient));
361     G    = pcbddc->discretegradient;
362   }
363 
364   /* Extract subdomain relevant rows of G */
365   PetscCall(ISLocalToGlobalMappingGetIndices(el2g,&idxs));
366   PetscCall(ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned));
367   PetscCall(MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall));
368   PetscCall(ISLocalToGlobalMappingRestoreIndices(el2g,&idxs));
369   PetscCall(ISDestroy(&lned));
370   PetscCall(MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis));
371   PetscCall(MatDestroy(&lGall));
372   PetscCall(MatISGetLocalMat(lGis,&lG));
373 
374   /* SF for nodal dofs communications */
375   PetscCall(MatGetLocalSize(G,NULL,&Lv));
376   PetscCall(MatISGetLocalToGlobalMapping(lGis,NULL,&vl2g));
377   PetscCall(PetscObjectReference((PetscObject)vl2g));
378   PetscCall(ISLocalToGlobalMappingGetSize(vl2g,&nv));
379   PetscCall(PetscSFCreate(comm,&sfv));
380   PetscCall(ISLocalToGlobalMappingGetIndices(vl2g,&idxs));
381   PetscCall(PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs));
382   PetscCall(ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs));
383   i    = singular ? 2 : 1;
384   PetscCall(PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots));
385 
386   /* Destroy temporary G created in MATIS format and modified G */
387   PetscCall(PetscObjectReference((PetscObject)lG));
388   PetscCall(MatDestroy(&lGis));
389   PetscCall(MatDestroy(&G));
390 
391   if (print) {
392     PetscCall(PetscObjectSetName((PetscObject)lG,"initial_lG"));
393     PetscCall(MatView(lG,NULL));
394   }
395 
396   /* Save lG for values insertion in change of basis */
397   PetscCall(MatDuplicate(lG,MAT_COPY_VALUES,&lGinit));
398 
399   /* Analyze the edge-nodes connections (duplicate lG) */
400   PetscCall(MatDuplicate(lG,MAT_COPY_VALUES,&lGe));
401   PetscCall(MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE));
402   PetscCall(PetscBTCreate(nv,&btv));
403   PetscCall(PetscBTCreate(ne,&bte));
404   PetscCall(PetscBTCreate(ne,&btb));
405   PetscCall(PetscBTCreate(ne,&btbd));
406   PetscCall(PetscBTCreate(nv,&btvcand));
407   /* need to import the boundary specification to ensure the
408      proper detection of coarse edges' endpoints */
409   if (pcbddc->DirichletBoundariesLocal) {
410     IS is;
411 
412     if (fl2g) {
413       PetscCall(ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is));
414     } else {
415       is = pcbddc->DirichletBoundariesLocal;
416     }
417     PetscCall(ISGetLocalSize(is,&cum));
418     PetscCall(ISGetIndices(is,&idxs));
419     for (i=0;i<cum;i++) {
420       if (idxs[i] >= 0) {
421         PetscCall(PetscBTSet(btb,idxs[i]));
422         PetscCall(PetscBTSet(btbd,idxs[i]));
423       }
424     }
425     PetscCall(ISRestoreIndices(is,&idxs));
426     if (fl2g) {
427       PetscCall(ISDestroy(&is));
428     }
429   }
430   if (pcbddc->NeumannBoundariesLocal) {
431     IS is;
432 
433     if (fl2g) {
434       PetscCall(ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is));
435     } else {
436       is = pcbddc->NeumannBoundariesLocal;
437     }
438     PetscCall(ISGetLocalSize(is,&cum));
439     PetscCall(ISGetIndices(is,&idxs));
440     for (i=0;i<cum;i++) {
441       if (idxs[i] >= 0) {
442         PetscCall(PetscBTSet(btb,idxs[i]));
443       }
444     }
445     PetscCall(ISRestoreIndices(is,&idxs));
446     if (fl2g) {
447       PetscCall(ISDestroy(&is));
448     }
449   }
450 
451   /* Count neighs per dof */
452   PetscCall(ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs));
453   PetscCall(ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs));
454 
455   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
456      for proper detection of coarse edges' endpoints */
457   PetscCall(PetscBTCreate(ne,&btee));
458   for (i=0;i<ne;i++) {
459     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
460       PetscCall(PetscBTSet(btee,i));
461     }
462   }
463   PetscCall(PetscMalloc1(ne,&marks));
464   if (!conforming) {
465     PetscCall(MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt));
466     PetscCall(MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done));
467   }
468   PetscCall(MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
469   PetscCall(MatSeqAIJGetArray(lGe,&vals));
470   cum  = 0;
471   for (i=0;i<ne;i++) {
472     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
473     if (!PetscBTLookup(btee,i)) {
474       marks[cum++] = i;
475       continue;
476     }
477     /* set badly connected edge dofs as primal */
478     if (!conforming) {
479       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
480         marks[cum++] = i;
481         PetscCall(PetscBTSet(bte,i));
482         for (j=ii[i];j<ii[i+1];j++) {
483           PetscCall(PetscBTSet(btv,jj[j]));
484         }
485       } else {
486         /* every edge dofs should be connected trough a certain number of nodal dofs
487            to other edge dofs belonging to coarse edges
488            - at most 2 endpoints
489            - order-1 interior nodal dofs
490            - no undefined nodal dofs (nconn < order)
491         */
492         PetscInt ends = 0,ints = 0, undef = 0;
493         for (j=ii[i];j<ii[i+1];j++) {
494           PetscInt v = jj[j],k;
495           PetscInt nconn = iit[v+1]-iit[v];
496           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
497           if (nconn > order) ends++;
498           else if (nconn == order) ints++;
499           else undef++;
500         }
501         if (undef || ends > 2 || ints != order -1) {
502           marks[cum++] = i;
503           PetscCall(PetscBTSet(bte,i));
504           for (j=ii[i];j<ii[i+1];j++) {
505             PetscCall(PetscBTSet(btv,jj[j]));
506           }
507         }
508       }
509     }
510     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
511     if (!order && ii[i+1] != ii[i]) {
512       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
513       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
514     }
515   }
516   PetscCall(PetscBTDestroy(&btee));
517   PetscCall(MatSeqAIJRestoreArray(lGe,&vals));
518   PetscCall(MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
519   if (!conforming) {
520     PetscCall(MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done));
521     PetscCall(MatDestroy(&lGt));
522   }
523   PetscCall(MatZeroRows(lGe,cum,marks,0.,NULL,NULL));
524 
525   /* identify splitpoints and corner candidates */
526   PetscCall(MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt));
527   if (print) {
528     PetscCall(PetscObjectSetName((PetscObject)lGe,"edgerestr_lG"));
529     PetscCall(MatView(lGe,NULL));
530     PetscCall(PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt"));
531     PetscCall(MatView(lGt,NULL));
532   }
533   PetscCall(MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
534   PetscCall(MatSeqAIJGetArray(lGt,&vals));
535   for (i=0;i<nv;i++) {
536     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
537     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
538     if (!order) { /* variable order */
539       PetscReal vorder = 0.;
540 
541       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
542       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
543       PetscCheck(vorder-test <= PETSC_SQRT_MACHINE_EPSILON,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%" PetscInt_FMT ")",(double)vorder,test);
544       ord  = 1;
545     }
546     PetscAssert(test%ord == 0,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %" PetscInt_FMT " connected with nodal dof %" PetscInt_FMT " with order %" PetscInt_FMT,test,i,ord);
547     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
548       if (PetscBTLookup(btbd,jj[j])) {
549         bdir = PETSC_TRUE;
550         break;
551       }
552       if (vc != ecount[jj[j]]) {
553         sneighs = PETSC_FALSE;
554       } else {
555         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
556         for (k=0;k<vc;k++) {
557           if (vn[k] != en[k]) {
558             sneighs = PETSC_FALSE;
559             break;
560           }
561         }
562       }
563     }
564     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
565       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %" PetscInt_FMT " (%s %s %s)\n",i,PetscBools[!sneighs],PetscBools[test >= 3*ord],PetscBools[bdir]);
566       PetscCall(PetscBTSet(btv,i));
567     } else if (test == ord) {
568       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
569         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %" PetscInt_FMT "\n",i);
570         PetscCall(PetscBTSet(btv,i));
571       } else {
572         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %" PetscInt_FMT "\n",i);
573         PetscCall(PetscBTSet(btvcand,i));
574       }
575     }
576   }
577   PetscCall(ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs));
578   PetscCall(ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs));
579   PetscCall(PetscBTDestroy(&btbd));
580 
581   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
582   if (order != 1) {
583     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
584     PetscCall(MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done));
585     for (i=0;i<nv;i++) {
586       if (PetscBTLookup(btvcand,i)) {
587         PetscBool found = PETSC_FALSE;
588         for (j=ii[i];j<ii[i+1] && !found;j++) {
589           PetscInt k,e = jj[j];
590           if (PetscBTLookup(bte,e)) continue;
591           for (k=iit[e];k<iit[e+1];k++) {
592             PetscInt v = jjt[k];
593             if (v != i && PetscBTLookup(btvcand,v)) {
594               found = PETSC_TRUE;
595               break;
596             }
597           }
598         }
599         if (!found) {
600           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %" PetscInt_FMT " CLEARED\n",i);
601           PetscCall(PetscBTClear(btvcand,i));
602         } else {
603           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %" PetscInt_FMT " ACCEPTED\n",i);
604         }
605       }
606     }
607     PetscCall(MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done));
608   }
609   PetscCall(MatSeqAIJRestoreArray(lGt,&vals));
610   PetscCall(MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
611   PetscCall(MatDestroy(&lGe));
612 
613   /* Get the local G^T explicitly */
614   PetscCall(MatDestroy(&lGt));
615   PetscCall(MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt));
616   PetscCall(MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE));
617 
618   /* Mark interior nodal dofs */
619   PetscCall(ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared));
620   PetscCall(PetscBTCreate(nv,&btvi));
621   for (i=1;i<n_neigh;i++) {
622     for (j=0;j<n_shared[i];j++) {
623       PetscCall(PetscBTSet(btvi,shared[i][j]));
624     }
625   }
626   PetscCall(ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared));
627 
628   /* communicate corners and splitpoints */
629   PetscCall(PetscMalloc1(nv,&vmarks));
630   PetscCall(PetscArrayzero(sfvleaves,nv));
631   PetscCall(PetscArrayzero(sfvroots,Lv));
632   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
633 
634   if (print) {
635     IS tbz;
636 
637     cum = 0;
638     for (i=0;i<nv;i++)
639       if (sfvleaves[i])
640         vmarks[cum++] = i;
641 
642     PetscCall(ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz));
643     PetscCall(PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local"));
644     PetscCall(ISView(tbz,NULL));
645     PetscCall(ISDestroy(&tbz));
646   }
647 
648   PetscCall(PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM));
649   PetscCall(PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM));
650   PetscCall(PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves,MPI_REPLACE));
651   PetscCall(PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves,MPI_REPLACE));
652 
653   /* Zero rows of lGt corresponding to identified corners
654      and interior nodal dofs */
655   cum = 0;
656   for (i=0;i<nv;i++) {
657     if (sfvleaves[i]) {
658       vmarks[cum++] = i;
659       PetscCall(PetscBTSet(btv,i));
660     }
661     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
662   }
663   PetscCall(PetscBTDestroy(&btvi));
664   if (print) {
665     IS tbz;
666 
667     PetscCall(ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz));
668     PetscCall(PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior"));
669     PetscCall(ISView(tbz,NULL));
670     PetscCall(ISDestroy(&tbz));
671   }
672   PetscCall(MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL));
673   PetscCall(PetscFree(vmarks));
674   PetscCall(PetscSFDestroy(&sfv));
675   PetscCall(PetscFree2(sfvleaves,sfvroots));
676 
677   /* Recompute G */
678   PetscCall(MatDestroy(&lG));
679   PetscCall(MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG));
680   if (print) {
681     PetscCall(PetscObjectSetName((PetscObject)lG,"used_lG"));
682     PetscCall(MatView(lG,NULL));
683     PetscCall(PetscObjectSetName((PetscObject)lGt,"used_lGt"));
684     PetscCall(MatView(lGt,NULL));
685   }
686 
687   /* Get primal dofs (if any) */
688   cum = 0;
689   for (i=0;i<ne;i++) {
690     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
691   }
692   if (fl2g) PetscCall(ISLocalToGlobalMappingApply(fl2g,cum,marks,marks));
693   PetscCall(ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals));
694   if (print) {
695     PetscCall(PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs"));
696     PetscCall(ISView(primals,NULL));
697   }
698   PetscCall(PetscBTDestroy(&bte));
699   /* TODO: what if the user passed in some of them ?  */
700   PetscCall(PCBDDCSetPrimalVerticesLocalIS(pc,primals));
701   PetscCall(ISDestroy(&primals));
702 
703   /* Compute edge connectivity */
704   PetscCall(PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_"));
705 
706   /* Symbolic conn = lG*lGt */
707   PetscCall(MatProductCreate(lG,lGt,NULL,&conn));
708   PetscCall(MatProductSetType(conn,MATPRODUCT_AB));
709   PetscCall(MatProductSetAlgorithm(conn,"default"));
710   PetscCall(MatProductSetFill(conn,PETSC_DEFAULT));
711   PetscCall(PetscObjectSetOptionsPrefix((PetscObject)conn,"econn_"));
712   PetscCall(MatProductSetFromOptions(conn));
713   PetscCall(MatProductSymbolic(conn));
714 
715   PetscCall(MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     PetscCall(PetscMalloc1(n+1,&iia));
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       PetscCheck(pcbddc->mat_graph->nvtxs_csr == n,PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %" PetscInt_FMT ". Should be %" PetscInt_FMT,pcbddc->mat_graph->nvtxs_csr,n);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       PetscCall(MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done));
730     } else {
731       free   = PETSC_TRUE;
732       PetscCall(PetscMalloc2(n+1,&iiu,n,&jju));
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     PetscCall(PetscBTCreate(n,&btf));
746     PetscCall(ISGetIndices(nedfieldlocal,&idxs));
747     for (i=0;i<ne;i++) {
748       PetscCall(PetscBTSet(btf,idxs[i]));
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     PetscCall(PetscMalloc1(iia[n],&jja));
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       PetscCall(ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj));
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     PetscCall(ISRestoreIndices(nedfieldlocal,&idxs));
771     PetscCall(PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER));
772     if (rest) {
773       PetscCall(MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done));
774     }
775     if (free) PetscCall(PetscFree2(iiu,jju));
776     PetscCall(PetscBTDestroy(&btf));
777   } else {
778     PetscCall(PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER));
779   }
780 
781   /* Analyze interface for edge dofs */
782   PetscCall(PCBDDCAnalyzeInterface(pc));
783   pcbddc->mat_graph->twodim = PETSC_FALSE;
784 
785   /* Get coarse edges in the edge space */
786   PetscCall(PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals));
787   PetscCall(MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
788 
789   if (fl2g) {
790     PetscCall(ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals));
791     PetscCall(PetscMalloc1(nee,&eedges));
792     for (i=0;i<nee;i++) {
793       PetscCall(ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]));
794     }
795   } else {
796     eedges  = alleedges;
797     primals = allprimals;
798   }
799 
800   /* Mark fine edge dofs with their coarse edge id */
801   PetscCall(PetscArrayzero(marks,ne));
802   PetscCall(ISGetLocalSize(primals,&cum));
803   PetscCall(ISGetIndices(primals,&idxs));
804   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
805   PetscCall(ISRestoreIndices(primals,&idxs));
806   if (print) {
807     PetscCall(PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs"));
808     PetscCall(ISView(primals,NULL));
809   }
810 
811   maxsize = 0;
812   for (i=0;i<nee;i++) {
813     PetscInt size,mark = i+1;
814 
815     PetscCall(ISGetLocalSize(eedges[i],&size));
816     PetscCall(ISGetIndices(eedges[i],&idxs));
817     for (j=0;j<size;j++) marks[idxs[j]] = mark;
818     PetscCall(ISRestoreIndices(eedges[i],&idxs));
819     maxsize = PetscMax(maxsize,size);
820   }
821 
822   /* Find coarse edge endpoints */
823   PetscCall(MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
824   PetscCall(MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done));
825   for (i=0;i<nee;i++) {
826     PetscInt mark = i+1,size;
827 
828     PetscCall(ISGetLocalSize(eedges[i],&size));
829     if (!size && nedfieldlocal) continue;
830     PetscCheck(size,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %" PetscInt_FMT,i);
831     PetscCall(ISGetIndices(eedges[i],&idxs));
832     if (print) {
833       PetscCall(PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %" PetscInt_FMT "\n",i));
834       PetscCall(ISView(eedges[i],NULL));
835     }
836     for (j=0;j<size;j++) {
837       PetscInt k, ee = idxs[j];
838       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %" PetscInt_FMT "\n",ee);
839       for (k=ii[ee];k<ii[ee+1];k++) {
840         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %" PetscInt_FMT "\n",jj[k]);
841         if (PetscBTLookup(btv,jj[k])) {
842           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %" PetscInt_FMT "\n",jj[k]);
843         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
844           PetscInt  k2;
845           PetscBool corner = PETSC_FALSE;
846           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
847             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %" PetscInt_FMT ": mark %" PetscInt_FMT " (ref mark %" PetscInt_FMT "), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,(int)!!PetscBTLookup(btb,jjt[k2]));
848             /* it's a corner if either is connected with an edge dof belonging to a different cc or
849                if the edge dof lie on the natural part of the boundary */
850             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
851               corner = PETSC_TRUE;
852               break;
853             }
854           }
855           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
856             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %" PetscInt_FMT "\n",jj[k]);
857             PetscCall(PetscBTSet(btv,jj[k]));
858           } else {
859             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
860           }
861         }
862       }
863     }
864     PetscCall(ISRestoreIndices(eedges[i],&idxs));
865   }
866   PetscCall(MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done));
867   PetscCall(MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
868   PetscCall(PetscBTDestroy(&btb));
869 
870   /* Reset marked primal dofs */
871   PetscCall(ISGetLocalSize(primals,&cum));
872   PetscCall(ISGetIndices(primals,&idxs));
873   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
874   PetscCall(ISRestoreIndices(primals,&idxs));
875 
876   /* Now use the initial lG */
877   PetscCall(MatDestroy(&lG));
878   PetscCall(MatDestroy(&lGt));
879   lG   = lGinit;
880   PetscCall(MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt));
881 
882   /* Compute extended cols indices */
883   PetscCall(PetscBTCreate(nv,&btvc));
884   PetscCall(PetscBTCreate(nee,&bter));
885   PetscCall(MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
886   PetscCall(MatSeqAIJGetMaxRowNonzeros(lG,&i));
887   i   *= maxsize;
888   PetscCall(PetscCalloc1(nee,&extcols));
889   PetscCall(PetscMalloc2(i,&extrow,i,&gidxs));
890   eerr = PETSC_FALSE;
891   for (i=0;i<nee;i++) {
892     PetscInt size,found = 0;
893 
894     cum  = 0;
895     PetscCall(ISGetLocalSize(eedges[i],&size));
896     if (!size && nedfieldlocal) continue;
897     PetscCheck(size,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %" PetscInt_FMT,i);
898     PetscCall(ISGetIndices(eedges[i],&idxs));
899     PetscCall(PetscBTMemzero(nv,btvc));
900     for (j=0;j<size;j++) {
901       PetscInt k,ee = idxs[j];
902       for (k=ii[ee];k<ii[ee+1];k++) {
903         PetscInt vv = jj[k];
904         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
905         else if (!PetscBTLookupSet(btvc,vv)) found++;
906       }
907     }
908     PetscCall(ISRestoreIndices(eedges[i],&idxs));
909     PetscCall(PetscSortRemoveDupsInt(&cum,extrow));
910     PetscCall(ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs));
911     PetscCall(PetscSortIntWithArray(cum,gidxs,extrow));
912     PetscCall(ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]));
913     /* it may happen that endpoints are not defined at this point
914        if it is the case, mark this edge for a second pass */
915     if (cum != size -1 || found != 2) {
916       PetscCall(PetscBTSet(bter,i));
917       if (print) {
918         PetscCall(PetscObjectSetName((PetscObject)eedges[i],"error_edge"));
919         PetscCall(ISView(eedges[i],NULL));
920         PetscCall(PetscObjectSetName((PetscObject)extcols[i],"error_extcol"));
921         PetscCall(ISView(extcols[i],NULL));
922       }
923       eerr = PETSC_TRUE;
924     }
925   }
926   /* PetscCheck(!eerr,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
927   PetscCall(MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm));
928   if (done) {
929     PetscInt *newprimals;
930 
931     PetscCall(PetscMalloc1(ne,&newprimals));
932     PetscCall(ISGetLocalSize(primals,&cum));
933     PetscCall(ISGetIndices(primals,&idxs));
934     PetscCall(PetscArraycpy(newprimals,idxs,cum));
935     PetscCall(ISRestoreIndices(primals,&idxs));
936     PetscCall(MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done));
937     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %s)\n",PetscBools[eerr]);
938     for (i=0;i<nee;i++) {
939       PetscBool has_candidates = PETSC_FALSE;
940       if (PetscBTLookup(bter,i)) {
941         PetscInt size,mark = i+1;
942 
943         PetscCall(ISGetLocalSize(eedges[i],&size));
944         PetscCall(ISGetIndices(eedges[i],&idxs));
945         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
946         for (j=0;j<size;j++) {
947           PetscInt k,ee = idxs[j];
948           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %" PetscInt_FMT " [%" PetscInt_FMT " %" PetscInt_FMT ")\n",ee,ii[ee],ii[ee+1]);
949           for (k=ii[ee];k<ii[ee+1];k++) {
950             /* set all candidates located on the edge as corners */
951             if (PetscBTLookup(btvcand,jj[k])) {
952               PetscInt k2,vv = jj[k];
953               has_candidates = PETSC_TRUE;
954               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %" PetscInt_FMT "\n",vv);
955               PetscCall(PetscBTSet(btv,vv));
956               /* set all edge dofs connected to candidate as primals */
957               for (k2=iit[vv];k2<iit[vv+1];k2++) {
958                 if (marks[jjt[k2]] == mark) {
959                   PetscInt k3,ee2 = jjt[k2];
960                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %" PetscInt_FMT "\n",ee2);
961                   newprimals[cum++] = ee2;
962                   /* finally set the new corners */
963                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
964                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %" PetscInt_FMT "\n",jj[k3]);
965                     PetscCall(PetscBTSet(btv,jj[k3]));
966                   }
967                 }
968               }
969             } else {
970               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %" PetscInt_FMT "\n",jj[k]);
971             }
972           }
973         }
974         if (!has_candidates) { /* circular edge */
975           PetscInt k, ee = idxs[0],*tmarks;
976 
977           PetscCall(PetscCalloc1(ne,&tmarks));
978           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %" PetscInt_FMT "\n",i);
979           for (k=ii[ee];k<ii[ee+1];k++) {
980             PetscInt k2;
981             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %" PetscInt_FMT "\n",jj[k]);
982             PetscCall(PetscBTSet(btv,jj[k]));
983             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
984           }
985           for (j=0;j<size;j++) {
986             if (tmarks[idxs[j]] > 1) {
987               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %" PetscInt_FMT "\n",idxs[j]);
988               newprimals[cum++] = idxs[j];
989             }
990           }
991           PetscCall(PetscFree(tmarks));
992         }
993         PetscCall(ISRestoreIndices(eedges[i],&idxs));
994       }
995       PetscCall(ISDestroy(&extcols[i]));
996     }
997     PetscCall(PetscFree(extcols));
998     PetscCall(MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done));
999     PetscCall(PetscSortRemoveDupsInt(&cum,newprimals));
1000     if (fl2g) {
1001       PetscCall(ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals));
1002       PetscCall(ISDestroy(&primals));
1003       for (i=0;i<nee;i++) {
1004         PetscCall(ISDestroy(&eedges[i]));
1005       }
1006       PetscCall(PetscFree(eedges));
1007     }
1008     PetscCall(PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals));
1009     PetscCall(ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals));
1010     PetscCall(PetscFree(newprimals));
1011     PetscCall(PCBDDCSetPrimalVerticesLocalIS(pc,primals));
1012     PetscCall(ISDestroy(&primals));
1013     PetscCall(PCBDDCAnalyzeInterface(pc));
1014     pcbddc->mat_graph->twodim = PETSC_FALSE;
1015     PetscCall(PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals));
1016     if (fl2g) {
1017       PetscCall(ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals));
1018       PetscCall(PetscMalloc1(nee,&eedges));
1019       for (i=0;i<nee;i++) {
1020         PetscCall(ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]));
1021       }
1022     } else {
1023       eedges  = alleedges;
1024       primals = allprimals;
1025     }
1026     PetscCall(PetscCalloc1(nee,&extcols));
1027 
1028     /* Mark again */
1029     PetscCall(PetscArrayzero(marks,ne));
1030     for (i=0;i<nee;i++) {
1031       PetscInt size,mark = i+1;
1032 
1033       PetscCall(ISGetLocalSize(eedges[i],&size));
1034       PetscCall(ISGetIndices(eedges[i],&idxs));
1035       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1036       PetscCall(ISRestoreIndices(eedges[i],&idxs));
1037     }
1038     if (print) {
1039       PetscCall(PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass"));
1040       PetscCall(ISView(primals,NULL));
1041     }
1042 
1043     /* Recompute extended cols */
1044     eerr = PETSC_FALSE;
1045     for (i=0;i<nee;i++) {
1046       PetscInt size;
1047 
1048       cum  = 0;
1049       PetscCall(ISGetLocalSize(eedges[i],&size));
1050       if (!size && nedfieldlocal) continue;
1051       PetscCheck(size,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %" PetscInt_FMT,i);
1052       PetscCall(ISGetIndices(eedges[i],&idxs));
1053       for (j=0;j<size;j++) {
1054         PetscInt k,ee = idxs[j];
1055         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1056       }
1057       PetscCall(ISRestoreIndices(eedges[i],&idxs));
1058       PetscCall(PetscSortRemoveDupsInt(&cum,extrow));
1059       PetscCall(ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs));
1060       PetscCall(PetscSortIntWithArray(cum,gidxs,extrow));
1061       PetscCall(ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]));
1062       if (cum != size -1) {
1063         if (print) {
1064           PetscCall(PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass"));
1065           PetscCall(ISView(eedges[i],NULL));
1066           PetscCall(PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass"));
1067           PetscCall(ISView(extcols[i],NULL));
1068         }
1069         eerr = PETSC_TRUE;
1070       }
1071     }
1072   }
1073   PetscCall(MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
1074   PetscCall(PetscFree2(extrow,gidxs));
1075   PetscCall(PetscBTDestroy(&bter));
1076   if (print) PetscCall(PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF));
1077   /* an error should not occur at this point */
1078   PetscCheck(!eerr,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1079 
1080   /* Check the number of endpoints */
1081   PetscCall(MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
1082   PetscCall(PetscMalloc1(2*nee,&corners));
1083   PetscCall(PetscMalloc1(nee,&cedges));
1084   for (i=0;i<nee;i++) {
1085     PetscInt size, found = 0, gc[2];
1086 
1087     /* init with defaults */
1088     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1089     PetscCall(ISGetLocalSize(eedges[i],&size));
1090     if (!size && nedfieldlocal) continue;
1091     PetscCheck(size,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %" PetscInt_FMT,i);
1092     PetscCall(ISGetIndices(eedges[i],&idxs));
1093     PetscCall(PetscBTMemzero(nv,btvc));
1094     for (j=0;j<size;j++) {
1095       PetscInt k,ee = idxs[j];
1096       for (k=ii[ee];k<ii[ee+1];k++) {
1097         PetscInt vv = jj[k];
1098         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1099           PetscCheck(found != 2,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %" PetscInt_FMT,i);
1100           corners[i*2+found++] = vv;
1101         }
1102       }
1103     }
1104     if (found != 2) {
1105       PetscInt e;
1106       if (fl2g) {
1107         PetscCall(ISLocalToGlobalMappingApply(fl2g,1,idxs,&e));
1108       } else {
1109         e = idxs[0];
1110       }
1111       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %" PetscInt_FMT " corners for edge %" PetscInt_FMT " (astart %" PetscInt_FMT ", estart %" PetscInt_FMT ")",found,i,e,idxs[0]);
1112     }
1113 
1114     /* get primal dof index on this coarse edge */
1115     PetscCall(ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc));
1116     if (gc[0] > gc[1]) {
1117       PetscInt swap  = corners[2*i];
1118       corners[2*i]   = corners[2*i+1];
1119       corners[2*i+1] = swap;
1120     }
1121     cedges[i] = idxs[size-1];
1122     PetscCall(ISRestoreIndices(eedges[i],&idxs));
1123     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %" PetscInt_FMT ": ce %" PetscInt_FMT ", corners (%" PetscInt_FMT ",%" PetscInt_FMT ")\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1124   }
1125   PetscCall(MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
1126   PetscCall(PetscBTDestroy(&btvc));
1127 
1128   if (PetscDefined(USE_DEBUG)) {
1129     /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1130      not interfere with neighbouring coarse edges */
1131     PetscCall(PetscMalloc1(nee+1,&emarks));
1132     PetscCall(MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
1133     for (i=0;i<nv;i++) {
1134       PetscInt emax = 0,eemax = 0;
1135 
1136       if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1137       PetscCall(PetscArrayzero(emarks,nee+1));
1138       for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1139       for (j=1;j<nee+1;j++) {
1140         if (emax < emarks[j]) {
1141           emax = emarks[j];
1142           eemax = j;
1143         }
1144       }
1145       /* not relevant for edges */
1146       if (!eemax) continue;
1147 
1148       for (j=ii[i];j<ii[i+1];j++) {
1149         PetscCheck(!marks[jj[j]] || marks[jj[j]] == eemax,PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %" PetscInt_FMT " and %" PetscInt_FMT ") connected through the %" PetscInt_FMT " nodal dof at edge dof %" PetscInt_FMT,marks[jj[j]]-1,eemax,i,jj[j]);
1150       }
1151     }
1152     PetscCall(PetscFree(emarks));
1153     PetscCall(MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
1154   }
1155 
1156   /* Compute extended rows indices for edge blocks of the change of basis */
1157   PetscCall(MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
1158   PetscCall(MatSeqAIJGetMaxRowNonzeros(lGt,&extmem));
1159   extmem *= maxsize;
1160   PetscCall(PetscMalloc1(extmem*nee,&extrow));
1161   PetscCall(PetscMalloc1(nee,&extrows));
1162   PetscCall(PetscCalloc1(nee,&extrowcum));
1163   for (i=0;i<nv;i++) {
1164     PetscInt mark = 0,size,start;
1165 
1166     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1167     for (j=ii[i];j<ii[i+1];j++)
1168       if (marks[jj[j]] && !mark)
1169         mark = marks[jj[j]];
1170 
1171     /* not relevant */
1172     if (!mark) continue;
1173 
1174     /* import extended row */
1175     mark--;
1176     start = mark*extmem+extrowcum[mark];
1177     size = ii[i+1]-ii[i];
1178     PetscCheck(extrowcum[mark] + size <= extmem,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %" PetscInt_FMT " > %" PetscInt_FMT,extrowcum[mark] + size,extmem);
1179     PetscCall(PetscArraycpy(extrow+start,jj+ii[i],size));
1180     extrowcum[mark] += size;
1181   }
1182   PetscCall(MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done));
1183   PetscCall(MatDestroy(&lGt));
1184   PetscCall(PetscFree(marks));
1185 
1186   /* Compress extrows */
1187   cum  = 0;
1188   for (i=0;i<nee;i++) {
1189     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1190     PetscCall(PetscSortRemoveDupsInt(&size,start));
1191     PetscCall(ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]));
1192     cum  = PetscMax(cum,size);
1193   }
1194   PetscCall(PetscFree(extrowcum));
1195   PetscCall(PetscBTDestroy(&btv));
1196   PetscCall(PetscBTDestroy(&btvcand));
1197 
1198   /* Workspace for lapack inner calls and VecSetValues */
1199   PetscCall(PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork));
1200 
1201   /* Create change of basis matrix (preallocation can be improved) */
1202   PetscCall(MatCreate(comm,&T));
1203   PetscCall(MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,pc->pmat->rmap->N,pc->pmat->rmap->N));
1204   PetscCall(MatSetType(T,MATAIJ));
1205   PetscCall(MatSeqAIJSetPreallocation(T,10,NULL));
1206   PetscCall(MatMPIAIJSetPreallocation(T,10,NULL,10,NULL));
1207   PetscCall(MatSetLocalToGlobalMapping(T,al2g,al2g));
1208   PetscCall(MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE));
1209   PetscCall(MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE));
1210   PetscCall(ISLocalToGlobalMappingDestroy(&al2g));
1211 
1212   /* Defaults to identity */
1213   PetscCall(MatCreateVecs(pc->pmat,&tvec,NULL));
1214   PetscCall(VecSet(tvec,1.0));
1215   PetscCall(MatDiagonalSet(T,tvec,INSERT_VALUES));
1216   PetscCall(VecDestroy(&tvec));
1217 
1218   /* Create discrete gradient for the coarser level if needed */
1219   PetscCall(MatDestroy(&pcbddc->nedcG));
1220   PetscCall(ISDestroy(&pcbddc->nedclocal));
1221   if (pcbddc->current_level < pcbddc->max_levels) {
1222     ISLocalToGlobalMapping cel2g,cvl2g;
1223     IS                     wis,gwis;
1224     PetscInt               cnv,cne;
1225 
1226     PetscCall(ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis));
1227     if (fl2g) {
1228       PetscCall(ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal));
1229     } else {
1230       PetscCall(PetscObjectReference((PetscObject)wis));
1231       pcbddc->nedclocal = wis;
1232     }
1233     PetscCall(ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis));
1234     PetscCall(ISDestroy(&wis));
1235     PetscCall(ISRenumber(gwis,NULL,&cne,&wis));
1236     PetscCall(ISLocalToGlobalMappingCreateIS(wis,&cel2g));
1237     PetscCall(ISDestroy(&wis));
1238     PetscCall(ISDestroy(&gwis));
1239 
1240     PetscCall(ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis));
1241     PetscCall(ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis));
1242     PetscCall(ISDestroy(&wis));
1243     PetscCall(ISRenumber(gwis,NULL,&cnv,&wis));
1244     PetscCall(ISLocalToGlobalMappingCreateIS(wis,&cvl2g));
1245     PetscCall(ISDestroy(&wis));
1246     PetscCall(ISDestroy(&gwis));
1247 
1248     PetscCall(MatCreate(comm,&pcbddc->nedcG));
1249     PetscCall(MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv));
1250     PetscCall(MatSetType(pcbddc->nedcG,MATAIJ));
1251     PetscCall(MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL));
1252     PetscCall(MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL));
1253     PetscCall(MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g));
1254     PetscCall(ISLocalToGlobalMappingDestroy(&cel2g));
1255     PetscCall(ISLocalToGlobalMappingDestroy(&cvl2g));
1256   }
1257   PetscCall(ISLocalToGlobalMappingDestroy(&vl2g));
1258 
1259 #if defined(PRINT_GDET)
1260   inc = 0;
1261   lev = pcbddc->current_level;
1262 #endif
1263 
1264   /* Insert values in the change of basis matrix */
1265   for (i=0;i<nee;i++) {
1266     Mat         Gins = NULL, GKins = NULL;
1267     IS          cornersis = NULL;
1268     PetscScalar cvals[2];
1269 
1270     if (pcbddc->nedcG) {
1271       PetscCall(ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis));
1272     }
1273     PetscCall(PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork));
1274     if (Gins && GKins) {
1275       const PetscScalar *data;
1276       const PetscInt    *rows,*cols;
1277       PetscInt          nrh,nch,nrc,ncc;
1278 
1279       PetscCall(ISGetIndices(eedges[i],&cols));
1280       /* H1 */
1281       PetscCall(ISGetIndices(extrows[i],&rows));
1282       PetscCall(MatGetSize(Gins,&nrh,&nch));
1283       PetscCall(MatDenseGetArrayRead(Gins,&data));
1284       PetscCall(MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES));
1285       PetscCall(MatDenseRestoreArrayRead(Gins,&data));
1286       PetscCall(ISRestoreIndices(extrows[i],&rows));
1287       /* complement */
1288       PetscCall(MatGetSize(GKins,&nrc,&ncc));
1289       PetscCheck(ncc,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %" PetscInt_FMT,i);
1290       PetscCheck(ncc + nch == nrc,PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %" PetscInt_FMT " and Gins %" PetscInt_FMT " does not match %" PetscInt_FMT " for coarse edge %" PetscInt_FMT,ncc,nch,nrc,i);
1291       PetscCheck(ncc == 1 || !pcbddc->nedcG,PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %" PetscInt_FMT " with ncc %" PetscInt_FMT,i,ncc);
1292       PetscCall(MatDenseGetArrayRead(GKins,&data));
1293       PetscCall(MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES));
1294       PetscCall(MatDenseRestoreArrayRead(GKins,&data));
1295 
1296       /* coarse discrete gradient */
1297       if (pcbddc->nedcG) {
1298         PetscInt cols[2];
1299 
1300         cols[0] = 2*i;
1301         cols[1] = 2*i+1;
1302         PetscCall(MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES));
1303       }
1304       PetscCall(ISRestoreIndices(eedges[i],&cols));
1305     }
1306     PetscCall(ISDestroy(&extrows[i]));
1307     PetscCall(ISDestroy(&extcols[i]));
1308     PetscCall(ISDestroy(&cornersis));
1309     PetscCall(MatDestroy(&Gins));
1310     PetscCall(MatDestroy(&GKins));
1311   }
1312   PetscCall(ISLocalToGlobalMappingDestroy(&el2g));
1313 
1314   /* Start assembling */
1315   PetscCall(MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY));
1316   if (pcbddc->nedcG) PetscCall(MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY));
1317 
1318   /* Free */
1319   if (fl2g) {
1320     PetscCall(ISDestroy(&primals));
1321     for (i=0;i<nee;i++) {
1322       PetscCall(ISDestroy(&eedges[i]));
1323     }
1324     PetscCall(PetscFree(eedges));
1325   }
1326 
1327   /* hack mat_graph with primal dofs on the coarse edges */
1328   {
1329     PCBDDCGraph graph   = pcbddc->mat_graph;
1330     PetscInt    *oqueue = graph->queue;
1331     PetscInt    *ocptr  = graph->cptr;
1332     PetscInt    ncc,*idxs;
1333 
1334     /* find first primal edge */
1335     if (pcbddc->nedclocal) {
1336       PetscCall(ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs));
1337     } else {
1338       if (fl2g) PetscCall(ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges));
1339       idxs = cedges;
1340     }
1341     cum = 0;
1342     while (cum < nee && cedges[cum] < 0) cum++;
1343 
1344     /* adapt connected components */
1345     PetscCall(PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue));
1346     graph->cptr[0] = 0;
1347     for (i=0,ncc=0;i<graph->ncc;i++) {
1348       PetscInt lc = ocptr[i+1]-ocptr[i];
1349       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1350         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1351         graph->queue[graph->cptr[ncc]] = cedges[cum];
1352         ncc++;
1353         lc--;
1354         cum++;
1355         while (cum < nee && cedges[cum] < 0) cum++;
1356       }
1357       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1358       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1359       ncc++;
1360     }
1361     graph->ncc = ncc;
1362     if (pcbddc->nedclocal) {
1363       PetscCall(ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs));
1364     }
1365     PetscCall(PetscFree2(ocptr,oqueue));
1366   }
1367   PetscCall(ISLocalToGlobalMappingDestroy(&fl2g));
1368   PetscCall(PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals));
1369   PetscCall(PCBDDCGraphResetCSR(pcbddc->mat_graph));
1370   PetscCall(MatDestroy(&conn));
1371 
1372   PetscCall(ISDestroy(&nedfieldlocal));
1373   PetscCall(PetscFree(extrow));
1374   PetscCall(PetscFree2(work,rwork));
1375   PetscCall(PetscFree(corners));
1376   PetscCall(PetscFree(cedges));
1377   PetscCall(PetscFree(extrows));
1378   PetscCall(PetscFree(extcols));
1379   PetscCall(MatDestroy(&lG));
1380 
1381   /* Complete assembling */
1382   PetscCall(MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY));
1383   if (pcbddc->nedcG) {
1384     PetscCall(MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY));
1385 #if 0
1386     PetscCall(PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G"));
1387     PetscCall(MatView(pcbddc->nedcG,NULL));
1388 #endif
1389   }
1390 
1391   /* set change of basis */
1392   PetscCall(PCBDDCSetChangeOfBasisMat(pc,T,singular));
1393   PetscCall(MatDestroy(&T));
1394 
1395   PetscFunctionReturn(0);
1396 }
1397 
1398 /* the near-null space of BDDC carries information on quadrature weights,
1399    and these can be collinear -> so cheat with MatNullSpaceCreate
1400    and create a suitable set of basis vectors first */
1401 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1402 {
1403   PetscInt       i;
1404 
1405   PetscFunctionBegin;
1406   for (i=0;i<nvecs;i++) {
1407     PetscInt first,last;
1408 
1409     PetscCall(VecGetOwnershipRange(quad_vecs[i],&first,&last));
1410     PetscCheck(last-first >= 2*nvecs || !has_const,PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1411     if (i>=first && i < last) {
1412       PetscScalar *data;
1413       PetscCall(VecGetArray(quad_vecs[i],&data));
1414       if (!has_const) {
1415         data[i-first] = 1.;
1416       } else {
1417         data[2*i-first] = 1./PetscSqrtReal(2.);
1418         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1419       }
1420       PetscCall(VecRestoreArray(quad_vecs[i],&data));
1421     }
1422     PetscCall(PetscObjectStateIncrease((PetscObject)quad_vecs[i]));
1423   }
1424   PetscCall(MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp));
1425   for (i=0;i<nvecs;i++) { /* reset vectors */
1426     PetscInt first,last;
1427     PetscCall(VecLockReadPop(quad_vecs[i]));
1428     PetscCall(VecGetOwnershipRange(quad_vecs[i],&first,&last));
1429     if (i>=first && i < last) {
1430       PetscScalar *data;
1431       PetscCall(VecGetArray(quad_vecs[i],&data));
1432       if (!has_const) {
1433         data[i-first] = 0.;
1434       } else {
1435         data[2*i-first] = 0.;
1436         data[2*i-first+1] = 0.;
1437       }
1438       PetscCall(VecRestoreArray(quad_vecs[i],&data));
1439     }
1440     PetscCall(PetscObjectStateIncrease((PetscObject)quad_vecs[i]));
1441     PetscCall(VecLockReadPush(quad_vecs[i]));
1442   }
1443   PetscFunctionReturn(0);
1444 }
1445 
1446 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1447 {
1448   Mat                    loc_divudotp;
1449   Vec                    p,v,vins,quad_vec,*quad_vecs;
1450   ISLocalToGlobalMapping map;
1451   PetscScalar            *vals;
1452   const PetscScalar      *array;
1453   PetscInt               i,maxneighs = 0,maxsize,*gidxs;
1454   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1455   PetscMPIInt            rank;
1456 
1457   PetscFunctionBegin;
1458   PetscCall(ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared));
1459   for (i=0;i<n_neigh;i++) maxneighs = PetscMax(graph->count[shared[i][0]]+1,maxneighs);
1460   PetscCall(MPIU_Allreduce(MPI_IN_PLACE,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A)));
1461   if (!maxneighs) {
1462     PetscCall(ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared));
1463     *nnsp = NULL;
1464     PetscFunctionReturn(0);
1465   }
1466   maxsize = 0;
1467   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1468   PetscCall(PetscMalloc2(maxsize,&gidxs,maxsize,&vals));
1469   /* create vectors to hold quadrature weights */
1470   PetscCall(MatCreateVecs(A,&quad_vec,NULL));
1471   if (!transpose) {
1472     PetscCall(MatISGetLocalToGlobalMapping(A,&map,NULL));
1473   } else {
1474     PetscCall(MatISGetLocalToGlobalMapping(A,NULL,&map));
1475   }
1476   PetscCall(VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs));
1477   PetscCall(VecDestroy(&quad_vec));
1478   PetscCall(PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp));
1479   for (i=0;i<maxneighs;i++) {
1480     PetscCall(VecLockReadPop(quad_vecs[i]));
1481   }
1482 
1483   /* compute local quad vec */
1484   PetscCall(MatISGetLocalMat(divudotp,&loc_divudotp));
1485   if (!transpose) {
1486     PetscCall(MatCreateVecs(loc_divudotp,&v,&p));
1487   } else {
1488     PetscCall(MatCreateVecs(loc_divudotp,&p,&v));
1489   }
1490   PetscCall(VecSet(p,1.));
1491   if (!transpose) {
1492     PetscCall(MatMultTranspose(loc_divudotp,p,v));
1493   } else {
1494     PetscCall(MatMult(loc_divudotp,p,v));
1495   }
1496   if (vl2l) {
1497     Mat        lA;
1498     VecScatter sc;
1499 
1500     PetscCall(MatISGetLocalMat(A,&lA));
1501     PetscCall(MatCreateVecs(lA,&vins,NULL));
1502     PetscCall(VecScatterCreate(v,NULL,vins,vl2l,&sc));
1503     PetscCall(VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD));
1504     PetscCall(VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD));
1505     PetscCall(VecScatterDestroy(&sc));
1506   } else {
1507     vins = v;
1508   }
1509   PetscCall(VecGetArrayRead(vins,&array));
1510   PetscCall(VecDestroy(&p));
1511 
1512   /* insert in global quadrature vecs */
1513   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank));
1514   for (i=1;i<n_neigh;i++) {
1515     const PetscInt    *idxs;
1516     PetscInt          idx,nn,j;
1517 
1518     idxs = shared[i];
1519     nn   = n_shared[i];
1520     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1521     PetscCall(PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx));
1522     idx  = -(idx+1);
1523     PetscCheck(idx >= 0 && idx < maxneighs,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Invalid index %" PetscInt_FMT " not in [0,%" PetscInt_FMT ")",idx,maxneighs);
1524     PetscCall(ISLocalToGlobalMappingApply(map,nn,idxs,gidxs));
1525     PetscCall(VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES));
1526   }
1527   PetscCall(ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared));
1528   PetscCall(VecRestoreArrayRead(vins,&array));
1529   if (vl2l) {
1530     PetscCall(VecDestroy(&vins));
1531   }
1532   PetscCall(VecDestroy(&v));
1533   PetscCall(PetscFree2(gidxs,vals));
1534 
1535   /* assemble near null space */
1536   for (i=0;i<maxneighs;i++) {
1537     PetscCall(VecAssemblyBegin(quad_vecs[i]));
1538   }
1539   for (i=0;i<maxneighs;i++) {
1540     PetscCall(VecAssemblyEnd(quad_vecs[i]));
1541     PetscCall(VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view"));
1542     PetscCall(VecLockReadPush(quad_vecs[i]));
1543   }
1544   PetscCall(VecDestroyVecs(maxneighs,&quad_vecs));
1545   PetscFunctionReturn(0);
1546 }
1547 
1548 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1549 {
1550   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1551 
1552   PetscFunctionBegin;
1553   if (primalv) {
1554     if (pcbddc->user_primal_vertices_local) {
1555       IS list[2], newp;
1556 
1557       list[0] = primalv;
1558       list[1] = pcbddc->user_primal_vertices_local;
1559       PetscCall(ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp));
1560       PetscCall(ISSortRemoveDups(newp));
1561       PetscCall(ISDestroy(&list[1]));
1562       pcbddc->user_primal_vertices_local = newp;
1563     } else {
1564       PetscCall(PCBDDCSetPrimalVerticesLocalIS(pc,primalv));
1565     }
1566   }
1567   PetscFunctionReturn(0);
1568 }
1569 
1570 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1571 {
1572   PetscInt f, *comp  = (PetscInt *)ctx;
1573 
1574   PetscFunctionBegin;
1575   for (f=0;f<Nf;f++) out[f] = X[*comp];
1576   PetscFunctionReturn(0);
1577 }
1578 
1579 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1580 {
1581   Vec            local,global;
1582   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1583   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1584   PetscBool      monolithic = PETSC_FALSE;
1585 
1586   PetscFunctionBegin;
1587   PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");
1588   PetscCall(PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL));
1589   PetscOptionsEnd();
1590   /* need to convert from global to local topology information and remove references to information in global ordering */
1591   PetscCall(MatCreateVecs(pc->pmat,&global,NULL));
1592   PetscCall(MatCreateVecs(matis->A,&local,NULL));
1593   PetscCall(VecBindToCPU(global,PETSC_TRUE));
1594   PetscCall(VecBindToCPU(local,PETSC_TRUE));
1595   if (monolithic) { /* just get block size to properly compute vertices */
1596     if (pcbddc->vertex_size == 1) {
1597       PetscCall(MatGetBlockSize(pc->pmat,&pcbddc->vertex_size));
1598     }
1599     goto boundary;
1600   }
1601 
1602   if (pcbddc->user_provided_isfordofs) {
1603     if (pcbddc->n_ISForDofs) {
1604       PetscInt i;
1605 
1606       PetscCall(PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal));
1607       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1608         PetscInt bs;
1609 
1610         PetscCall(PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]));
1611         PetscCall(ISGetBlockSize(pcbddc->ISForDofs[i],&bs));
1612         PetscCall(ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs));
1613         PetscCall(ISDestroy(&pcbddc->ISForDofs[i]));
1614       }
1615       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1616       pcbddc->n_ISForDofs = 0;
1617       PetscCall(PetscFree(pcbddc->ISForDofs));
1618     }
1619   } else {
1620     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1621       DM dm;
1622 
1623       PetscCall(MatGetDM(pc->pmat, &dm));
1624       if (!dm) {
1625         PetscCall(PCGetDM(pc, &dm));
1626       }
1627       if (dm) {
1628         IS      *fields;
1629         PetscInt nf,i;
1630 
1631         PetscCall(DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL));
1632         PetscCall(PetscMalloc1(nf,&pcbddc->ISForDofsLocal));
1633         for (i=0;i<nf;i++) {
1634           PetscInt bs;
1635 
1636           PetscCall(PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]));
1637           PetscCall(ISGetBlockSize(fields[i],&bs));
1638           PetscCall(ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs));
1639           PetscCall(ISDestroy(&fields[i]));
1640         }
1641         PetscCall(PetscFree(fields));
1642         pcbddc->n_ISForDofsLocal = nf;
1643       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1644         PetscContainer   c;
1645 
1646         PetscCall(PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c));
1647         if (c) {
1648           MatISLocalFields lf;
1649           PetscCall(PetscContainerGetPointer(c,(void**)&lf));
1650           PetscCall(PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf));
1651         } else { /* fallback, create the default fields if bs > 1 */
1652           PetscInt i, n = matis->A->rmap->n;
1653           PetscCall(MatGetBlockSize(pc->pmat,&i));
1654           if (i > 1) {
1655             pcbddc->n_ISForDofsLocal = i;
1656             PetscCall(PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal));
1657             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1658               PetscCall(ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]));
1659             }
1660           }
1661         }
1662       }
1663     } else {
1664       PetscInt i;
1665       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1666         PetscCall(PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]));
1667       }
1668     }
1669   }
1670 
1671 boundary:
1672   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1673     PetscCall(PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal));
1674   } else if (pcbddc->DirichletBoundariesLocal) {
1675     PetscCall(PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal));
1676   }
1677   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1678     PetscCall(PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal));
1679   } else if (pcbddc->NeumannBoundariesLocal) {
1680     PetscCall(PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal));
1681   }
1682   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1683     PetscCall(PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local));
1684   }
1685   PetscCall(VecDestroy(&global));
1686   PetscCall(VecDestroy(&local));
1687   /* detect local disconnected subdomains if requested (use matis->A) */
1688   if (pcbddc->detect_disconnected) {
1689     IS        primalv = NULL;
1690     PetscInt  i;
1691     PetscBool filter = pcbddc->detect_disconnected_filter;
1692 
1693     for (i=0;i<pcbddc->n_local_subs;i++) {
1694       PetscCall(ISDestroy(&pcbddc->local_subs[i]));
1695     }
1696     PetscCall(PetscFree(pcbddc->local_subs));
1697     PetscCall(PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv));
1698     PetscCall(PCBDDCAddPrimalVerticesLocalIS(pc,primalv));
1699     PetscCall(ISDestroy(&primalv));
1700   }
1701   /* early stage corner detection */
1702   {
1703     DM dm;
1704 
1705     PetscCall(MatGetDM(pc->pmat,&dm));
1706     if (!dm) {
1707       PetscCall(PCGetDM(pc,&dm));
1708     }
1709     if (dm) {
1710       PetscBool isda;
1711 
1712       PetscCall(PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda));
1713       if (isda) {
1714         ISLocalToGlobalMapping l2l;
1715         IS                     corners;
1716         Mat                    lA;
1717         PetscBool              gl,lo;
1718 
1719         {
1720           Vec               cvec;
1721           const PetscScalar *coords;
1722           PetscInt          dof,n,cdim;
1723           PetscBool         memc = PETSC_TRUE;
1724 
1725           PetscCall(DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL));
1726           PetscCall(DMGetCoordinates(dm,&cvec));
1727           PetscCall(VecGetLocalSize(cvec,&n));
1728           PetscCall(VecGetBlockSize(cvec,&cdim));
1729           n   /= cdim;
1730           PetscCall(PetscFree(pcbddc->mat_graph->coords));
1731           PetscCall(PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords));
1732           PetscCall(VecGetArrayRead(cvec,&coords));
1733 #if defined(PETSC_USE_COMPLEX)
1734           memc = PETSC_FALSE;
1735 #endif
1736           if (dof != 1) memc = PETSC_FALSE;
1737           if (memc) {
1738             PetscCall(PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof));
1739           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1740             PetscReal *bcoords = pcbddc->mat_graph->coords;
1741             PetscInt  i, b, d;
1742 
1743             for (i=0;i<n;i++) {
1744               for (b=0;b<dof;b++) {
1745                 for (d=0;d<cdim;d++) {
1746                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1747                 }
1748               }
1749             }
1750           }
1751           PetscCall(VecRestoreArrayRead(cvec,&coords));
1752           pcbddc->mat_graph->cdim  = cdim;
1753           pcbddc->mat_graph->cnloc = dof*n;
1754           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1755         }
1756         PetscCall(DMDAGetSubdomainCornersIS(dm,&corners));
1757         PetscCall(MatISGetLocalMat(pc->pmat,&lA));
1758         PetscCall(MatGetLocalToGlobalMapping(lA,&l2l,NULL));
1759         PetscCall(MatISRestoreLocalMat(pc->pmat,&lA));
1760         lo   = (PetscBool)(l2l && corners);
1761         PetscCall(MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc)));
1762         if (gl) { /* From PETSc's DMDA */
1763           const PetscInt    *idx;
1764           PetscInt          dof,bs,*idxout,n;
1765 
1766           PetscCall(DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL));
1767           PetscCall(ISLocalToGlobalMappingGetBlockSize(l2l,&bs));
1768           PetscCall(ISGetLocalSize(corners,&n));
1769           PetscCall(ISGetIndices(corners,&idx));
1770           if (bs == dof) {
1771             PetscCall(PetscMalloc1(n,&idxout));
1772             PetscCall(ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout));
1773           } else { /* the original DMDA local-to-local map have been modified */
1774             PetscInt i,d;
1775 
1776             PetscCall(PetscMalloc1(dof*n,&idxout));
1777             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1778             PetscCall(ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout));
1779 
1780             bs = 1;
1781             n *= dof;
1782           }
1783           PetscCall(ISRestoreIndices(corners,&idx));
1784           PetscCall(DMDARestoreSubdomainCornersIS(dm,&corners));
1785           PetscCall(ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners));
1786           PetscCall(PCBDDCAddPrimalVerticesLocalIS(pc,corners));
1787           PetscCall(ISDestroy(&corners));
1788           pcbddc->corner_selected  = PETSC_TRUE;
1789           pcbddc->corner_selection = PETSC_TRUE;
1790         }
1791         if (corners) {
1792           PetscCall(DMDARestoreSubdomainCornersIS(dm,&corners));
1793         }
1794       }
1795     }
1796   }
1797   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1798     DM dm;
1799 
1800     PetscCall(MatGetDM(pc->pmat,&dm));
1801     if (!dm) {
1802       PetscCall(PCGetDM(pc,&dm));
1803     }
1804     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1805       Vec            vcoords;
1806       PetscSection   section;
1807       PetscReal      *coords;
1808       PetscInt       d,cdim,nl,nf,**ctxs;
1809       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1810       /* debug coordinates */
1811       PetscViewer       viewer;
1812       PetscBool         flg;
1813       PetscViewerFormat format;
1814       const char        *prefix;
1815 
1816       PetscCall(DMGetCoordinateDim(dm,&cdim));
1817       PetscCall(DMGetLocalSection(dm,&section));
1818       PetscCall(PetscSectionGetNumFields(section,&nf));
1819       PetscCall(DMCreateGlobalVector(dm,&vcoords));
1820       PetscCall(VecGetLocalSize(vcoords,&nl));
1821       PetscCall(PetscMalloc1(nl*cdim,&coords));
1822       PetscCall(PetscMalloc2(nf,&funcs,nf,&ctxs));
1823       PetscCall(PetscMalloc1(nf,&ctxs[0]));
1824       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1825       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1826 
1827       /* debug coordinates */
1828       PetscCall(PCGetOptionsPrefix(pc,&prefix));
1829       PetscCall(PetscOptionsGetViewer(PetscObjectComm((PetscObject)vcoords),((PetscObject)vcoords)->options,prefix,"-pc_bddc_coords_vec_view",&viewer,&format,&flg));
1830       if (flg) PetscCall(PetscViewerPushFormat(viewer,format));
1831       for (d=0;d<cdim;d++) {
1832         PetscInt          i;
1833         const PetscScalar *v;
1834         char              name[16];
1835 
1836         for (i=0;i<nf;i++) ctxs[i][0] = d;
1837         PetscCall(PetscSNPrintf(name,sizeof(name),"bddc_coords_%d",(int)d));
1838         PetscCall(PetscObjectSetName((PetscObject)vcoords,name));
1839         PetscCall(DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords));
1840         if (flg) PetscCall(VecView(vcoords,viewer));
1841         PetscCall(VecGetArrayRead(vcoords,&v));
1842         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1843         PetscCall(VecRestoreArrayRead(vcoords,&v));
1844       }
1845       PetscCall(VecDestroy(&vcoords));
1846       PetscCall(PCSetCoordinates(pc,cdim,nl,coords));
1847       PetscCall(PetscFree(coords));
1848       PetscCall(PetscFree(ctxs[0]));
1849       PetscCall(PetscFree2(funcs,ctxs));
1850       if (flg) {
1851         PetscCall(PetscViewerPopFormat(viewer));
1852         PetscCall(PetscViewerDestroy(&viewer));
1853       }
1854     }
1855   }
1856   PetscFunctionReturn(0);
1857 }
1858 
1859 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1860 {
1861   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1862   IS              nis;
1863   const PetscInt  *idxs;
1864   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1865 
1866   PetscFunctionBegin;
1867   PetscCheck(mop == MPI_LAND || mop == MPI_LOR,PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1868   if (mop == MPI_LAND) {
1869     /* init rootdata with true */
1870     for (i=0;i<pc->pmat->rmap->n;i++) matis->sf_rootdata[i] = 1;
1871   } else {
1872     PetscCall(PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n));
1873   }
1874   PetscCall(PetscArrayzero(matis->sf_leafdata,n));
1875   PetscCall(ISGetLocalSize(*is,&nd));
1876   PetscCall(ISGetIndices(*is,&idxs));
1877   for (i=0;i<nd;i++)
1878     if (-1 < idxs[i] && idxs[i] < n)
1879       matis->sf_leafdata[idxs[i]] = 1;
1880   PetscCall(ISRestoreIndices(*is,&idxs));
1881   PetscCall(PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,mop));
1882   PetscCall(PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,mop));
1883   PetscCall(PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE));
1884   PetscCall(PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE));
1885   if (mop == MPI_LAND) {
1886     PetscCall(PetscMalloc1(nd,&nidxs));
1887   } else {
1888     PetscCall(PetscMalloc1(n,&nidxs));
1889   }
1890   for (i=0,nnd=0;i<n;i++)
1891     if (matis->sf_leafdata[i])
1892       nidxs[nnd++] = i;
1893   PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis));
1894   PetscCall(ISDestroy(is));
1895   *is  = nis;
1896   PetscFunctionReturn(0);
1897 }
1898 
1899 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1900 {
1901   PC_IS             *pcis = (PC_IS*)(pc->data);
1902   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1903 
1904   PetscFunctionBegin;
1905   if (!pcbddc->benign_have_null) {
1906     PetscFunctionReturn(0);
1907   }
1908   if (pcbddc->ChangeOfBasisMatrix) {
1909     Vec swap;
1910 
1911     PetscCall(MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change));
1912     swap = pcbddc->work_change;
1913     pcbddc->work_change = r;
1914     r = swap;
1915   }
1916   PetscCall(VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD));
1917   PetscCall(VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD));
1918   PetscCall(PetscLogEventBegin(PC_BDDC_Solves[pcbddc->current_level][0],pc,0,0,0));
1919   PetscCall(KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D));
1920   PetscCall(PetscLogEventEnd(PC_BDDC_Solves[pcbddc->current_level][0],pc,0,0,0));
1921   PetscCall(KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D));
1922   PetscCall(VecSet(z,0.));
1923   PetscCall(VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE));
1924   PetscCall(VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE));
1925   if (pcbddc->ChangeOfBasisMatrix) {
1926     pcbddc->work_change = r;
1927     PetscCall(VecCopy(z,pcbddc->work_change));
1928     PetscCall(MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z));
1929   }
1930   PetscFunctionReturn(0);
1931 }
1932 
1933 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1934 {
1935   PCBDDCBenignMatMult_ctx ctx;
1936   PetscBool               apply_right,apply_left,reset_x;
1937 
1938   PetscFunctionBegin;
1939   PetscCall(MatShellGetContext(A,&ctx));
1940   if (transpose) {
1941     apply_right = ctx->apply_left;
1942     apply_left = ctx->apply_right;
1943   } else {
1944     apply_right = ctx->apply_right;
1945     apply_left = ctx->apply_left;
1946   }
1947   reset_x = PETSC_FALSE;
1948   if (apply_right) {
1949     const PetscScalar *ax;
1950     PetscInt          nl,i;
1951 
1952     PetscCall(VecGetLocalSize(x,&nl));
1953     PetscCall(VecGetArrayRead(x,&ax));
1954     PetscCall(PetscArraycpy(ctx->work,ax,nl));
1955     PetscCall(VecRestoreArrayRead(x,&ax));
1956     for (i=0;i<ctx->benign_n;i++) {
1957       PetscScalar    sum,val;
1958       const PetscInt *idxs;
1959       PetscInt       nz,j;
1960       PetscCall(ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz));
1961       PetscCall(ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs));
1962       sum = 0.;
1963       if (ctx->apply_p0) {
1964         val = ctx->work[idxs[nz-1]];
1965         for (j=0;j<nz-1;j++) {
1966           sum += ctx->work[idxs[j]];
1967           ctx->work[idxs[j]] += val;
1968         }
1969       } else {
1970         for (j=0;j<nz-1;j++) {
1971           sum += ctx->work[idxs[j]];
1972         }
1973       }
1974       ctx->work[idxs[nz-1]] -= sum;
1975       PetscCall(ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs));
1976     }
1977     PetscCall(VecPlaceArray(x,ctx->work));
1978     reset_x = PETSC_TRUE;
1979   }
1980   if (transpose) {
1981     PetscCall(MatMultTranspose(ctx->A,x,y));
1982   } else {
1983     PetscCall(MatMult(ctx->A,x,y));
1984   }
1985   if (reset_x) PetscCall(VecResetArray(x));
1986   if (apply_left) {
1987     PetscScalar *ay;
1988     PetscInt    i;
1989 
1990     PetscCall(VecGetArray(y,&ay));
1991     for (i=0;i<ctx->benign_n;i++) {
1992       PetscScalar    sum,val;
1993       const PetscInt *idxs;
1994       PetscInt       nz,j;
1995       PetscCall(ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz));
1996       PetscCall(ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs));
1997       val = -ay[idxs[nz-1]];
1998       if (ctx->apply_p0) {
1999         sum = 0.;
2000         for (j=0;j<nz-1;j++) {
2001           sum += ay[idxs[j]];
2002           ay[idxs[j]] += val;
2003         }
2004         ay[idxs[nz-1]] += sum;
2005       } else {
2006         for (j=0;j<nz-1;j++) {
2007           ay[idxs[j]] += val;
2008         }
2009         ay[idxs[nz-1]] = 0.;
2010       }
2011       PetscCall(ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs));
2012     }
2013     PetscCall(VecRestoreArray(y,&ay));
2014   }
2015   PetscFunctionReturn(0);
2016 }
2017 
2018 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2019 {
2020   PetscFunctionBegin;
2021   PetscCall(PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE));
2022   PetscFunctionReturn(0);
2023 }
2024 
2025 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2026 {
2027   PetscFunctionBegin;
2028   PetscCall(PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE));
2029   PetscFunctionReturn(0);
2030 }
2031 
2032 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2033 {
2034   PC_IS                   *pcis = (PC_IS*)pc->data;
2035   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2036   PCBDDCBenignMatMult_ctx ctx;
2037 
2038   PetscFunctionBegin;
2039   if (!restore) {
2040     Mat                A_IB,A_BI;
2041     PetscScalar        *work;
2042     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2043 
2044     PetscCheck(!pcbddc->benign_original_mat,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2045     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2046     PetscCall(PetscMalloc1(pcis->n,&work));
2047     PetscCall(MatCreate(PETSC_COMM_SELF,&A_IB));
2048     PetscCall(MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE));
2049     PetscCall(MatSetType(A_IB,MATSHELL));
2050     PetscCall(MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private));
2051     PetscCall(MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private));
2052     PetscCall(PetscNew(&ctx));
2053     PetscCall(MatShellSetContext(A_IB,ctx));
2054     ctx->apply_left = PETSC_TRUE;
2055     ctx->apply_right = PETSC_FALSE;
2056     ctx->apply_p0 = PETSC_FALSE;
2057     ctx->benign_n = pcbddc->benign_n;
2058     if (reuse) {
2059       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2060       ctx->free = PETSC_FALSE;
2061     } else { /* TODO: could be optimized for successive solves */
2062       ISLocalToGlobalMapping N_to_D;
2063       PetscInt               i;
2064 
2065       PetscCall(ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D));
2066       PetscCall(PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs));
2067       for (i=0;i<pcbddc->benign_n;i++) {
2068         PetscCall(ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]));
2069       }
2070       PetscCall(ISLocalToGlobalMappingDestroy(&N_to_D));
2071       ctx->free = PETSC_TRUE;
2072     }
2073     ctx->A = pcis->A_IB;
2074     ctx->work = work;
2075     PetscCall(MatSetUp(A_IB));
2076     PetscCall(MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY));
2077     PetscCall(MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY));
2078     pcis->A_IB = A_IB;
2079 
2080     /* A_BI as A_IB^T */
2081     PetscCall(MatCreateTranspose(A_IB,&A_BI));
2082     pcbddc->benign_original_mat = pcis->A_BI;
2083     pcis->A_BI = A_BI;
2084   } else {
2085     if (!pcbddc->benign_original_mat) {
2086       PetscFunctionReturn(0);
2087     }
2088     PetscCall(MatShellGetContext(pcis->A_IB,&ctx));
2089     PetscCall(MatDestroy(&pcis->A_IB));
2090     pcis->A_IB = ctx->A;
2091     ctx->A = NULL;
2092     PetscCall(MatDestroy(&pcis->A_BI));
2093     pcis->A_BI = pcbddc->benign_original_mat;
2094     pcbddc->benign_original_mat = NULL;
2095     if (ctx->free) {
2096       PetscInt i;
2097       for (i=0;i<ctx->benign_n;i++) {
2098         PetscCall(ISDestroy(&ctx->benign_zerodiag_subs[i]));
2099       }
2100       PetscCall(PetscFree(ctx->benign_zerodiag_subs));
2101     }
2102     PetscCall(PetscFree(ctx->work));
2103     PetscCall(PetscFree(ctx));
2104   }
2105   PetscFunctionReturn(0);
2106 }
2107 
2108 /* used just in bddc debug mode */
2109 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2110 {
2111   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2112   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2113   Mat            An;
2114 
2115   PetscFunctionBegin;
2116   PetscCall(MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An));
2117   PetscCall(MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL));
2118   if (is1) {
2119     PetscCall(MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B));
2120     PetscCall(MatDestroy(&An));
2121   } else {
2122     *B = An;
2123   }
2124   PetscFunctionReturn(0);
2125 }
2126 
2127 /* TODO: add reuse flag */
2128 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2129 {
2130   Mat            Bt;
2131   PetscScalar    *a,*bdata;
2132   const PetscInt *ii,*ij;
2133   PetscInt       m,n,i,nnz,*bii,*bij;
2134   PetscBool      flg_row;
2135 
2136   PetscFunctionBegin;
2137   PetscCall(MatGetSize(A,&n,&m));
2138   PetscCall(MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row));
2139   PetscCall(MatSeqAIJGetArray(A,&a));
2140   nnz = n;
2141   for (i=0;i<ii[n];i++) {
2142     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2143   }
2144   PetscCall(PetscMalloc1(n+1,&bii));
2145   PetscCall(PetscMalloc1(nnz,&bij));
2146   PetscCall(PetscMalloc1(nnz,&bdata));
2147   nnz = 0;
2148   bii[0] = 0;
2149   for (i=0;i<n;i++) {
2150     PetscInt j;
2151     for (j=ii[i];j<ii[i+1];j++) {
2152       PetscScalar entry = a[j];
2153       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2154         bij[nnz] = ij[j];
2155         bdata[nnz] = entry;
2156         nnz++;
2157       }
2158     }
2159     bii[i+1] = nnz;
2160   }
2161   PetscCall(MatSeqAIJRestoreArray(A,&a));
2162   PetscCall(MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt));
2163   PetscCall(MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row));
2164   {
2165     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2166     b->free_a = PETSC_TRUE;
2167     b->free_ij = PETSC_TRUE;
2168   }
2169   if (*B == A) {
2170     PetscCall(MatDestroy(&A));
2171   }
2172   *B = Bt;
2173   PetscFunctionReturn(0);
2174 }
2175 
2176 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2177 {
2178   Mat                    B = NULL;
2179   DM                     dm;
2180   IS                     is_dummy,*cc_n;
2181   ISLocalToGlobalMapping l2gmap_dummy;
2182   PCBDDCGraph            graph;
2183   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2184   PetscInt               i,n;
2185   PetscInt               *xadj,*adjncy;
2186   PetscBool              isplex = PETSC_FALSE;
2187 
2188   PetscFunctionBegin;
2189   if (ncc) *ncc = 0;
2190   if (cc) *cc = NULL;
2191   if (primalv) *primalv = NULL;
2192   PetscCall(PCBDDCGraphCreate(&graph));
2193   PetscCall(MatGetDM(pc->pmat,&dm));
2194   if (!dm) {
2195     PetscCall(PCGetDM(pc,&dm));
2196   }
2197   if (dm) {
2198     PetscCall(PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex));
2199   }
2200   if (filter) isplex = PETSC_FALSE;
2201 
2202   if (isplex) { /* this code has been modified from plexpartition.c */
2203     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2204     PetscInt      *adj = NULL;
2205     IS             cellNumbering;
2206     const PetscInt *cellNum;
2207     PetscBool      useCone, useClosure;
2208     PetscSection   section;
2209     PetscSegBuffer adjBuffer;
2210     PetscSF        sfPoint;
2211 
2212     PetscCall(DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd));
2213     PetscCall(DMGetPointSF(dm, &sfPoint));
2214     PetscCall(PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL));
2215     /* Build adjacency graph via a section/segbuffer */
2216     PetscCall(PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section));
2217     PetscCall(PetscSectionSetChart(section, pStart, pEnd));
2218     PetscCall(PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer));
2219     /* Always use FVM adjacency to create partitioner graph */
2220     PetscCall(DMGetBasicAdjacency(dm, &useCone, &useClosure));
2221     PetscCall(DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE));
2222     PetscCall(DMPlexGetCellNumbering(dm, &cellNumbering));
2223     PetscCall(ISGetIndices(cellNumbering, &cellNum));
2224     for (n = 0, p = pStart; p < pEnd; p++) {
2225       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2226       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2227       adjSize = PETSC_DETERMINE;
2228       PetscCall(DMPlexGetAdjacency(dm, p, &adjSize, &adj));
2229       for (a = 0; a < adjSize; ++a) {
2230         const PetscInt point = adj[a];
2231         if (pStart <= point && point < pEnd) {
2232           PetscInt *PETSC_RESTRICT pBuf;
2233           PetscCall(PetscSectionAddDof(section, p, 1));
2234           PetscCall(PetscSegBufferGetInts(adjBuffer, 1, &pBuf));
2235           *pBuf = point;
2236         }
2237       }
2238       n++;
2239     }
2240     PetscCall(DMSetBasicAdjacency(dm, useCone, useClosure));
2241     /* Derive CSR graph from section/segbuffer */
2242     PetscCall(PetscSectionSetUp(section));
2243     PetscCall(PetscSectionGetStorageSize(section, &size));
2244     PetscCall(PetscMalloc1(n+1, &xadj));
2245     for (idx = 0, p = pStart; p < pEnd; p++) {
2246       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2247       PetscCall(PetscSectionGetOffset(section, p, &(xadj[idx++])));
2248     }
2249     xadj[n] = size;
2250     PetscCall(PetscSegBufferExtractAlloc(adjBuffer, &adjncy));
2251     /* Clean up */
2252     PetscCall(PetscSegBufferDestroy(&adjBuffer));
2253     PetscCall(PetscSectionDestroy(&section));
2254     PetscCall(PetscFree(adj));
2255     graph->xadj = xadj;
2256     graph->adjncy = adjncy;
2257   } else {
2258     Mat       A;
2259     PetscBool isseqaij, flg_row;
2260 
2261     PetscCall(MatISGetLocalMat(pc->pmat,&A));
2262     if (!A->rmap->N || !A->cmap->N) {
2263       PetscCall(PCBDDCGraphDestroy(&graph));
2264       PetscFunctionReturn(0);
2265     }
2266     PetscCall(PetscObjectBaseTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij));
2267     if (!isseqaij && filter) {
2268       PetscBool isseqdense;
2269 
2270       PetscCall(PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense));
2271       if (!isseqdense) {
2272         PetscCall(MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B));
2273       } else { /* TODO: rectangular case and LDA */
2274         PetscScalar *array;
2275         PetscReal   chop=1.e-6;
2276 
2277         PetscCall(MatDuplicate(A,MAT_COPY_VALUES,&B));
2278         PetscCall(MatDenseGetArray(B,&array));
2279         PetscCall(MatGetSize(B,&n,NULL));
2280         for (i=0;i<n;i++) {
2281           PetscInt j;
2282           for (j=i+1;j<n;j++) {
2283             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2284             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2285             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2286           }
2287         }
2288         PetscCall(MatDenseRestoreArray(B,&array));
2289         PetscCall(MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B));
2290       }
2291     } else {
2292       PetscCall(PetscObjectReference((PetscObject)A));
2293       B = A;
2294     }
2295     PetscCall(MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row));
2296 
2297     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2298     if (filter) {
2299       PetscScalar *data;
2300       PetscInt    j,cum;
2301 
2302       PetscCall(PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered));
2303       PetscCall(MatSeqAIJGetArray(B,&data));
2304       cum = 0;
2305       for (i=0;i<n;i++) {
2306         PetscInt t;
2307 
2308         for (j=xadj[i];j<xadj[i+1];j++) {
2309           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2310             continue;
2311           }
2312           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2313         }
2314         t = xadj_filtered[i];
2315         xadj_filtered[i] = cum;
2316         cum += t;
2317       }
2318       PetscCall(MatSeqAIJRestoreArray(B,&data));
2319       graph->xadj = xadj_filtered;
2320       graph->adjncy = adjncy_filtered;
2321     } else {
2322       graph->xadj = xadj;
2323       graph->adjncy = adjncy;
2324     }
2325   }
2326   /* compute local connected components using PCBDDCGraph */
2327   PetscCall(ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy));
2328   PetscCall(ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy));
2329   PetscCall(ISDestroy(&is_dummy));
2330   PetscCall(PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT));
2331   PetscCall(ISLocalToGlobalMappingDestroy(&l2gmap_dummy));
2332   PetscCall(PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL));
2333   PetscCall(PCBDDCGraphComputeConnectedComponents(graph));
2334 
2335   /* partial clean up */
2336   PetscCall(PetscFree2(xadj_filtered,adjncy_filtered));
2337   if (B) {
2338     PetscBool flg_row;
2339     PetscCall(MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row));
2340     PetscCall(MatDestroy(&B));
2341   }
2342   if (isplex) {
2343     PetscCall(PetscFree(xadj));
2344     PetscCall(PetscFree(adjncy));
2345   }
2346 
2347   /* get back data */
2348   if (isplex) {
2349     if (ncc) *ncc = graph->ncc;
2350     if (cc || primalv) {
2351       Mat          A;
2352       PetscBT      btv,btvt;
2353       PetscSection subSection;
2354       PetscInt     *ids,cum,cump,*cids,*pids;
2355 
2356       PetscCall(DMPlexGetSubdomainSection(dm,&subSection));
2357       PetscCall(MatISGetLocalMat(pc->pmat,&A));
2358       PetscCall(PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids));
2359       PetscCall(PetscBTCreate(A->rmap->n,&btv));
2360       PetscCall(PetscBTCreate(A->rmap->n,&btvt));
2361 
2362       cids[0] = 0;
2363       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2364         PetscInt j;
2365 
2366         PetscCall(PetscBTMemzero(A->rmap->n,btvt));
2367         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2368           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2369 
2370           PetscCall(DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure));
2371           for (k = 0; k < 2*size; k += 2) {
2372             PetscInt s, pp, p = closure[k], off, dof, cdof;
2373 
2374             PetscCall(PetscSectionGetConstraintDof(subSection,p,&cdof));
2375             PetscCall(PetscSectionGetOffset(subSection,p,&off));
2376             PetscCall(PetscSectionGetDof(subSection,p,&dof));
2377             for (s = 0; s < dof-cdof; s++) {
2378               if (PetscBTLookupSet(btvt,off+s)) continue;
2379               if (!PetscBTLookup(btv,off+s)) ids[cum++] = off+s;
2380               else pids[cump++] = off+s; /* cross-vertex */
2381             }
2382             PetscCall(DMPlexGetTreeParent(dm,p,&pp,NULL));
2383             if (pp != p) {
2384               PetscCall(PetscSectionGetConstraintDof(subSection,pp,&cdof));
2385               PetscCall(PetscSectionGetOffset(subSection,pp,&off));
2386               PetscCall(PetscSectionGetDof(subSection,pp,&dof));
2387               for (s = 0; s < dof-cdof; s++) {
2388                 if (PetscBTLookupSet(btvt,off+s)) continue;
2389                 if (!PetscBTLookup(btv,off+s)) ids[cum++] = off+s;
2390                 else pids[cump++] = off+s; /* cross-vertex */
2391               }
2392             }
2393           }
2394           PetscCall(DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure));
2395         }
2396         cids[i+1] = cum;
2397         /* mark dofs as already assigned */
2398         for (j = cids[i]; j < cids[i+1]; j++) {
2399           PetscCall(PetscBTSet(btv,ids[j]));
2400         }
2401       }
2402       if (cc) {
2403         PetscCall(PetscMalloc1(graph->ncc,&cc_n));
2404         for (i = 0; i < graph->ncc; i++) {
2405           PetscCall(ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]));
2406         }
2407         *cc = cc_n;
2408       }
2409       if (primalv) PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv));
2410       PetscCall(PetscFree3(ids,cids,pids));
2411       PetscCall(PetscBTDestroy(&btv));
2412       PetscCall(PetscBTDestroy(&btvt));
2413     }
2414   } else {
2415     if (ncc) *ncc = graph->ncc;
2416     if (cc) {
2417       PetscCall(PetscMalloc1(graph->ncc,&cc_n));
2418       for (i=0;i<graph->ncc;i++) {
2419         PetscCall(ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]));
2420       }
2421       *cc = cc_n;
2422     }
2423   }
2424   /* clean up graph */
2425   graph->xadj = NULL;
2426   graph->adjncy = NULL;
2427   PetscCall(PCBDDCGraphDestroy(&graph));
2428   PetscFunctionReturn(0);
2429 }
2430 
2431 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2432 {
2433   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2434   PC_IS*         pcis = (PC_IS*)(pc->data);
2435   IS             dirIS = NULL;
2436   PetscInt       i;
2437 
2438   PetscFunctionBegin;
2439   PetscCall(PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS));
2440   if (zerodiag) {
2441     Mat            A;
2442     Vec            vec3_N;
2443     PetscScalar    *vals;
2444     const PetscInt *idxs;
2445     PetscInt       nz,*count;
2446 
2447     /* p0 */
2448     PetscCall(VecSet(pcis->vec1_N,0.));
2449     PetscCall(PetscMalloc1(pcis->n,&vals));
2450     PetscCall(ISGetLocalSize(zerodiag,&nz));
2451     PetscCall(ISGetIndices(zerodiag,&idxs));
2452     for (i=0;i<nz;i++) vals[i] = 1.;
2453     PetscCall(VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES));
2454     PetscCall(VecAssemblyBegin(pcis->vec1_N));
2455     PetscCall(VecAssemblyEnd(pcis->vec1_N));
2456     /* v_I */
2457     PetscCall(VecSetRandom(pcis->vec2_N,NULL));
2458     for (i=0;i<nz;i++) vals[i] = 0.;
2459     PetscCall(VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES));
2460     PetscCall(ISRestoreIndices(zerodiag,&idxs));
2461     PetscCall(ISGetIndices(pcis->is_B_local,&idxs));
2462     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2463     PetscCall(VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES));
2464     PetscCall(ISRestoreIndices(pcis->is_B_local,&idxs));
2465     if (dirIS) {
2466       PetscInt n;
2467 
2468       PetscCall(ISGetLocalSize(dirIS,&n));
2469       PetscCall(ISGetIndices(dirIS,&idxs));
2470       for (i=0;i<n;i++) vals[i] = 0.;
2471       PetscCall(VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES));
2472       PetscCall(ISRestoreIndices(dirIS,&idxs));
2473     }
2474     PetscCall(VecAssemblyBegin(pcis->vec2_N));
2475     PetscCall(VecAssemblyEnd(pcis->vec2_N));
2476     PetscCall(VecDuplicate(pcis->vec1_N,&vec3_N));
2477     PetscCall(VecSet(vec3_N,0.));
2478     PetscCall(MatISGetLocalMat(pc->pmat,&A));
2479     PetscCall(MatMult(A,pcis->vec1_N,vec3_N));
2480     PetscCall(VecDot(vec3_N,pcis->vec2_N,&vals[0]));
2481     PetscCheck(PetscAbsScalar(vals[0]) <= 1.e-1,PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",(double)PetscAbsScalar(vals[0]));
2482     PetscCall(PetscFree(vals));
2483     PetscCall(VecDestroy(&vec3_N));
2484 
2485     /* there should not be any pressure dofs lying on the interface */
2486     PetscCall(PetscCalloc1(pcis->n,&count));
2487     PetscCall(ISGetIndices(pcis->is_B_local,&idxs));
2488     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2489     PetscCall(ISRestoreIndices(pcis->is_B_local,&idxs));
2490     PetscCall(ISGetIndices(zerodiag,&idxs));
2491     for (i=0;i<nz;i++) PetscCheck(!count[idxs[i]],PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %" PetscInt_FMT " is an interface dof",idxs[i]);
2492     PetscCall(ISRestoreIndices(zerodiag,&idxs));
2493     PetscCall(PetscFree(count));
2494   }
2495   PetscCall(ISDestroy(&dirIS));
2496 
2497   /* check PCBDDCBenignGetOrSetP0 */
2498   PetscCall(VecSetRandom(pcis->vec1_global,NULL));
2499   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2500   PetscCall(PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE));
2501   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2502   PetscCall(PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE));
2503   for (i=0;i<pcbddc->benign_n;i++) {
2504     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2505     PetscCheck(val == -PetscGlobalRank-i,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %" PetscInt_FMT " instead of %g",(double)PetscRealPart(pcbddc->benign_p0[i]),i,(double)(-PetscGlobalRank-i));
2506   }
2507   PetscFunctionReturn(0);
2508 }
2509 
2510 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2511 {
2512   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2513   Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2514   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2515   PetscInt       nz,n,benign_n,bsp = 1;
2516   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2517   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2518 
2519   PetscFunctionBegin;
2520   if (reuse) goto project_b0;
2521   PetscCall(PetscSFDestroy(&pcbddc->benign_sf));
2522   PetscCall(MatDestroy(&pcbddc->benign_B0));
2523   for (n=0;n<pcbddc->benign_n;n++) {
2524     PetscCall(ISDestroy(&pcbddc->benign_zerodiag_subs[n]));
2525   }
2526   PetscCall(PetscFree(pcbddc->benign_zerodiag_subs));
2527   has_null_pressures = PETSC_TRUE;
2528   have_null = PETSC_TRUE;
2529   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2530      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2531      Checks if all the pressure dofs in each subdomain have a zero diagonal
2532      If not, a change of basis on pressures is not needed
2533      since the local Schur complements are already SPD
2534   */
2535   if (pcbddc->n_ISForDofsLocal) {
2536     IS        iP = NULL;
2537     PetscInt  p,*pp;
2538     PetscBool flg;
2539 
2540     PetscCall(PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp));
2541     n    = pcbddc->n_ISForDofsLocal;
2542     PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");
2543     PetscCall(PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg));
2544     PetscOptionsEnd();
2545     if (!flg) {
2546       n = 1;
2547       pp[0] = pcbddc->n_ISForDofsLocal-1;
2548     }
2549 
2550     bsp = 0;
2551     for (p=0;p<n;p++) {
2552       PetscInt bs;
2553 
2554       PetscCheck(pp[p] >= 0 && pp[p] < pcbddc->n_ISForDofsLocal,PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %" PetscInt_FMT,pp[p]);
2555       PetscCall(ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs));
2556       bsp += bs;
2557     }
2558     PetscCall(PetscMalloc1(bsp,&bzerodiag));
2559     bsp  = 0;
2560     for (p=0;p<n;p++) {
2561       const PetscInt *idxs;
2562       PetscInt       b,bs,npl,*bidxs;
2563 
2564       PetscCall(ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs));
2565       PetscCall(ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl));
2566       PetscCall(ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs));
2567       PetscCall(PetscMalloc1(npl/bs,&bidxs));
2568       for (b=0;b<bs;b++) {
2569         PetscInt i;
2570 
2571         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2572         PetscCall(ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]));
2573         bsp++;
2574       }
2575       PetscCall(PetscFree(bidxs));
2576       PetscCall(ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs));
2577     }
2578     PetscCall(ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures));
2579 
2580     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2581     PetscCall(PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP));
2582     if (iP) {
2583       IS newpressures;
2584 
2585       PetscCall(ISDifference(pressures,iP,&newpressures));
2586       PetscCall(ISDestroy(&pressures));
2587       pressures = newpressures;
2588     }
2589     PetscCall(ISSorted(pressures,&sorted));
2590     if (!sorted) {
2591       PetscCall(ISSort(pressures));
2592     }
2593     PetscCall(PetscFree(pp));
2594   }
2595 
2596   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2597   PetscCall(MatGetLocalSize(pcbddc->local_mat,&n,NULL));
2598   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2599   PetscCall(MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag));
2600   PetscCall(ISSorted(zerodiag,&sorted));
2601   if (!sorted) {
2602     PetscCall(ISSort(zerodiag));
2603   }
2604   PetscCall(PetscObjectReference((PetscObject)zerodiag));
2605   zerodiag_save = zerodiag;
2606   PetscCall(ISGetLocalSize(zerodiag,&nz));
2607   if (!nz) {
2608     if (n) have_null = PETSC_FALSE;
2609     has_null_pressures = PETSC_FALSE;
2610     PetscCall(ISDestroy(&zerodiag));
2611   }
2612   recompute_zerodiag = PETSC_FALSE;
2613 
2614   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2615   zerodiag_subs    = NULL;
2616   benign_n         = 0;
2617   n_interior_dofs  = 0;
2618   interior_dofs    = NULL;
2619   nneu             = 0;
2620   if (pcbddc->NeumannBoundariesLocal) {
2621     PetscCall(ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu));
2622   }
2623   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2624   if (checkb) { /* need to compute interior nodes */
2625     PetscInt n,i,j;
2626     PetscInt n_neigh,*neigh,*n_shared,**shared;
2627     PetscInt *iwork;
2628 
2629     PetscCall(ISLocalToGlobalMappingGetSize(matis->rmapping,&n));
2630     PetscCall(ISLocalToGlobalMappingGetInfo(matis->rmapping,&n_neigh,&neigh,&n_shared,&shared));
2631     PetscCall(PetscCalloc1(n,&iwork));
2632     PetscCall(PetscMalloc1(n,&interior_dofs));
2633     for (i=1;i<n_neigh;i++)
2634       for (j=0;j<n_shared[i];j++)
2635           iwork[shared[i][j]] += 1;
2636     for (i=0;i<n;i++)
2637       if (!iwork[i])
2638         interior_dofs[n_interior_dofs++] = i;
2639     PetscCall(PetscFree(iwork));
2640     PetscCall(ISLocalToGlobalMappingRestoreInfo(matis->rmapping,&n_neigh,&neigh,&n_shared,&shared));
2641   }
2642   if (has_null_pressures) {
2643     IS             *subs;
2644     PetscInt       nsubs,i,j,nl;
2645     const PetscInt *idxs;
2646     PetscScalar    *array;
2647     Vec            *work;
2648 
2649     subs  = pcbddc->local_subs;
2650     nsubs = pcbddc->n_local_subs;
2651     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2652     if (checkb) {
2653       PetscCall(VecDuplicateVecs(matis->y,2,&work));
2654       PetscCall(ISGetLocalSize(zerodiag,&nl));
2655       PetscCall(ISGetIndices(zerodiag,&idxs));
2656       /* work[0] = 1_p */
2657       PetscCall(VecSet(work[0],0.));
2658       PetscCall(VecGetArray(work[0],&array));
2659       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2660       PetscCall(VecRestoreArray(work[0],&array));
2661       /* work[0] = 1_v */
2662       PetscCall(VecSet(work[1],1.));
2663       PetscCall(VecGetArray(work[1],&array));
2664       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2665       PetscCall(VecRestoreArray(work[1],&array));
2666       PetscCall(ISRestoreIndices(zerodiag,&idxs));
2667     }
2668 
2669     if (nsubs > 1 || bsp > 1) {
2670       IS       *is;
2671       PetscInt b,totb;
2672 
2673       totb  = bsp;
2674       is    = bsp > 1 ? bzerodiag : &zerodiag;
2675       nsubs = PetscMax(nsubs,1);
2676       PetscCall(PetscCalloc1(nsubs*totb,&zerodiag_subs));
2677       for (b=0;b<totb;b++) {
2678         for (i=0;i<nsubs;i++) {
2679           ISLocalToGlobalMapping l2g;
2680           IS                     t_zerodiag_subs;
2681           PetscInt               nl;
2682 
2683           if (subs) {
2684             PetscCall(ISLocalToGlobalMappingCreateIS(subs[i],&l2g));
2685           } else {
2686             IS tis;
2687 
2688             PetscCall(MatGetLocalSize(pcbddc->local_mat,&nl,NULL));
2689             PetscCall(ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis));
2690             PetscCall(ISLocalToGlobalMappingCreateIS(tis,&l2g));
2691             PetscCall(ISDestroy(&tis));
2692           }
2693           PetscCall(ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs));
2694           PetscCall(ISGetLocalSize(t_zerodiag_subs,&nl));
2695           if (nl) {
2696             PetscBool valid = PETSC_TRUE;
2697 
2698             if (checkb) {
2699               PetscCall(VecSet(matis->x,0));
2700               PetscCall(ISGetLocalSize(subs[i],&nl));
2701               PetscCall(ISGetIndices(subs[i],&idxs));
2702               PetscCall(VecGetArray(matis->x,&array));
2703               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2704               PetscCall(VecRestoreArray(matis->x,&array));
2705               PetscCall(ISRestoreIndices(subs[i],&idxs));
2706               PetscCall(VecPointwiseMult(matis->x,work[0],matis->x));
2707               PetscCall(MatMult(matis->A,matis->x,matis->y));
2708               PetscCall(VecPointwiseMult(matis->y,work[1],matis->y));
2709               PetscCall(VecGetArray(matis->y,&array));
2710               for (j=0;j<n_interior_dofs;j++) {
2711                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2712                   valid = PETSC_FALSE;
2713                   break;
2714                 }
2715               }
2716               PetscCall(VecRestoreArray(matis->y,&array));
2717             }
2718             if (valid && nneu) {
2719               const PetscInt *idxs;
2720               PetscInt       nzb;
2721 
2722               PetscCall(ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs));
2723               PetscCall(ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL));
2724               PetscCall(ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs));
2725               if (nzb) valid = PETSC_FALSE;
2726             }
2727             if (valid && pressures) {
2728               IS       t_pressure_subs,tmp;
2729               PetscInt i1,i2;
2730 
2731               PetscCall(ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs));
2732               PetscCall(ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp));
2733               PetscCall(ISGetLocalSize(tmp,&i1));
2734               PetscCall(ISGetLocalSize(t_zerodiag_subs,&i2));
2735               if (i2 != i1) valid = PETSC_FALSE;
2736               PetscCall(ISDestroy(&t_pressure_subs));
2737               PetscCall(ISDestroy(&tmp));
2738             }
2739             if (valid) {
2740               PetscCall(ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]));
2741               benign_n++;
2742             } else recompute_zerodiag = PETSC_TRUE;
2743           }
2744           PetscCall(ISDestroy(&t_zerodiag_subs));
2745           PetscCall(ISLocalToGlobalMappingDestroy(&l2g));
2746         }
2747       }
2748     } else { /* there's just one subdomain (or zero if they have not been detected */
2749       PetscBool valid = PETSC_TRUE;
2750 
2751       if (nneu) valid = PETSC_FALSE;
2752       if (valid && pressures) {
2753         PetscCall(ISEqual(pressures,zerodiag,&valid));
2754       }
2755       if (valid && checkb) {
2756         PetscCall(MatMult(matis->A,work[0],matis->x));
2757         PetscCall(VecPointwiseMult(matis->x,work[1],matis->x));
2758         PetscCall(VecGetArray(matis->x,&array));
2759         for (j=0;j<n_interior_dofs;j++) {
2760           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2761             valid = PETSC_FALSE;
2762             break;
2763           }
2764         }
2765         PetscCall(VecRestoreArray(matis->x,&array));
2766       }
2767       if (valid) {
2768         benign_n = 1;
2769         PetscCall(PetscMalloc1(benign_n,&zerodiag_subs));
2770         PetscCall(PetscObjectReference((PetscObject)zerodiag));
2771         zerodiag_subs[0] = zerodiag;
2772       }
2773     }
2774     if (checkb) {
2775       PetscCall(VecDestroyVecs(2,&work));
2776     }
2777   }
2778   PetscCall(PetscFree(interior_dofs));
2779 
2780   if (!benign_n) {
2781     PetscInt n;
2782 
2783     PetscCall(ISDestroy(&zerodiag));
2784     recompute_zerodiag = PETSC_FALSE;
2785     PetscCall(MatGetLocalSize(pcbddc->local_mat,&n,NULL));
2786     if (n) have_null = PETSC_FALSE;
2787   }
2788 
2789   /* final check for null pressures */
2790   if (zerodiag && pressures) {
2791     PetscCall(ISEqual(pressures,zerodiag,&have_null));
2792   }
2793 
2794   if (recompute_zerodiag) {
2795     PetscCall(ISDestroy(&zerodiag));
2796     if (benign_n == 1) {
2797       PetscCall(PetscObjectReference((PetscObject)zerodiag_subs[0]));
2798       zerodiag = zerodiag_subs[0];
2799     } else {
2800       PetscInt i,nzn,*new_idxs;
2801 
2802       nzn = 0;
2803       for (i=0;i<benign_n;i++) {
2804         PetscInt ns;
2805         PetscCall(ISGetLocalSize(zerodiag_subs[i],&ns));
2806         nzn += ns;
2807       }
2808       PetscCall(PetscMalloc1(nzn,&new_idxs));
2809       nzn = 0;
2810       for (i=0;i<benign_n;i++) {
2811         PetscInt ns,*idxs;
2812         PetscCall(ISGetLocalSize(zerodiag_subs[i],&ns));
2813         PetscCall(ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs));
2814         PetscCall(PetscArraycpy(new_idxs+nzn,idxs,ns));
2815         PetscCall(ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs));
2816         nzn += ns;
2817       }
2818       PetscCall(PetscSortInt(nzn,new_idxs));
2819       PetscCall(ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag));
2820     }
2821     have_null = PETSC_FALSE;
2822   }
2823 
2824   /* determines if the coarse solver will be singular or not */
2825   PetscCall(MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc)));
2826 
2827   /* Prepare matrix to compute no-net-flux */
2828   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2829     Mat                    A,loc_divudotp;
2830     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2831     IS                     row,col,isused = NULL;
2832     PetscInt               M,N,n,st,n_isused;
2833 
2834     if (pressures) {
2835       isused = pressures;
2836     } else {
2837       isused = zerodiag_save;
2838     }
2839     PetscCall(MatISGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL));
2840     PetscCall(MatISGetLocalMat(pc->pmat,&A));
2841     PetscCall(MatGetLocalSize(A,&n,NULL));
2842     PetscCheck(isused || (n == 0),PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2843     n_isused = 0;
2844     if (isused) {
2845       PetscCall(ISGetLocalSize(isused,&n_isused));
2846     }
2847     PetscCallMPI(MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc)));
2848     st = st-n_isused;
2849     if (n) {
2850       const PetscInt *gidxs;
2851 
2852       PetscCall(MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp));
2853       PetscCall(ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs));
2854       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2855       PetscCall(ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row));
2856       PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col));
2857       PetscCall(ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs));
2858     } else {
2859       PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp));
2860       PetscCall(ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row));
2861       PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col));
2862     }
2863     PetscCall(MatGetSize(pc->pmat,NULL,&N));
2864     PetscCall(ISGetSize(row,&M));
2865     PetscCall(ISLocalToGlobalMappingCreateIS(row,&rl2g));
2866     PetscCall(ISLocalToGlobalMappingCreateIS(col,&cl2g));
2867     PetscCall(ISDestroy(&row));
2868     PetscCall(ISDestroy(&col));
2869     PetscCall(MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp));
2870     PetscCall(MatSetType(pcbddc->divudotp,MATIS));
2871     PetscCall(MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N));
2872     PetscCall(MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g));
2873     PetscCall(ISLocalToGlobalMappingDestroy(&rl2g));
2874     PetscCall(ISLocalToGlobalMappingDestroy(&cl2g));
2875     PetscCall(MatISSetLocalMat(pcbddc->divudotp,loc_divudotp));
2876     PetscCall(MatDestroy(&loc_divudotp));
2877     PetscCall(MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY));
2878     PetscCall(MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY));
2879   }
2880   PetscCall(ISDestroy(&zerodiag_save));
2881   PetscCall(ISDestroy(&pressures));
2882   if (bzerodiag) {
2883     PetscInt i;
2884 
2885     for (i=0;i<bsp;i++) {
2886       PetscCall(ISDestroy(&bzerodiag[i]));
2887     }
2888     PetscCall(PetscFree(bzerodiag));
2889   }
2890   pcbddc->benign_n = benign_n;
2891   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2892 
2893   /* determines if the problem has subdomains with 0 pressure block */
2894   have_null = (PetscBool)(!!pcbddc->benign_n);
2895   PetscCall(MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc)));
2896 
2897 project_b0:
2898   PetscCall(MatGetLocalSize(pcbddc->local_mat,&n,NULL));
2899   /* change of basis and p0 dofs */
2900   if (pcbddc->benign_n) {
2901     PetscInt i,s,*nnz;
2902 
2903     /* local change of basis for pressures */
2904     PetscCall(MatDestroy(&pcbddc->benign_change));
2905     PetscCall(MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change));
2906     PetscCall(MatSetType(pcbddc->benign_change,MATAIJ));
2907     PetscCall(MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE));
2908     PetscCall(PetscMalloc1(n,&nnz));
2909     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2910     for (i=0;i<pcbddc->benign_n;i++) {
2911       const PetscInt *idxs;
2912       PetscInt       nzs,j;
2913 
2914       PetscCall(ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs));
2915       PetscCall(ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs));
2916       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2917       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2918       PetscCall(ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs));
2919     }
2920     PetscCall(MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz));
2921     PetscCall(MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE));
2922     PetscCall(PetscFree(nnz));
2923     /* set identity by default */
2924     for (i=0;i<n;i++) {
2925       PetscCall(MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES));
2926     }
2927     PetscCall(PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0));
2928     PetscCall(PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0));
2929     /* set change on pressures */
2930     for (s=0;s<pcbddc->benign_n;s++) {
2931       PetscScalar    *array;
2932       const PetscInt *idxs;
2933       PetscInt       nzs;
2934 
2935       PetscCall(ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs));
2936       PetscCall(ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs));
2937       for (i=0;i<nzs-1;i++) {
2938         PetscScalar vals[2];
2939         PetscInt    cols[2];
2940 
2941         cols[0] = idxs[i];
2942         cols[1] = idxs[nzs-1];
2943         vals[0] = 1.;
2944         vals[1] = 1.;
2945         PetscCall(MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES));
2946       }
2947       PetscCall(PetscMalloc1(nzs,&array));
2948       for (i=0;i<nzs-1;i++) array[i] = -1.;
2949       array[nzs-1] = 1.;
2950       PetscCall(MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES));
2951       /* store local idxs for p0 */
2952       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2953       PetscCall(ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs));
2954       PetscCall(PetscFree(array));
2955     }
2956     PetscCall(MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY));
2957     PetscCall(MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY));
2958 
2959     /* project if needed */
2960     if (pcbddc->benign_change_explicit) {
2961       Mat M;
2962 
2963       PetscCall(MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M));
2964       PetscCall(MatDestroy(&pcbddc->local_mat));
2965       PetscCall(MatSeqAIJCompress(M,&pcbddc->local_mat));
2966       PetscCall(MatDestroy(&M));
2967     }
2968     /* store global idxs for p0 */
2969     PetscCall(ISLocalToGlobalMappingApply(matis->rmapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx));
2970   }
2971   *zerodiaglocal = zerodiag;
2972   PetscFunctionReturn(0);
2973 }
2974 
2975 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2976 {
2977   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2978   PetscScalar    *array;
2979 
2980   PetscFunctionBegin;
2981   if (!pcbddc->benign_sf) {
2982     PetscCall(PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf));
2983     PetscCall(PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx));
2984   }
2985   if (get) {
2986     PetscCall(VecGetArrayRead(v,(const PetscScalar**)&array));
2987     PetscCall(PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0,MPI_REPLACE));
2988     PetscCall(PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0,MPI_REPLACE));
2989     PetscCall(VecRestoreArrayRead(v,(const PetscScalar**)&array));
2990   } else {
2991     PetscCall(VecGetArray(v,&array));
2992     PetscCall(PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPI_REPLACE));
2993     PetscCall(PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPI_REPLACE));
2994     PetscCall(VecRestoreArray(v,&array));
2995   }
2996   PetscFunctionReturn(0);
2997 }
2998 
2999 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3000 {
3001   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3002 
3003   PetscFunctionBegin;
3004   /* TODO: add error checking
3005     - avoid nested pop (or push) calls.
3006     - cannot push before pop.
3007     - cannot call this if pcbddc->local_mat is NULL
3008   */
3009   if (!pcbddc->benign_n) {
3010     PetscFunctionReturn(0);
3011   }
3012   if (pop) {
3013     if (pcbddc->benign_change_explicit) {
3014       IS       is_p0;
3015       MatReuse reuse;
3016 
3017       /* extract B_0 */
3018       reuse = MAT_INITIAL_MATRIX;
3019       if (pcbddc->benign_B0) {
3020         reuse = MAT_REUSE_MATRIX;
3021       }
3022       PetscCall(ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0));
3023       PetscCall(MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0));
3024       /* remove rows and cols from local problem */
3025       PetscCall(MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE));
3026       PetscCall(MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE));
3027       PetscCall(MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL));
3028       PetscCall(ISDestroy(&is_p0));
3029     } else {
3030       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3031       PetscScalar *vals;
3032       PetscInt    i,n,*idxs_ins;
3033 
3034       PetscCall(VecGetLocalSize(matis->y,&n));
3035       PetscCall(PetscMalloc2(n,&idxs_ins,n,&vals));
3036       if (!pcbddc->benign_B0) {
3037         PetscInt *nnz;
3038         PetscCall(MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0));
3039         PetscCall(MatSetType(pcbddc->benign_B0,MATAIJ));
3040         PetscCall(MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE));
3041         PetscCall(PetscMalloc1(pcbddc->benign_n,&nnz));
3042         for (i=0;i<pcbddc->benign_n;i++) {
3043           PetscCall(ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]));
3044           nnz[i] = n - nnz[i];
3045         }
3046         PetscCall(MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz));
3047         PetscCall(MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE));
3048         PetscCall(PetscFree(nnz));
3049       }
3050 
3051       for (i=0;i<pcbddc->benign_n;i++) {
3052         PetscScalar *array;
3053         PetscInt    *idxs,j,nz,cum;
3054 
3055         PetscCall(VecSet(matis->x,0.));
3056         PetscCall(ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz));
3057         PetscCall(ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs));
3058         for (j=0;j<nz;j++) vals[j] = 1.;
3059         PetscCall(VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES));
3060         PetscCall(VecAssemblyBegin(matis->x));
3061         PetscCall(VecAssemblyEnd(matis->x));
3062         PetscCall(VecSet(matis->y,0.));
3063         PetscCall(MatMult(matis->A,matis->x,matis->y));
3064         PetscCall(VecGetArray(matis->y,&array));
3065         cum = 0;
3066         for (j=0;j<n;j++) {
3067           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3068             vals[cum] = array[j];
3069             idxs_ins[cum] = j;
3070             cum++;
3071           }
3072         }
3073         PetscCall(MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES));
3074         PetscCall(VecRestoreArray(matis->y,&array));
3075         PetscCall(ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs));
3076       }
3077       PetscCall(MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY));
3078       PetscCall(MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY));
3079       PetscCall(PetscFree2(idxs_ins,vals));
3080     }
3081   } else { /* push */
3082     if (pcbddc->benign_change_explicit) {
3083       PetscInt i;
3084 
3085       for (i=0;i<pcbddc->benign_n;i++) {
3086         PetscScalar *B0_vals;
3087         PetscInt    *B0_cols,B0_ncol;
3088 
3089         PetscCall(MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals));
3090         PetscCall(MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES));
3091         PetscCall(MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES));
3092         PetscCall(MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES));
3093         PetscCall(MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals));
3094       }
3095       PetscCall(MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY));
3096       PetscCall(MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY));
3097     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3098   }
3099   PetscFunctionReturn(0);
3100 }
3101 
3102 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3103 {
3104   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3105   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3106   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3107   PetscBLASInt    *B_iwork,*B_ifail;
3108   PetscScalar     *work,lwork;
3109   PetscScalar     *St,*S,*eigv;
3110   PetscScalar     *Sarray,*Starray;
3111   PetscReal       *eigs,thresh,lthresh,uthresh;
3112   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3113   PetscBool       allocated_S_St,upart;
3114 #if defined(PETSC_USE_COMPLEX)
3115   PetscReal       *rwork;
3116 #endif
3117 
3118   PetscFunctionBegin;
3119   if (!pcbddc->adaptive_selection) PetscFunctionReturn(0);
3120   PetscCheck(sub_schurs,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3121   PetscCheck(sub_schurs->schur_explicit || !sub_schurs->n_subs,PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3122   PetscCheck(!sub_schurs->n_subs || sub_schurs->is_symmetric,PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3123   PetscCall(PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0));
3124 
3125   if (pcbddc->dbg_flag) {
3126     if (!pcbddc->dbg_viewer) pcbddc->dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pc));
3127     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
3128     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n"));
3129     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n"));
3130     PetscCall(PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer));
3131   }
3132 
3133   if (pcbddc->dbg_flag) {
3134     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %" PetscInt_FMT " (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef));
3135   }
3136 
3137   /* max size of subsets */
3138   mss = 0;
3139   for (i=0;i<sub_schurs->n_subs;i++) {
3140     PetscInt subset_size;
3141 
3142     PetscCall(ISGetLocalSize(sub_schurs->is_subs[i],&subset_size));
3143     mss = PetscMax(mss,subset_size);
3144   }
3145 
3146   /* min/max and threshold */
3147   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3148   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3149   nmax = PetscMax(nmin,nmax);
3150   allocated_S_St = PETSC_FALSE;
3151   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3152     allocated_S_St = PETSC_TRUE;
3153   }
3154 
3155   /* allocate lapack workspace */
3156   cum = cum2 = 0;
3157   maxneigs = 0;
3158   for (i=0;i<sub_schurs->n_subs;i++) {
3159     PetscInt n,subset_size;
3160 
3161     PetscCall(ISGetLocalSize(sub_schurs->is_subs[i],&subset_size));
3162     n = PetscMin(subset_size,nmax);
3163     cum += subset_size;
3164     cum2 += subset_size*n;
3165     maxneigs = PetscMax(maxneigs,n);
3166   }
3167   lwork = 0;
3168   if (mss) {
3169     if (sub_schurs->is_symmetric) {
3170       PetscScalar  sdummy = 0.;
3171       PetscBLASInt B_itype = 1;
3172       PetscBLASInt B_N = mss, idummy = 0;
3173       PetscReal    rdummy = 0.,zero = 0.0;
3174       PetscReal    eps = 0.0; /* dlamch? */
3175 
3176       B_lwork = -1;
3177       /* some implementations may complain about NULL pointers, even if we are querying */
3178       S = &sdummy;
3179       St = &sdummy;
3180       eigs = &rdummy;
3181       eigv = &sdummy;
3182       B_iwork = &idummy;
3183       B_ifail = &idummy;
3184 #if defined(PETSC_USE_COMPLEX)
3185       rwork = &rdummy;
3186 #endif
3187       thresh = 1.0;
3188       PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
3189 #if defined(PETSC_USE_COMPLEX)
3190       PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3191 #else
3192       PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
3193 #endif
3194       PetscCheck(B_ierr == 0,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3195       PetscCall(PetscFPTrapPop());
3196     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3197   }
3198 
3199   nv = 0;
3200   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
3201     PetscCall(ISGetLocalSize(sub_schurs->is_vertices,&nv));
3202   }
3203   PetscCall(PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork));
3204   if (allocated_S_St) {
3205     PetscCall(PetscMalloc2(mss*mss,&S,mss*mss,&St));
3206   }
3207   PetscCall(PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail));
3208 #if defined(PETSC_USE_COMPLEX)
3209   PetscCall(PetscMalloc1(7*mss,&rwork));
3210 #endif
3211   PetscCall(PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3212                          nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3213                          nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3214                          nv+cum,&pcbddc->adaptive_constraints_idxs,
3215                          nv+cum2,&pcbddc->adaptive_constraints_data));
3216   PetscCall(PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs));
3217 
3218   maxneigs = 0;
3219   cum = cumarray = 0;
3220   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3221   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3222   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3223     const PetscInt *idxs;
3224 
3225     PetscCall(ISGetIndices(sub_schurs->is_vertices,&idxs));
3226     for (cum=0;cum<nv;cum++) {
3227       pcbddc->adaptive_constraints_n[cum] = 1;
3228       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3229       pcbddc->adaptive_constraints_data[cum] = 1.0;
3230       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3231       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3232     }
3233     PetscCall(ISRestoreIndices(sub_schurs->is_vertices,&idxs));
3234   }
3235 
3236   if (mss) { /* multilevel */
3237     if (sub_schurs->gdsw) {
3238       PetscCall(MatSeqAIJGetArray(sub_schurs->sum_S_Ej_all,&Sarray));
3239       PetscCall(MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray));
3240     } else {
3241       PetscCall(MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray));
3242       PetscCall(MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray));
3243     }
3244   }
3245 
3246   lthresh = pcbddc->adaptive_threshold[0];
3247   uthresh = pcbddc->adaptive_threshold[1];
3248   upart = pcbddc->use_deluxe_scaling;
3249   for (i=0;i<sub_schurs->n_subs;i++) {
3250     const PetscInt *idxs;
3251     PetscReal      upper,lower;
3252     PetscInt       j,subset_size,eigs_start = 0;
3253     PetscBLASInt   B_N;
3254     PetscBool      same_data = PETSC_FALSE;
3255     PetscBool      scal = PETSC_FALSE;
3256 
3257     if (upart) {
3258       upper = PETSC_MAX_REAL;
3259       lower = uthresh;
3260     } else {
3261       if (sub_schurs->gdsw) {
3262         upper = uthresh;
3263         lower = PETSC_MIN_REAL;
3264       } else {
3265         PetscCheck(sub_schurs->is_posdef,PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3266         upper = 1./uthresh;
3267         lower = 0.;
3268       }
3269     }
3270     PetscCall(ISGetLocalSize(sub_schurs->is_subs[i],&subset_size));
3271     PetscCall(ISGetIndices(sub_schurs->is_subs[i],&idxs));
3272     PetscCall(PetscBLASIntCast(subset_size,&B_N));
3273     /* this is experimental: we assume the dofs have been properly grouped to have
3274        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3275     if (!sub_schurs->is_posdef) {
3276       Mat T;
3277 
3278       for (j=0;j<subset_size;j++) {
3279         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3280           PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T));
3281           PetscCall(MatScale(T,-1.0));
3282           PetscCall(MatDestroy(&T));
3283           PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T));
3284           PetscCall(MatScale(T,-1.0));
3285           PetscCall(MatDestroy(&T));
3286           if (sub_schurs->change_primal_sub) {
3287             PetscInt       nz,k;
3288             const PetscInt *idxs;
3289 
3290             PetscCall(ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz));
3291             PetscCall(ISGetIndices(sub_schurs->change_primal_sub[i],&idxs));
3292             for (k=0;k<nz;k++) {
3293               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3294               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3295             }
3296             PetscCall(ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs));
3297           }
3298           scal = PETSC_TRUE;
3299           break;
3300         }
3301       }
3302     }
3303 
3304     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3305       if (sub_schurs->is_symmetric) {
3306         PetscInt j,k;
3307         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3308           PetscCall(PetscArrayzero(S,subset_size*subset_size));
3309           PetscCall(PetscArrayzero(St,subset_size*subset_size));
3310         }
3311         for (j=0;j<subset_size;j++) {
3312           for (k=j;k<subset_size;k++) {
3313             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3314             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3315           }
3316         }
3317       } else {
3318         PetscCall(PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size));
3319         PetscCall(PetscArraycpy(St,Starray+cumarray,subset_size*subset_size));
3320       }
3321     } else {
3322       S = Sarray + cumarray;
3323       St = Starray + cumarray;
3324     }
3325     /* see if we can save some work */
3326     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3327       PetscCall(PetscArraycmp(S,St,subset_size*subset_size,&same_data));
3328     }
3329 
3330     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3331       B_neigs = 0;
3332     } else {
3333       if (sub_schurs->is_symmetric) {
3334         PetscBLASInt B_itype = 1;
3335         PetscBLASInt B_IL, B_IU;
3336         PetscReal    eps = -1.0; /* dlamch? */
3337         PetscInt     nmin_s;
3338         PetscBool    compute_range;
3339 
3340         B_neigs = 0;
3341         compute_range = (PetscBool)!same_data;
3342         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3343 
3344         if (pcbddc->dbg_flag) {
3345           PetscInt nc = 0;
3346 
3347           if (sub_schurs->change_primal_sub) {
3348             PetscCall(ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc));
3349           }
3350           PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %" PetscInt_FMT "/%" PetscInt_FMT " size %" PetscInt_FMT " count %" PetscInt_FMT " fid %" PetscInt_FMT " (range %d) (change %" PetscInt_FMT ").\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc));
3351         }
3352 
3353         PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
3354         if (compute_range) {
3355 
3356           /* ask for eigenvalues larger than thresh */
3357           if (sub_schurs->is_posdef) {
3358 #if defined(PETSC_USE_COMPLEX)
3359             PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3360 #else
3361             PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3362 #endif
3363             PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3364           } else { /* no theory so far, but it works nicely */
3365             PetscInt  recipe = 0,recipe_m = 1;
3366             PetscReal bb[2];
3367 
3368             PetscCall(PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL));
3369             switch (recipe) {
3370             case 0:
3371               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3372               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3373 #if defined(PETSC_USE_COMPLEX)
3374               PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3375 #else
3376               PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3377 #endif
3378               PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3379               break;
3380             case 1:
3381               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3382 #if defined(PETSC_USE_COMPLEX)
3383               PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3384 #else
3385               PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3386 #endif
3387               PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3388               if (!scal) {
3389                 PetscBLASInt B_neigs2 = 0;
3390 
3391                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3392                 PetscCall(PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size));
3393                 PetscCall(PetscArraycpy(St,Starray+cumarray,subset_size*subset_size));
3394 #if defined(PETSC_USE_COMPLEX)
3395                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3396 #else
3397                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3398 #endif
3399                 PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3400                 B_neigs += B_neigs2;
3401               }
3402               break;
3403             case 2:
3404               if (scal) {
3405                 bb[0] = PETSC_MIN_REAL;
3406                 bb[1] = 0;
3407 #if defined(PETSC_USE_COMPLEX)
3408                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3409 #else
3410                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3411 #endif
3412                 PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3413               } else {
3414                 PetscBLASInt B_neigs2 = 0;
3415                 PetscBool    import = PETSC_FALSE;
3416 
3417                 lthresh = PetscMax(lthresh,0.0);
3418                 if (lthresh > 0.0) {
3419                   bb[0] = PETSC_MIN_REAL;
3420                   bb[1] = lthresh*lthresh;
3421 
3422                   import = PETSC_TRUE;
3423 #if defined(PETSC_USE_COMPLEX)
3424                   PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3425 #else
3426                   PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3427 #endif
3428                   PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3429                 }
3430                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3431                 bb[1] = PETSC_MAX_REAL;
3432                 if (import) {
3433                   PetscCall(PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size));
3434                   PetscCall(PetscArraycpy(St,Starray+cumarray,subset_size*subset_size));
3435                 }
3436 #if defined(PETSC_USE_COMPLEX)
3437                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3438 #else
3439                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3440 #endif
3441                 PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3442                 B_neigs += B_neigs2;
3443               }
3444               break;
3445             case 3:
3446               if (scal) {
3447                 PetscCall(PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL));
3448               } else {
3449                 PetscCall(PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL));
3450               }
3451               if (!scal) {
3452                 bb[0] = uthresh;
3453                 bb[1] = PETSC_MAX_REAL;
3454 #if defined(PETSC_USE_COMPLEX)
3455                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3456 #else
3457                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3458 #endif
3459                 PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3460               }
3461               if (recipe_m > 0 && B_N - B_neigs > 0) {
3462                 PetscBLASInt B_neigs2 = 0;
3463 
3464                 B_IL = 1;
3465                 PetscCall(PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU));
3466                 PetscCall(PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size));
3467                 PetscCall(PetscArraycpy(St,Starray+cumarray,subset_size*subset_size));
3468 #if defined(PETSC_USE_COMPLEX)
3469                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3470 #else
3471                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3472 #endif
3473                 PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3474                 B_neigs += B_neigs2;
3475               }
3476               break;
3477             case 4:
3478               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3479 #if defined(PETSC_USE_COMPLEX)
3480               PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3481 #else
3482               PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3483 #endif
3484               PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3485               {
3486                 PetscBLASInt B_neigs2 = 0;
3487 
3488                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3489                 PetscCall(PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size));
3490                 PetscCall(PetscArraycpy(St,Starray+cumarray,subset_size*subset_size));
3491 #if defined(PETSC_USE_COMPLEX)
3492                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3493 #else
3494                 PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3495 #endif
3496                 PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3497                 B_neigs += B_neigs2;
3498               }
3499               break;
3500             case 5: /* same as before: first compute all eigenvalues, then filter */
3501 #if defined(PETSC_USE_COMPLEX)
3502               PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3503 #else
3504               PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3505 #endif
3506               PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3507               {
3508                 PetscInt e,k,ne;
3509                 for (e=0,ne=0;e<B_neigs;e++) {
3510                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3511                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3512                     eigs[ne] = eigs[e];
3513                     ne++;
3514                   }
3515                 }
3516                 PetscCall(PetscArraycpy(eigv,S,B_N*ne));
3517                 B_neigs = ne;
3518               }
3519               break;
3520             default:
3521               SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %" PetscInt_FMT,recipe);
3522             }
3523           }
3524         } else if (!same_data) { /* this is just to see all the eigenvalues */
3525           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3526           B_IL = 1;
3527 #if defined(PETSC_USE_COMPLEX)
3528           PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3529 #else
3530           PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3531 #endif
3532           PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3533         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3534           PetscInt k;
3535           PetscCheck(sub_schurs->change_primal_sub,PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3536           PetscCall(ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax));
3537           PetscCall(PetscBLASIntCast(nmax,&B_neigs));
3538           nmin = nmax;
3539           PetscCall(PetscArrayzero(eigv,subset_size*nmax));
3540           for (k=0;k<nmax;k++) {
3541             eigs[k] = 1./PETSC_SMALL;
3542             eigv[k*(subset_size+1)] = 1.0;
3543           }
3544         }
3545         PetscCall(PetscFPTrapPop());
3546         if (B_ierr) {
3547           PetscCheck(B_ierr >= 0,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %" PetscBLASInt_FMT,-B_ierr);
3548           PetscCheck(B_ierr > B_N,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %" PetscBLASInt_FMT " eigenvalues failed to converge",B_ierr);
3549           SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %" PetscBLASInt_FMT " is not positive definite",B_ierr-B_N-1);
3550         }
3551 
3552         if (B_neigs > nmax) {
3553           if (pcbddc->dbg_flag) {
3554             PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %" PetscBLASInt_FMT " eigs, more than maximum required %" PetscInt_FMT ".\n",B_neigs,nmax));
3555           }
3556           if (upart) eigs_start = scal ? 0 : B_neigs-nmax;
3557           B_neigs = nmax;
3558         }
3559 
3560         nmin_s = PetscMin(nmin,B_N);
3561         if (B_neigs < nmin_s) {
3562           PetscBLASInt B_neigs2 = 0;
3563 
3564           if (upart) {
3565             if (scal) {
3566               B_IU = nmin_s;
3567               B_IL = B_neigs + 1;
3568             } else {
3569               B_IL = B_N - nmin_s + 1;
3570               B_IU = B_N - B_neigs;
3571             }
3572           } else {
3573             B_IL = B_neigs + 1;
3574             B_IU = nmin_s;
3575           }
3576           if (pcbddc->dbg_flag) {
3577             PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %" PetscBLASInt_FMT " eigs, less than minimum required %" PetscInt_FMT ". Asking for %" PetscBLASInt_FMT " to %" PetscBLASInt_FMT " incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU));
3578           }
3579           if (sub_schurs->is_symmetric) {
3580             PetscInt j,k;
3581             for (j=0;j<subset_size;j++) {
3582               for (k=j;k<subset_size;k++) {
3583                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3584                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3585               }
3586             }
3587           } else {
3588             PetscCall(PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size));
3589             PetscCall(PetscArraycpy(St,Starray+cumarray,subset_size*subset_size));
3590           }
3591           PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
3592 #if defined(PETSC_USE_COMPLEX)
3593           PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3594 #else
3595           PetscCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3596 #endif
3597           PetscCall(PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0));
3598           PetscCall(PetscFPTrapPop());
3599           B_neigs += B_neigs2;
3600         }
3601         if (B_ierr) {
3602           PetscCheck(B_ierr >= 0,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %" PetscBLASInt_FMT,-B_ierr);
3603           PetscCheck(B_ierr > B_N,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %" PetscBLASInt_FMT " eigenvalues failed to converge",B_ierr);
3604           SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %" PetscBLASInt_FMT " is not positive definite",B_ierr-B_N-1);
3605         }
3606         if (pcbddc->dbg_flag) {
3607           PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %" PetscBLASInt_FMT " eigs\n",B_neigs));
3608           for (j=0;j<B_neigs;j++) {
3609             if (!sub_schurs->gdsw) {
3610               if (eigs[j] == 0.0) {
3611                 PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n"));
3612               } else {
3613                 if (upart) {
3614                   PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",(double)eigs[j+eigs_start]));
3615                 } else {
3616                   PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",(double)(1./eigs[j+eigs_start])));
3617                 }
3618               }
3619             } else {
3620               double pg = (double)eigs[j+eigs_start];
3621               if (pg < 2*PETSC_SMALL) pg = 0.0;
3622               PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",pg));
3623             }
3624           }
3625         }
3626       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3627     }
3628     /* change the basis back to the original one */
3629     if (sub_schurs->change) {
3630       Mat change,phi,phit;
3631 
3632       if (pcbddc->dbg_flag > 2) {
3633         PetscInt ii;
3634         for (ii=0;ii<B_neigs;ii++) {
3635           PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %" PetscInt_FMT "/%" PetscBLASInt_FMT " (%" PetscBLASInt_FMT ")\n",ii,B_neigs,B_N));
3636           for (j=0;j<B_N;j++) {
3637 #if defined(PETSC_USE_COMPLEX)
3638             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3639             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3640             PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",(double)r,(double)c));
3641 #else
3642             PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",(double)(eigv[(ii+eigs_start)*subset_size+j])));
3643 #endif
3644           }
3645         }
3646       }
3647       PetscCall(KSPGetOperators(sub_schurs->change[i],&change,NULL));
3648       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit));
3649       PetscCall(MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi));
3650       PetscCall(MatCopy(phi,phit,SAME_NONZERO_PATTERN));
3651       PetscCall(MatDestroy(&phit));
3652       PetscCall(MatDestroy(&phi));
3653     }
3654     maxneigs = PetscMax(B_neigs,maxneigs);
3655     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3656     if (B_neigs) {
3657       PetscCall(PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size));
3658 
3659       if (pcbddc->dbg_flag > 1) {
3660         PetscInt ii;
3661         for (ii=0;ii<B_neigs;ii++) {
3662           PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %" PetscInt_FMT "/%" PetscBLASInt_FMT " (%" PetscBLASInt_FMT ")\n",ii,B_neigs,B_N));
3663           for (j=0;j<B_N;j++) {
3664 #if defined(PETSC_USE_COMPLEX)
3665             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3666             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3667             PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",(double)r,(double)c));
3668 #else
3669             PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",(double)PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]])));
3670 #endif
3671           }
3672         }
3673       }
3674       PetscCall(PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size));
3675       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3676       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3677       cum++;
3678     }
3679     PetscCall(ISRestoreIndices(sub_schurs->is_subs[i],&idxs));
3680     /* shift for next computation */
3681     cumarray += subset_size*subset_size;
3682   }
3683   if (pcbddc->dbg_flag) PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
3684 
3685   if (mss) {
3686     if (sub_schurs->gdsw) {
3687       PetscCall(MatSeqAIJGetArray(sub_schurs->sum_S_Ej_all,&Sarray));
3688       PetscCall(MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray));
3689     } else {
3690       PetscCall(MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray));
3691       PetscCall(MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray));
3692       /* destroy matrices (junk) */
3693       PetscCall(MatDestroy(&sub_schurs->sum_S_Ej_inv_all));
3694       PetscCall(MatDestroy(&sub_schurs->sum_S_Ej_tilda_all));
3695     }
3696   }
3697   if (allocated_S_St) PetscCall(PetscFree2(S,St));
3698   PetscCall(PetscFree5(eigv,eigs,work,B_iwork,B_ifail));
3699 #if defined(PETSC_USE_COMPLEX)
3700   PetscCall(PetscFree(rwork));
3701 #endif
3702   if (pcbddc->dbg_flag) {
3703     PetscInt maxneigs_r;
3704     PetscCall(MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc)));
3705     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %" PetscInt_FMT "\n",maxneigs_r));
3706   }
3707   PetscCall(PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0));
3708   PetscFunctionReturn(0);
3709 }
3710 
3711 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3712 {
3713   PetscScalar    *coarse_submat_vals;
3714 
3715   PetscFunctionBegin;
3716   /* Setup local scatters R_to_B and (optionally) R_to_D */
3717   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3718   PetscCall(PCBDDCSetUpLocalScatters(pc));
3719 
3720   /* Setup local neumann solver ksp_R */
3721   /* PCBDDCSetUpLocalScatters should be called first! */
3722   PetscCall(PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE));
3723 
3724   /*
3725      Setup local correction and local part of coarse basis.
3726      Gives back the dense local part of the coarse matrix in column major ordering
3727   */
3728   PetscCall(PCBDDCSetUpCorrection(pc,&coarse_submat_vals));
3729 
3730   /* Compute total number of coarse nodes and setup coarse solver */
3731   PetscCall(PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals));
3732 
3733   /* free */
3734   PetscCall(PetscFree(coarse_submat_vals));
3735   PetscFunctionReturn(0);
3736 }
3737 
3738 PetscErrorCode PCBDDCResetCustomization(PC pc)
3739 {
3740   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3741 
3742   PetscFunctionBegin;
3743   PetscCall(ISDestroy(&pcbddc->user_primal_vertices));
3744   PetscCall(ISDestroy(&pcbddc->user_primal_vertices_local));
3745   PetscCall(ISDestroy(&pcbddc->NeumannBoundaries));
3746   PetscCall(ISDestroy(&pcbddc->NeumannBoundariesLocal));
3747   PetscCall(ISDestroy(&pcbddc->DirichletBoundaries));
3748   PetscCall(MatNullSpaceDestroy(&pcbddc->onearnullspace));
3749   PetscCall(PetscFree(pcbddc->onearnullvecs_state));
3750   PetscCall(ISDestroy(&pcbddc->DirichletBoundariesLocal));
3751   PetscCall(PCBDDCSetDofsSplitting(pc,0,NULL));
3752   PetscCall(PCBDDCSetDofsSplittingLocal(pc,0,NULL));
3753   PetscFunctionReturn(0);
3754 }
3755 
3756 PetscErrorCode PCBDDCResetTopography(PC pc)
3757 {
3758   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3759   PetscInt       i;
3760 
3761   PetscFunctionBegin;
3762   PetscCall(MatDestroy(&pcbddc->nedcG));
3763   PetscCall(ISDestroy(&pcbddc->nedclocal));
3764   PetscCall(MatDestroy(&pcbddc->discretegradient));
3765   PetscCall(MatDestroy(&pcbddc->user_ChangeOfBasisMatrix));
3766   PetscCall(MatDestroy(&pcbddc->ChangeOfBasisMatrix));
3767   PetscCall(MatDestroy(&pcbddc->switch_static_change));
3768   PetscCall(VecDestroy(&pcbddc->work_change));
3769   PetscCall(MatDestroy(&pcbddc->ConstraintMatrix));
3770   PetscCall(MatDestroy(&pcbddc->divudotp));
3771   PetscCall(ISDestroy(&pcbddc->divudotp_vl2l));
3772   PetscCall(PCBDDCGraphDestroy(&pcbddc->mat_graph));
3773   for (i=0;i<pcbddc->n_local_subs;i++) {
3774     PetscCall(ISDestroy(&pcbddc->local_subs[i]));
3775   }
3776   pcbddc->n_local_subs = 0;
3777   PetscCall(PetscFree(pcbddc->local_subs));
3778   PetscCall(PCBDDCSubSchursDestroy(&pcbddc->sub_schurs));
3779   pcbddc->graphanalyzed        = PETSC_FALSE;
3780   pcbddc->recompute_topography = PETSC_TRUE;
3781   pcbddc->corner_selected      = PETSC_FALSE;
3782   PetscFunctionReturn(0);
3783 }
3784 
3785 PetscErrorCode PCBDDCResetSolvers(PC pc)
3786 {
3787   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3788 
3789   PetscFunctionBegin;
3790   PetscCall(VecDestroy(&pcbddc->coarse_vec));
3791   if (pcbddc->coarse_phi_B) {
3792     PetscScalar *array;
3793     PetscCall(MatDenseGetArray(pcbddc->coarse_phi_B,&array));
3794     PetscCall(PetscFree(array));
3795   }
3796   PetscCall(MatDestroy(&pcbddc->coarse_phi_B));
3797   PetscCall(MatDestroy(&pcbddc->coarse_phi_D));
3798   PetscCall(MatDestroy(&pcbddc->coarse_psi_B));
3799   PetscCall(MatDestroy(&pcbddc->coarse_psi_D));
3800   PetscCall(VecDestroy(&pcbddc->vec1_P));
3801   PetscCall(VecDestroy(&pcbddc->vec1_C));
3802   PetscCall(MatDestroy(&pcbddc->local_auxmat2));
3803   PetscCall(MatDestroy(&pcbddc->local_auxmat1));
3804   PetscCall(VecDestroy(&pcbddc->vec1_R));
3805   PetscCall(VecDestroy(&pcbddc->vec2_R));
3806   PetscCall(ISDestroy(&pcbddc->is_R_local));
3807   PetscCall(VecScatterDestroy(&pcbddc->R_to_B));
3808   PetscCall(VecScatterDestroy(&pcbddc->R_to_D));
3809   PetscCall(VecScatterDestroy(&pcbddc->coarse_loc_to_glob));
3810   PetscCall(KSPReset(pcbddc->ksp_D));
3811   PetscCall(KSPReset(pcbddc->ksp_R));
3812   PetscCall(KSPReset(pcbddc->coarse_ksp));
3813   PetscCall(MatDestroy(&pcbddc->local_mat));
3814   PetscCall(PetscFree(pcbddc->primal_indices_local_idxs));
3815   PetscCall(PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult));
3816   PetscCall(PetscFree(pcbddc->global_primal_indices));
3817   PetscCall(ISDestroy(&pcbddc->coarse_subassembling));
3818   PetscCall(MatDestroy(&pcbddc->benign_change));
3819   PetscCall(VecDestroy(&pcbddc->benign_vec));
3820   PetscCall(PCBDDCBenignShellMat(pc,PETSC_TRUE));
3821   PetscCall(MatDestroy(&pcbddc->benign_B0));
3822   PetscCall(PetscSFDestroy(&pcbddc->benign_sf));
3823   if (pcbddc->benign_zerodiag_subs) {
3824     PetscInt i;
3825     for (i=0;i<pcbddc->benign_n;i++) {
3826       PetscCall(ISDestroy(&pcbddc->benign_zerodiag_subs[i]));
3827     }
3828     PetscCall(PetscFree(pcbddc->benign_zerodiag_subs));
3829   }
3830   PetscCall(PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0));
3831   PetscFunctionReturn(0);
3832 }
3833 
3834 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3835 {
3836   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3837   PC_IS          *pcis = (PC_IS*)pc->data;
3838   VecType        impVecType;
3839   PetscInt       n_constraints,n_R,old_size;
3840 
3841   PetscFunctionBegin;
3842   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3843   n_R = pcis->n - pcbddc->n_vertices;
3844   PetscCall(VecGetType(pcis->vec1_N,&impVecType));
3845   /* local work vectors (try to avoid unneeded work)*/
3846   /* R nodes */
3847   old_size = -1;
3848   if (pcbddc->vec1_R) {
3849     PetscCall(VecGetSize(pcbddc->vec1_R,&old_size));
3850   }
3851   if (n_R != old_size) {
3852     PetscCall(VecDestroy(&pcbddc->vec1_R));
3853     PetscCall(VecDestroy(&pcbddc->vec2_R));
3854     PetscCall(VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R));
3855     PetscCall(VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R));
3856     PetscCall(VecSetType(pcbddc->vec1_R,impVecType));
3857     PetscCall(VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R));
3858   }
3859   /* local primal dofs */
3860   old_size = -1;
3861   if (pcbddc->vec1_P) {
3862     PetscCall(VecGetSize(pcbddc->vec1_P,&old_size));
3863   }
3864   if (pcbddc->local_primal_size != old_size) {
3865     PetscCall(VecDestroy(&pcbddc->vec1_P));
3866     PetscCall(VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P));
3867     PetscCall(VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size));
3868     PetscCall(VecSetType(pcbddc->vec1_P,impVecType));
3869   }
3870   /* local explicit constraints */
3871   old_size = -1;
3872   if (pcbddc->vec1_C) {
3873     PetscCall(VecGetSize(pcbddc->vec1_C,&old_size));
3874   }
3875   if (n_constraints && n_constraints != old_size) {
3876     PetscCall(VecDestroy(&pcbddc->vec1_C));
3877     PetscCall(VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C));
3878     PetscCall(VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints));
3879     PetscCall(VecSetType(pcbddc->vec1_C,impVecType));
3880   }
3881   PetscFunctionReturn(0);
3882 }
3883 
3884 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3885 {
3886   /* pointers to pcis and pcbddc */
3887   PC_IS*          pcis = (PC_IS*)pc->data;
3888   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3889   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3890   /* submatrices of local problem */
3891   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3892   /* submatrices of local coarse problem */
3893   Mat             S_VV,S_CV,S_VC,S_CC;
3894   /* working matrices */
3895   Mat             C_CR;
3896   /* additional working stuff */
3897   PC              pc_R;
3898   Mat             F,Brhs = NULL;
3899   Vec             dummy_vec;
3900   PetscBool       isLU,isCHOL,need_benign_correction,sparserhs;
3901   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3902   PetscScalar     *work;
3903   PetscInt        *idx_V_B;
3904   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3905   PetscInt        i,n_R,n_D,n_B;
3906   PetscScalar     one=1.0,m_one=-1.0;
3907 
3908   PetscFunctionBegin;
3909   PetscCheck(pcbddc->symmetric_primal || !pcbddc->benign_n,PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3910   PetscCall(PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0));
3911 
3912   /* Set Non-overlapping dimensions */
3913   n_vertices = pcbddc->n_vertices;
3914   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3915   n_B = pcis->n_B;
3916   n_D = pcis->n - n_B;
3917   n_R = pcis->n - n_vertices;
3918 
3919   /* vertices in boundary numbering */
3920   PetscCall(PetscMalloc1(n_vertices,&idx_V_B));
3921   PetscCall(ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B));
3922   PetscCheck(i == n_vertices,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %" PetscInt_FMT " != %" PetscInt_FMT,n_vertices,i);
3923 
3924   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3925   PetscCall(PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals));
3926   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV));
3927   PetscCall(MatDenseSetLDA(S_VV,pcbddc->local_primal_size));
3928   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV));
3929   PetscCall(MatDenseSetLDA(S_CV,pcbddc->local_primal_size));
3930   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC));
3931   PetscCall(MatDenseSetLDA(S_VC,pcbddc->local_primal_size));
3932   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC));
3933   PetscCall(MatDenseSetLDA(S_CC,pcbddc->local_primal_size));
3934 
3935   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3936   PetscCall(KSPGetPC(pcbddc->ksp_R,&pc_R));
3937   PetscCall(PCSetUp(pc_R));
3938   PetscCall(PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU));
3939   PetscCall(PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL));
3940   lda_rhs = n_R;
3941   need_benign_correction = PETSC_FALSE;
3942   if (isLU || isCHOL) {
3943     PetscCall(PCFactorGetMatrix(pc_R,&F));
3944   } else if (sub_schurs && sub_schurs->reuse_solver) {
3945     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3946     MatFactorType      type;
3947 
3948     F = reuse_solver->F;
3949     PetscCall(MatGetFactorType(F,&type));
3950     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3951     if (type == MAT_FACTOR_LU) isLU = PETSC_TRUE;
3952     PetscCall(MatGetSize(F,&lda_rhs,NULL));
3953     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3954   } else F = NULL;
3955 
3956   /* determine if we can use a sparse right-hand side */
3957   sparserhs = PETSC_FALSE;
3958   if (F) {
3959     MatSolverType solver;
3960 
3961     PetscCall(MatFactorGetSolverType(F,&solver));
3962     PetscCall(PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs));
3963   }
3964 
3965   /* allocate workspace */
3966   n = 0;
3967   if (n_constraints) {
3968     n += lda_rhs*n_constraints;
3969   }
3970   if (n_vertices) {
3971     n = PetscMax(2*lda_rhs*n_vertices,n);
3972     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3973   }
3974   if (!pcbddc->symmetric_primal) {
3975     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3976   }
3977   PetscCall(PetscMalloc1(n,&work));
3978 
3979   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3980   dummy_vec = NULL;
3981   if (need_benign_correction && lda_rhs != n_R && F) {
3982     PetscCall(VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec));
3983     PetscCall(VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE));
3984     PetscCall(VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name));
3985   }
3986 
3987   PetscCall(MatDestroy(&pcbddc->local_auxmat1));
3988   PetscCall(MatDestroy(&pcbddc->local_auxmat2));
3989 
3990   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3991   if (n_constraints) {
3992     Mat         M3,C_B;
3993     IS          is_aux;
3994 
3995     /* Extract constraints on R nodes: C_{CR}  */
3996     PetscCall(ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux));
3997     PetscCall(MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR));
3998     PetscCall(MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B));
3999 
4000     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4001     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4002     if (!sparserhs) {
4003       PetscCall(PetscArrayzero(work,lda_rhs*n_constraints));
4004       for (i=0;i<n_constraints;i++) {
4005         const PetscScalar *row_cmat_values;
4006         const PetscInt    *row_cmat_indices;
4007         PetscInt          size_of_constraint,j;
4008 
4009         PetscCall(MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values));
4010         for (j=0;j<size_of_constraint;j++) {
4011           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4012         }
4013         PetscCall(MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values));
4014       }
4015       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs));
4016     } else {
4017       Mat tC_CR;
4018 
4019       PetscCall(MatScale(C_CR,-1.0));
4020       if (lda_rhs != n_R) {
4021         PetscScalar *aa;
4022         PetscInt    r,*ii,*jj;
4023         PetscBool   done;
4024 
4025         PetscCall(MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done));
4026         PetscCheck(done,PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4027         PetscCall(MatSeqAIJGetArray(C_CR,&aa));
4028         PetscCall(MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR));
4029         PetscCall(MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done));
4030         PetscCheck(done,PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4031       } else {
4032         PetscCall(PetscObjectReference((PetscObject)C_CR));
4033         tC_CR = C_CR;
4034       }
4035       PetscCall(MatCreateTranspose(tC_CR,&Brhs));
4036       PetscCall(MatDestroy(&tC_CR));
4037     }
4038     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R));
4039     if (F) {
4040       if (need_benign_correction) {
4041         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4042 
4043         /* rhs is already zero on interior dofs, no need to change the rhs */
4044         PetscCall(PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n));
4045       }
4046       PetscCall(MatMatSolve(F,Brhs,local_auxmat2_R));
4047       if (need_benign_correction) {
4048         PetscScalar        *marr;
4049         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4050 
4051         PetscCall(MatDenseGetArray(local_auxmat2_R,&marr));
4052         if (lda_rhs != n_R) {
4053           for (i=0;i<n_constraints;i++) {
4054             PetscCall(VecPlaceArray(dummy_vec,marr+i*lda_rhs));
4055             PetscCall(PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE));
4056             PetscCall(VecResetArray(dummy_vec));
4057           }
4058         } else {
4059           for (i=0;i<n_constraints;i++) {
4060             PetscCall(VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs));
4061             PetscCall(PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE));
4062             PetscCall(VecResetArray(pcbddc->vec1_R));
4063           }
4064         }
4065         PetscCall(MatDenseRestoreArray(local_auxmat2_R,&marr));
4066       }
4067     } else {
4068       PetscScalar *marr;
4069 
4070       PetscCall(MatDenseGetArray(local_auxmat2_R,&marr));
4071       for (i=0;i<n_constraints;i++) {
4072         PetscCall(VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs));
4073         PetscCall(VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs));
4074         PetscCall(KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R));
4075         PetscCall(KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R));
4076         PetscCall(VecResetArray(pcbddc->vec1_R));
4077         PetscCall(VecResetArray(pcbddc->vec2_R));
4078       }
4079       PetscCall(MatDenseRestoreArray(local_auxmat2_R,&marr));
4080     }
4081     if (sparserhs) PetscCall(MatScale(C_CR,-1.0));
4082     PetscCall(MatDestroy(&Brhs));
4083     if (!pcbddc->switch_static) {
4084       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2));
4085       for (i=0;i<n_constraints;i++) {
4086         Vec r, b;
4087         PetscCall(MatDenseGetColumnVecRead(local_auxmat2_R,i,&r));
4088         PetscCall(MatDenseGetColumnVec(pcbddc->local_auxmat2,i,&b));
4089         PetscCall(VecScatterBegin(pcbddc->R_to_B,r,b,INSERT_VALUES,SCATTER_FORWARD));
4090         PetscCall(VecScatterEnd(pcbddc->R_to_B,r,b,INSERT_VALUES,SCATTER_FORWARD));
4091         PetscCall(MatDenseRestoreColumnVec(pcbddc->local_auxmat2,i,&b));
4092         PetscCall(MatDenseRestoreColumnVecRead(local_auxmat2_R,i,&r));
4093       }
4094       PetscCall(MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3));
4095     } else {
4096       if (lda_rhs != n_R) {
4097         IS dummy;
4098 
4099         PetscCall(ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy));
4100         PetscCall(MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2));
4101         PetscCall(ISDestroy(&dummy));
4102       } else {
4103         PetscCall(PetscObjectReference((PetscObject)local_auxmat2_R));
4104         pcbddc->local_auxmat2 = local_auxmat2_R;
4105       }
4106       PetscCall(MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3));
4107     }
4108     PetscCall(ISDestroy(&is_aux));
4109     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR})^{-1}  */
4110     PetscCall(MatScale(M3,m_one));
4111     if (isCHOL) {
4112       PetscCall(MatCholeskyFactor(M3,NULL,NULL));
4113     } else {
4114       PetscCall(MatLUFactor(M3,NULL,NULL,NULL));
4115     }
4116     PetscCall(MatSeqDenseInvertFactors_Private(M3));
4117     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4118     PetscCall(MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1));
4119     PetscCall(MatDestroy(&C_B));
4120     PetscCall(MatCopy(M3,S_CC,SAME_NONZERO_PATTERN)); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4121     PetscCall(MatDestroy(&M3));
4122   }
4123 
4124   /* Get submatrices from subdomain matrix */
4125   if (n_vertices) {
4126 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4127     PetscBool oldpin;
4128 #endif
4129     PetscBool isaij;
4130     IS        is_aux;
4131 
4132     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4133       IS tis;
4134 
4135       PetscCall(ISDuplicate(pcbddc->is_R_local,&tis));
4136       PetscCall(ISSort(tis));
4137       PetscCall(ISComplement(tis,0,pcis->n,&is_aux));
4138       PetscCall(ISDestroy(&tis));
4139     } else {
4140       PetscCall(ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux));
4141     }
4142 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4143     oldpin = pcbddc->local_mat->boundtocpu;
4144 #endif
4145     PetscCall(MatBindToCPU(pcbddc->local_mat,PETSC_TRUE));
4146     PetscCall(MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV));
4147     PetscCall(MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR));
4148     PetscCall(PetscObjectBaseTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isaij));
4149     if (!isaij) { /* TODO REMOVE: MatMatMult(A_VR,A_RRmA_RV) below may raise an error */
4150       PetscCall(MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR));
4151     }
4152     PetscCall(MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV));
4153 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4154     PetscCall(MatBindToCPU(pcbddc->local_mat,oldpin));
4155 #endif
4156     PetscCall(ISDestroy(&is_aux));
4157   }
4158 
4159   /* Matrix of coarse basis functions (local) */
4160   if (pcbddc->coarse_phi_B) {
4161     PetscInt on_B,on_primal,on_D=n_D;
4162     if (pcbddc->coarse_phi_D) {
4163       PetscCall(MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL));
4164     }
4165     PetscCall(MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal));
4166     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4167       PetscScalar *marray;
4168 
4169       PetscCall(MatDenseGetArray(pcbddc->coarse_phi_B,&marray));
4170       PetscCall(PetscFree(marray));
4171       PetscCall(MatDestroy(&pcbddc->coarse_phi_B));
4172       PetscCall(MatDestroy(&pcbddc->coarse_psi_B));
4173       PetscCall(MatDestroy(&pcbddc->coarse_phi_D));
4174       PetscCall(MatDestroy(&pcbddc->coarse_psi_D));
4175     }
4176   }
4177 
4178   if (!pcbddc->coarse_phi_B) {
4179     PetscScalar *marr;
4180 
4181     /* memory size */
4182     n = n_B*pcbddc->local_primal_size;
4183     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4184     if (!pcbddc->symmetric_primal) n *= 2;
4185     PetscCall(PetscCalloc1(n,&marr));
4186     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B));
4187     marr += n_B*pcbddc->local_primal_size;
4188     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4189       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D));
4190       marr += n_D*pcbddc->local_primal_size;
4191     }
4192     if (!pcbddc->symmetric_primal) {
4193       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B));
4194       marr += n_B*pcbddc->local_primal_size;
4195       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4196         PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D));
4197       }
4198     } else {
4199       PetscCall(PetscObjectReference((PetscObject)pcbddc->coarse_phi_B));
4200       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4201       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4202         PetscCall(PetscObjectReference((PetscObject)pcbddc->coarse_phi_D));
4203         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4204       }
4205     }
4206   }
4207 
4208   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4209   p0_lidx_I = NULL;
4210   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4211     const PetscInt *idxs;
4212 
4213     PetscCall(ISGetIndices(pcis->is_I_local,&idxs));
4214     PetscCall(PetscMalloc1(pcbddc->benign_n,&p0_lidx_I));
4215     for (i=0;i<pcbddc->benign_n;i++) {
4216       PetscCall(PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]));
4217     }
4218     PetscCall(ISRestoreIndices(pcis->is_I_local,&idxs));
4219   }
4220 
4221   /* vertices */
4222   if (n_vertices) {
4223     PetscBool restoreavr = PETSC_FALSE;
4224 
4225     PetscCall(MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV));
4226 
4227     if (n_R) {
4228       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4229       PetscBLASInt      B_N,B_one = 1;
4230       const PetscScalar *x;
4231       PetscScalar       *y;
4232 
4233       PetscCall(MatScale(A_RV,m_one));
4234       if (need_benign_correction) {
4235         ISLocalToGlobalMapping RtoN;
4236         IS                     is_p0;
4237         PetscInt               *idxs_p0,n;
4238 
4239         PetscCall(PetscMalloc1(pcbddc->benign_n,&idxs_p0));
4240         PetscCall(ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN));
4241         PetscCall(ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0));
4242         PetscCheck(n == pcbddc->benign_n,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %" PetscInt_FMT " != %" PetscInt_FMT,n,pcbddc->benign_n);
4243         PetscCall(ISLocalToGlobalMappingDestroy(&RtoN));
4244         PetscCall(ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0));
4245         PetscCall(MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr));
4246         PetscCall(ISDestroy(&is_p0));
4247       }
4248 
4249       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV));
4250       if (!sparserhs || need_benign_correction) {
4251         if (lda_rhs == n_R) {
4252           PetscCall(MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV));
4253         } else {
4254           PetscScalar    *av,*array;
4255           const PetscInt *xadj,*adjncy;
4256           PetscInt       n;
4257           PetscBool      flg_row;
4258 
4259           array = work+lda_rhs*n_vertices;
4260           PetscCall(PetscArrayzero(array,lda_rhs*n_vertices));
4261           PetscCall(MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV));
4262           PetscCall(MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row));
4263           PetscCall(MatSeqAIJGetArray(A_RV,&av));
4264           for (i=0;i<n;i++) {
4265             PetscInt j;
4266             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4267           }
4268           PetscCall(MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row));
4269           PetscCall(MatDestroy(&A_RV));
4270           PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV));
4271         }
4272         if (need_benign_correction) {
4273           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4274           PetscScalar        *marr;
4275 
4276           PetscCall(MatDenseGetArray(A_RV,&marr));
4277           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4278 
4279                  | 0 0  0 | (V)
4280              L = | 0 0 -1 | (P-p0)
4281                  | 0 0 -1 | (p0)
4282 
4283           */
4284           for (i=0;i<reuse_solver->benign_n;i++) {
4285             const PetscScalar *vals;
4286             const PetscInt    *idxs,*idxs_zero;
4287             PetscInt          n,j,nz;
4288 
4289             PetscCall(ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz));
4290             PetscCall(ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero));
4291             PetscCall(MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals));
4292             for (j=0;j<n;j++) {
4293               PetscScalar val = vals[j];
4294               PetscInt    k,col = idxs[j];
4295               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4296             }
4297             PetscCall(MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals));
4298             PetscCall(ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero));
4299           }
4300           PetscCall(MatDenseRestoreArray(A_RV,&marr));
4301         }
4302         PetscCall(PetscObjectReference((PetscObject)A_RV));
4303         Brhs = A_RV;
4304       } else {
4305         Mat tA_RVT,A_RVT;
4306 
4307         if (!pcbddc->symmetric_primal) {
4308           /* A_RV already scaled by -1 */
4309           PetscCall(MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT));
4310         } else {
4311           restoreavr = PETSC_TRUE;
4312           PetscCall(MatScale(A_VR,-1.0));
4313           PetscCall(PetscObjectReference((PetscObject)A_VR));
4314           A_RVT = A_VR;
4315         }
4316         if (lda_rhs != n_R) {
4317           PetscScalar *aa;
4318           PetscInt    r,*ii,*jj;
4319           PetscBool   done;
4320 
4321           PetscCall(MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done));
4322           PetscCheck(done,PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4323           PetscCall(MatSeqAIJGetArray(A_RVT,&aa));
4324           PetscCall(MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT));
4325           PetscCall(MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done));
4326           PetscCheck(done,PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4327         } else {
4328           PetscCall(PetscObjectReference((PetscObject)A_RVT));
4329           tA_RVT = A_RVT;
4330         }
4331         PetscCall(MatCreateTranspose(tA_RVT,&Brhs));
4332         PetscCall(MatDestroy(&tA_RVT));
4333         PetscCall(MatDestroy(&A_RVT));
4334       }
4335       if (F) {
4336         /* need to correct the rhs */
4337         if (need_benign_correction) {
4338           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4339           PetscScalar        *marr;
4340 
4341           PetscCall(MatDenseGetArray(Brhs,&marr));
4342           if (lda_rhs != n_R) {
4343             for (i=0;i<n_vertices;i++) {
4344               PetscCall(VecPlaceArray(dummy_vec,marr+i*lda_rhs));
4345               PetscCall(PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE));
4346               PetscCall(VecResetArray(dummy_vec));
4347             }
4348           } else {
4349             for (i=0;i<n_vertices;i++) {
4350               PetscCall(VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs));
4351               PetscCall(PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE));
4352               PetscCall(VecResetArray(pcbddc->vec1_R));
4353             }
4354           }
4355           PetscCall(MatDenseRestoreArray(Brhs,&marr));
4356         }
4357         PetscCall(MatMatSolve(F,Brhs,A_RRmA_RV));
4358         if (restoreavr) PetscCall(MatScale(A_VR,-1.0));
4359         /* need to correct the solution */
4360         if (need_benign_correction) {
4361           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4362           PetscScalar        *marr;
4363 
4364           PetscCall(MatDenseGetArray(A_RRmA_RV,&marr));
4365           if (lda_rhs != n_R) {
4366             for (i=0;i<n_vertices;i++) {
4367               PetscCall(VecPlaceArray(dummy_vec,marr+i*lda_rhs));
4368               PetscCall(PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE));
4369               PetscCall(VecResetArray(dummy_vec));
4370             }
4371           } else {
4372             for (i=0;i<n_vertices;i++) {
4373               PetscCall(VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs));
4374               PetscCall(PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE));
4375               PetscCall(VecResetArray(pcbddc->vec1_R));
4376             }
4377           }
4378           PetscCall(MatDenseRestoreArray(A_RRmA_RV,&marr));
4379         }
4380       } else {
4381         PetscCall(MatDenseGetArray(Brhs,&y));
4382         for (i=0;i<n_vertices;i++) {
4383           PetscCall(VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs));
4384           PetscCall(VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs));
4385           PetscCall(KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R));
4386           PetscCall(KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R));
4387           PetscCall(VecResetArray(pcbddc->vec1_R));
4388           PetscCall(VecResetArray(pcbddc->vec2_R));
4389         }
4390         PetscCall(MatDenseRestoreArray(Brhs,&y));
4391       }
4392       PetscCall(MatDestroy(&A_RV));
4393       PetscCall(MatDestroy(&Brhs));
4394       /* S_VV and S_CV */
4395       if (n_constraints) {
4396         Mat B;
4397 
4398         PetscCall(PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices));
4399         for (i=0;i<n_vertices;i++) {
4400           PetscCall(VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs));
4401           PetscCall(VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B));
4402           PetscCall(VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD));
4403           PetscCall(VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD));
4404           PetscCall(VecResetArray(pcis->vec1_B));
4405           PetscCall(VecResetArray(pcbddc->vec1_R));
4406         }
4407         PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B));
4408         /* Reuse dense S_C = pcbddc->local_auxmat1 * B */
4409         PetscCall(MatProductCreateWithMat(pcbddc->local_auxmat1,B,NULL,S_CV));
4410         PetscCall(MatProductSetType(S_CV,MATPRODUCT_AB));
4411         PetscCall(MatProductSetFromOptions(S_CV));
4412         PetscCall(MatProductSymbolic(S_CV));
4413         PetscCall(MatProductNumeric(S_CV));
4414         PetscCall(MatProductClear(S_CV));
4415 
4416         PetscCall(MatDestroy(&B));
4417         PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B));
4418         /* Reuse B = local_auxmat2_R * S_CV */
4419         PetscCall(MatProductCreateWithMat(local_auxmat2_R,S_CV,NULL,B));
4420         PetscCall(MatProductSetType(B,MATPRODUCT_AB));
4421         PetscCall(MatProductSetFromOptions(B));
4422         PetscCall(MatProductSymbolic(B));
4423         PetscCall(MatProductNumeric(B));
4424 
4425         PetscCall(MatScale(S_CV,m_one));
4426         PetscCall(PetscBLASIntCast(lda_rhs*n_vertices,&B_N));
4427         PetscCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4428         PetscCall(MatDestroy(&B));
4429       }
4430       if (lda_rhs != n_R) {
4431         PetscCall(MatDestroy(&A_RRmA_RV));
4432         PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV));
4433         PetscCall(MatDenseSetLDA(A_RRmA_RV,lda_rhs));
4434       }
4435       PetscCall(MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt));
4436       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4437       if (need_benign_correction) {
4438         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4439         PetscScalar        *marr,*sums;
4440 
4441         PetscCall(PetscMalloc1(n_vertices,&sums));
4442         PetscCall(MatDenseGetArray(S_VVt,&marr));
4443         for (i=0;i<reuse_solver->benign_n;i++) {
4444           const PetscScalar *vals;
4445           const PetscInt    *idxs,*idxs_zero;
4446           PetscInt          n,j,nz;
4447 
4448           PetscCall(ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz));
4449           PetscCall(ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero));
4450           for (j=0;j<n_vertices;j++) {
4451             PetscInt k;
4452             sums[j] = 0.;
4453             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4454           }
4455           PetscCall(MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals));
4456           for (j=0;j<n;j++) {
4457             PetscScalar val = vals[j];
4458             PetscInt k;
4459             for (k=0;k<n_vertices;k++) {
4460               marr[idxs[j]+k*n_vertices] += val*sums[k];
4461             }
4462           }
4463           PetscCall(MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals));
4464           PetscCall(ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero));
4465         }
4466         PetscCall(PetscFree(sums));
4467         PetscCall(MatDenseRestoreArray(S_VVt,&marr));
4468         PetscCall(MatDestroy(&A_RV_bcorr));
4469       }
4470       PetscCall(MatDestroy(&A_RRmA_RV));
4471       PetscCall(PetscBLASIntCast(n_vertices*n_vertices,&B_N));
4472       PetscCall(MatDenseGetArrayRead(A_VV,&x));
4473       PetscCall(MatDenseGetArray(S_VVt,&y));
4474       PetscCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4475       PetscCall(MatDenseRestoreArrayRead(A_VV,&x));
4476       PetscCall(MatDenseRestoreArray(S_VVt,&y));
4477       PetscCall(MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN));
4478       PetscCall(MatDestroy(&S_VVt));
4479     } else {
4480       PetscCall(MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN));
4481     }
4482     PetscCall(MatDestroy(&A_VV));
4483 
4484     /* coarse basis functions */
4485     for (i=0;i<n_vertices;i++) {
4486       Vec         v;
4487       PetscScalar one = 1.0,zero = 0.0;
4488 
4489       PetscCall(VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i));
4490       PetscCall(MatDenseGetColumnVec(pcbddc->coarse_phi_B,i,&v));
4491       PetscCall(VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4492       PetscCall(VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4493       if (PetscDefined(USE_DEBUG)) { /* The following VecSetValues() expects a sequential matrix */
4494         PetscMPIInt rank;
4495         PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)pcbddc->coarse_phi_B),&rank));
4496         PetscCheck(rank <= 1,PetscObjectComm((PetscObject)pcbddc->coarse_phi_B),PETSC_ERR_PLIB,"Expected a sequential dense matrix");
4497       }
4498       PetscCall(VecSetValues(v,1,&idx_V_B[i],&one,INSERT_VALUES));
4499       PetscCall(VecAssemblyBegin(v)); /* If v is on device, hope VecSetValues() eventually implemented by a host to device memcopy */
4500       PetscCall(VecAssemblyEnd(v));
4501       PetscCall(MatDenseRestoreColumnVec(pcbddc->coarse_phi_B,i,&v));
4502 
4503       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4504         PetscInt j;
4505 
4506         PetscCall(MatDenseGetColumnVec(pcbddc->coarse_phi_D,i,&v));
4507         PetscCall(VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4508         PetscCall(VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4509         if (PetscDefined(USE_DEBUG)) { /* The following VecSetValues() expects a sequential matrix */
4510           PetscMPIInt rank;
4511           PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)pcbddc->coarse_phi_D),&rank));
4512           PetscCheck(rank <= 1,PetscObjectComm((PetscObject)pcbddc->coarse_phi_D),PETSC_ERR_PLIB,"Expected a sequential dense matrix");
4513         }
4514         for (j=0;j<pcbddc->benign_n;j++) PetscCall(VecSetValues(v,1,&p0_lidx_I[j],&zero,INSERT_VALUES));
4515         PetscCall(VecAssemblyBegin(v));
4516         PetscCall(VecAssemblyEnd(v));
4517         PetscCall(MatDenseRestoreColumnVec(pcbddc->coarse_phi_D,i,&v));
4518       }
4519       PetscCall(VecResetArray(pcbddc->vec1_R));
4520     }
4521     /* if n_R == 0 the object is not destroyed */
4522     PetscCall(MatDestroy(&A_RV));
4523   }
4524   PetscCall(VecDestroy(&dummy_vec));
4525 
4526   if (n_constraints) {
4527     Mat B;
4528 
4529     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B));
4530     PetscCall(MatScale(S_CC,m_one));
4531     PetscCall(MatProductCreateWithMat(local_auxmat2_R,S_CC,NULL,B));
4532     PetscCall(MatProductSetType(B,MATPRODUCT_AB));
4533     PetscCall(MatProductSetFromOptions(B));
4534     PetscCall(MatProductSymbolic(B));
4535     PetscCall(MatProductNumeric(B));
4536 
4537     PetscCall(MatScale(S_CC,m_one));
4538     if (n_vertices) {
4539       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4540         PetscCall(MatTransposeSetPrecursor(S_CV,S_VC));
4541         PetscCall(MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC));
4542       } else {
4543         Mat S_VCt;
4544 
4545         if (lda_rhs != n_R) {
4546           PetscCall(MatDestroy(&B));
4547           PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B));
4548           PetscCall(MatDenseSetLDA(B,lda_rhs));
4549         }
4550         PetscCall(MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt));
4551         PetscCall(MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN));
4552         PetscCall(MatDestroy(&S_VCt));
4553       }
4554     }
4555     PetscCall(MatDestroy(&B));
4556     /* coarse basis functions */
4557     for (i=0;i<n_constraints;i++) {
4558       Vec v;
4559 
4560       PetscCall(VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i));
4561       PetscCall(MatDenseGetColumnVec(pcbddc->coarse_phi_B,i+n_vertices,&v));
4562       PetscCall(VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4563       PetscCall(VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4564       PetscCall(MatDenseRestoreColumnVec(pcbddc->coarse_phi_B,i+n_vertices,&v));
4565       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4566         PetscInt    j;
4567         PetscScalar zero = 0.0;
4568         PetscCall(MatDenseGetColumnVec(pcbddc->coarse_phi_D,i+n_vertices,&v));
4569         PetscCall(VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4570         PetscCall(VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4571         for (j=0;j<pcbddc->benign_n;j++) PetscCall(VecSetValues(v,1,&p0_lidx_I[j],&zero,INSERT_VALUES));
4572         PetscCall(VecAssemblyBegin(v));
4573         PetscCall(VecAssemblyEnd(v));
4574         PetscCall(MatDenseRestoreColumnVec(pcbddc->coarse_phi_D,i+n_vertices,&v));
4575       }
4576       PetscCall(VecResetArray(pcbddc->vec1_R));
4577     }
4578   }
4579   if (n_constraints) {
4580     PetscCall(MatDestroy(&local_auxmat2_R));
4581   }
4582   PetscCall(PetscFree(p0_lidx_I));
4583 
4584   /* coarse matrix entries relative to B_0 */
4585   if (pcbddc->benign_n) {
4586     Mat               B0_B,B0_BPHI;
4587     IS                is_dummy;
4588     const PetscScalar *data;
4589     PetscInt          j;
4590 
4591     PetscCall(ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy));
4592     PetscCall(MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B));
4593     PetscCall(ISDestroy(&is_dummy));
4594     PetscCall(MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI));
4595     PetscCall(MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI));
4596     PetscCall(MatDenseGetArrayRead(B0_BPHI,&data));
4597     for (j=0;j<pcbddc->benign_n;j++) {
4598       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4599       for (i=0;i<pcbddc->local_primal_size;i++) {
4600         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4601         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4602       }
4603     }
4604     PetscCall(MatDenseRestoreArrayRead(B0_BPHI,&data));
4605     PetscCall(MatDestroy(&B0_B));
4606     PetscCall(MatDestroy(&B0_BPHI));
4607   }
4608 
4609   /* compute other basis functions for non-symmetric problems */
4610   if (!pcbddc->symmetric_primal) {
4611     Mat         B_V=NULL,B_C=NULL;
4612     PetscScalar *marray;
4613 
4614     if (n_constraints) {
4615       Mat S_CCT,C_CRT;
4616 
4617       PetscCall(MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT));
4618       PetscCall(MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT));
4619       PetscCall(MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C));
4620       PetscCall(MatDestroy(&S_CCT));
4621       if (n_vertices) {
4622         Mat S_VCT;
4623 
4624         PetscCall(MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT));
4625         PetscCall(MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V));
4626         PetscCall(MatDestroy(&S_VCT));
4627       }
4628       PetscCall(MatDestroy(&C_CRT));
4629     } else {
4630       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V));
4631     }
4632     if (n_vertices && n_R) {
4633       PetscScalar    *av,*marray;
4634       const PetscInt *xadj,*adjncy;
4635       PetscInt       n;
4636       PetscBool      flg_row;
4637 
4638       /* B_V = B_V - A_VR^T */
4639       PetscCall(MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR));
4640       PetscCall(MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row));
4641       PetscCall(MatSeqAIJGetArray(A_VR,&av));
4642       PetscCall(MatDenseGetArray(B_V,&marray));
4643       for (i=0;i<n;i++) {
4644         PetscInt j;
4645         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4646       }
4647       PetscCall(MatDenseRestoreArray(B_V,&marray));
4648       PetscCall(MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row));
4649       PetscCall(MatDestroy(&A_VR));
4650     }
4651 
4652     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4653     if (n_vertices) {
4654       PetscCall(MatDenseGetArray(B_V,&marray));
4655       for (i=0;i<n_vertices;i++) {
4656         PetscCall(VecPlaceArray(pcbddc->vec1_R,marray+i*n_R));
4657         PetscCall(VecPlaceArray(pcbddc->vec2_R,work+i*n_R));
4658         PetscCall(KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R));
4659         PetscCall(KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R));
4660         PetscCall(VecResetArray(pcbddc->vec1_R));
4661         PetscCall(VecResetArray(pcbddc->vec2_R));
4662       }
4663       PetscCall(MatDenseRestoreArray(B_V,&marray));
4664     }
4665     if (B_C) {
4666       PetscCall(MatDenseGetArray(B_C,&marray));
4667       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4668         PetscCall(VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R));
4669         PetscCall(VecPlaceArray(pcbddc->vec2_R,work+i*n_R));
4670         PetscCall(KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R));
4671         PetscCall(KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R));
4672         PetscCall(VecResetArray(pcbddc->vec1_R));
4673         PetscCall(VecResetArray(pcbddc->vec2_R));
4674       }
4675       PetscCall(MatDenseRestoreArray(B_C,&marray));
4676     }
4677     /* coarse basis functions */
4678     for (i=0;i<pcbddc->local_primal_size;i++) {
4679       Vec  v;
4680 
4681       PetscCall(VecPlaceArray(pcbddc->vec1_R,work+i*n_R));
4682       PetscCall(MatDenseGetColumnVec(pcbddc->coarse_psi_B,i,&v));
4683       PetscCall(VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4684       PetscCall(VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4685       if (i<n_vertices) {
4686         PetscScalar one = 1.0;
4687         PetscCall(VecSetValues(v,1,&idx_V_B[i],&one,INSERT_VALUES));
4688         PetscCall(VecAssemblyBegin(v));
4689         PetscCall(VecAssemblyEnd(v));
4690       }
4691       PetscCall(MatDenseRestoreColumnVec(pcbddc->coarse_psi_B,i,&v));
4692 
4693       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4694         PetscCall(MatDenseGetColumnVec(pcbddc->coarse_psi_D,i,&v));
4695         PetscCall(VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4696         PetscCall(VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,v,INSERT_VALUES,SCATTER_FORWARD));
4697         PetscCall(MatDenseRestoreColumnVec(pcbddc->coarse_psi_D,i,&v));
4698       }
4699       PetscCall(VecResetArray(pcbddc->vec1_R));
4700     }
4701     PetscCall(MatDestroy(&B_V));
4702     PetscCall(MatDestroy(&B_C));
4703   }
4704 
4705   /* free memory */
4706   PetscCall(PetscFree(idx_V_B));
4707   PetscCall(MatDestroy(&S_VV));
4708   PetscCall(MatDestroy(&S_CV));
4709   PetscCall(MatDestroy(&S_VC));
4710   PetscCall(MatDestroy(&S_CC));
4711   PetscCall(PetscFree(work));
4712   if (n_vertices) {
4713     PetscCall(MatDestroy(&A_VR));
4714   }
4715   if (n_constraints) {
4716     PetscCall(MatDestroy(&C_CR));
4717   }
4718   PetscCall(PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0));
4719 
4720   /* Checking coarse_sub_mat and coarse basis functios */
4721   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4722   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4723   if (pcbddc->dbg_flag) {
4724     Mat         coarse_sub_mat;
4725     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4726     Mat         coarse_phi_D,coarse_phi_B;
4727     Mat         coarse_psi_D,coarse_psi_B;
4728     Mat         A_II,A_BB,A_IB,A_BI;
4729     Mat         C_B,CPHI;
4730     IS          is_dummy;
4731     Vec         mones;
4732     MatType     checkmattype=MATSEQAIJ;
4733     PetscReal   real_value;
4734 
4735     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4736       Mat A;
4737       PetscCall(PCBDDCBenignProject(pc,NULL,NULL,&A));
4738       PetscCall(MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II));
4739       PetscCall(MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB));
4740       PetscCall(MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI));
4741       PetscCall(MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB));
4742       PetscCall(MatDestroy(&A));
4743     } else {
4744       PetscCall(MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II));
4745       PetscCall(MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB));
4746       PetscCall(MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI));
4747       PetscCall(MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB));
4748     }
4749     PetscCall(MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D));
4750     PetscCall(MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B));
4751     if (!pcbddc->symmetric_primal) {
4752       PetscCall(MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D));
4753       PetscCall(MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B));
4754     }
4755     PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat));
4756 
4757     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n"));
4758     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal));
4759     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
4760     if (!pcbddc->symmetric_primal) {
4761       PetscCall(MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT));
4762       PetscCall(MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1));
4763       PetscCall(MatDestroy(&AUXMAT));
4764       PetscCall(MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT));
4765       PetscCall(MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2));
4766       PetscCall(MatDestroy(&AUXMAT));
4767       PetscCall(MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT));
4768       PetscCall(MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3));
4769       PetscCall(MatDestroy(&AUXMAT));
4770       PetscCall(MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT));
4771       PetscCall(MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4));
4772       PetscCall(MatDestroy(&AUXMAT));
4773     } else {
4774       PetscCall(MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1));
4775       PetscCall(MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2));
4776       PetscCall(MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT));
4777       PetscCall(MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3));
4778       PetscCall(MatDestroy(&AUXMAT));
4779       PetscCall(MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT));
4780       PetscCall(MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4));
4781       PetscCall(MatDestroy(&AUXMAT));
4782     }
4783     PetscCall(MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN));
4784     PetscCall(MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN));
4785     PetscCall(MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN));
4786     PetscCall(MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1));
4787     if (pcbddc->benign_n) {
4788       Mat               B0_B,B0_BPHI;
4789       const PetscScalar *data2;
4790       PetscScalar       *data;
4791       PetscInt          j;
4792 
4793       PetscCall(ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy));
4794       PetscCall(MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B));
4795       PetscCall(MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI));
4796       PetscCall(MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI));
4797       PetscCall(MatDenseGetArray(TM1,&data));
4798       PetscCall(MatDenseGetArrayRead(B0_BPHI,&data2));
4799       for (j=0;j<pcbddc->benign_n;j++) {
4800         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4801         for (i=0;i<pcbddc->local_primal_size;i++) {
4802           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4803           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4804         }
4805       }
4806       PetscCall(MatDenseRestoreArray(TM1,&data));
4807       PetscCall(MatDenseRestoreArrayRead(B0_BPHI,&data2));
4808       PetscCall(MatDestroy(&B0_B));
4809       PetscCall(ISDestroy(&is_dummy));
4810       PetscCall(MatDestroy(&B0_BPHI));
4811     }
4812 #if 0
4813   {
4814     PetscViewer viewer;
4815     char filename[256];
4816     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4817     PetscCall(PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer));
4818     PetscCall(PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB));
4819     PetscCall(PetscObjectSetName((PetscObject)coarse_sub_mat,"computed"));
4820     PetscCall(MatView(coarse_sub_mat,viewer));
4821     PetscCall(PetscObjectSetName((PetscObject)TM1,"projected"));
4822     PetscCall(MatView(TM1,viewer));
4823     if (pcbddc->coarse_phi_B) {
4824       PetscCall(PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B"));
4825       PetscCall(MatView(pcbddc->coarse_phi_B,viewer));
4826     }
4827     if (pcbddc->coarse_phi_D) {
4828       PetscCall(PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D"));
4829       PetscCall(MatView(pcbddc->coarse_phi_D,viewer));
4830     }
4831     if (pcbddc->coarse_psi_B) {
4832       PetscCall(PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B"));
4833       PetscCall(MatView(pcbddc->coarse_psi_B,viewer));
4834     }
4835     if (pcbddc->coarse_psi_D) {
4836       PetscCall(PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D"));
4837       PetscCall(MatView(pcbddc->coarse_psi_D,viewer));
4838     }
4839     PetscCall(PetscObjectSetName((PetscObject)pcbddc->local_mat,"A"));
4840     PetscCall(MatView(pcbddc->local_mat,viewer));
4841     PetscCall(PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C"));
4842     PetscCall(MatView(pcbddc->ConstraintMatrix,viewer));
4843     PetscCall(PetscObjectSetName((PetscObject)pcis->is_I_local,"I"));
4844     PetscCall(ISView(pcis->is_I_local,viewer));
4845     PetscCall(PetscObjectSetName((PetscObject)pcis->is_B_local,"B"));
4846     PetscCall(ISView(pcis->is_B_local,viewer));
4847     PetscCall(PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R"));
4848     PetscCall(ISView(pcbddc->is_R_local,viewer));
4849     PetscCall(PetscViewerDestroy(&viewer));
4850   }
4851 #endif
4852     PetscCall(MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN));
4853     PetscCall(MatNorm(TM1,NORM_FROBENIUS,&real_value));
4854     PetscCall(PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer));
4855     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,(double)real_value));
4856 
4857     /* check constraints */
4858     PetscCall(ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy));
4859     PetscCall(MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B));
4860     if (!pcbddc->benign_n) { /* TODO: add benign case */
4861       PetscCall(MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI));
4862     } else {
4863       PetscScalar *data;
4864       Mat         tmat;
4865       PetscCall(MatDenseGetArray(pcbddc->coarse_phi_B,&data));
4866       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat));
4867       PetscCall(MatDenseRestoreArray(pcbddc->coarse_phi_B,&data));
4868       PetscCall(MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI));
4869       PetscCall(MatDestroy(&tmat));
4870     }
4871     PetscCall(MatCreateVecs(CPHI,&mones,NULL));
4872     PetscCall(VecSet(mones,-1.0));
4873     PetscCall(MatDiagonalSet(CPHI,mones,ADD_VALUES));
4874     PetscCall(MatNorm(CPHI,NORM_FROBENIUS,&real_value));
4875     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,(double)real_value));
4876     if (!pcbddc->symmetric_primal) {
4877       PetscCall(MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI));
4878       PetscCall(VecSet(mones,-1.0));
4879       PetscCall(MatDiagonalSet(CPHI,mones,ADD_VALUES));
4880       PetscCall(MatNorm(CPHI,NORM_FROBENIUS,&real_value));
4881       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,(double)real_value));
4882     }
4883     PetscCall(MatDestroy(&C_B));
4884     PetscCall(MatDestroy(&CPHI));
4885     PetscCall(ISDestroy(&is_dummy));
4886     PetscCall(VecDestroy(&mones));
4887     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
4888     PetscCall(MatDestroy(&A_II));
4889     PetscCall(MatDestroy(&A_BB));
4890     PetscCall(MatDestroy(&A_IB));
4891     PetscCall(MatDestroy(&A_BI));
4892     PetscCall(MatDestroy(&TM1));
4893     PetscCall(MatDestroy(&TM2));
4894     PetscCall(MatDestroy(&TM3));
4895     PetscCall(MatDestroy(&TM4));
4896     PetscCall(MatDestroy(&coarse_phi_D));
4897     PetscCall(MatDestroy(&coarse_phi_B));
4898     if (!pcbddc->symmetric_primal) {
4899       PetscCall(MatDestroy(&coarse_psi_D));
4900       PetscCall(MatDestroy(&coarse_psi_B));
4901     }
4902     PetscCall(MatDestroy(&coarse_sub_mat));
4903   }
4904   /* FINAL CUDA support (we cannot currently mix viennacl and cuda vectors */
4905   {
4906     PetscBool gpu;
4907 
4908     PetscCall(PetscObjectTypeCompare((PetscObject)pcis->vec1_N,VECSEQCUDA,&gpu));
4909     if (gpu) {
4910       if (pcbddc->local_auxmat1) {
4911         PetscCall(MatConvert(pcbddc->local_auxmat1,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat1));
4912       }
4913       if (pcbddc->local_auxmat2) {
4914         PetscCall(MatConvert(pcbddc->local_auxmat2,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat2));
4915       }
4916       if (pcbddc->coarse_phi_B) {
4917         PetscCall(MatConvert(pcbddc->coarse_phi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_B));
4918       }
4919       if (pcbddc->coarse_phi_D) {
4920         PetscCall(MatConvert(pcbddc->coarse_phi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_D));
4921       }
4922       if (pcbddc->coarse_psi_B) {
4923         PetscCall(MatConvert(pcbddc->coarse_psi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_B));
4924       }
4925       if (pcbddc->coarse_psi_D) {
4926         PetscCall(MatConvert(pcbddc->coarse_psi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_D));
4927       }
4928     }
4929   }
4930   /* get back data */
4931   *coarse_submat_vals_n = coarse_submat_vals;
4932   PetscFunctionReturn(0);
4933 }
4934 
4935 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4936 {
4937   Mat            *work_mat;
4938   IS             isrow_s,iscol_s;
4939   PetscBool      rsorted,csorted;
4940   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4941 
4942   PetscFunctionBegin;
4943   PetscCall(ISSorted(isrow,&rsorted));
4944   PetscCall(ISSorted(iscol,&csorted));
4945   PetscCall(ISGetLocalSize(isrow,&rsize));
4946   PetscCall(ISGetLocalSize(iscol,&csize));
4947 
4948   if (!rsorted) {
4949     const PetscInt *idxs;
4950     PetscInt *idxs_sorted,i;
4951 
4952     PetscCall(PetscMalloc1(rsize,&idxs_perm_r));
4953     PetscCall(PetscMalloc1(rsize,&idxs_sorted));
4954     for (i=0;i<rsize;i++) {
4955       idxs_perm_r[i] = i;
4956     }
4957     PetscCall(ISGetIndices(isrow,&idxs));
4958     PetscCall(PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r));
4959     for (i=0;i<rsize;i++) {
4960       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4961     }
4962     PetscCall(ISRestoreIndices(isrow,&idxs));
4963     PetscCall(ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s));
4964   } else {
4965     PetscCall(PetscObjectReference((PetscObject)isrow));
4966     isrow_s = isrow;
4967   }
4968 
4969   if (!csorted) {
4970     if (isrow == iscol) {
4971       PetscCall(PetscObjectReference((PetscObject)isrow_s));
4972       iscol_s = isrow_s;
4973     } else {
4974       const PetscInt *idxs;
4975       PetscInt       *idxs_sorted,i;
4976 
4977       PetscCall(PetscMalloc1(csize,&idxs_perm_c));
4978       PetscCall(PetscMalloc1(csize,&idxs_sorted));
4979       for (i=0;i<csize;i++) {
4980         idxs_perm_c[i] = i;
4981       }
4982       PetscCall(ISGetIndices(iscol,&idxs));
4983       PetscCall(PetscSortIntWithPermutation(csize,idxs,idxs_perm_c));
4984       for (i=0;i<csize;i++) {
4985         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4986       }
4987       PetscCall(ISRestoreIndices(iscol,&idxs));
4988       PetscCall(ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s));
4989     }
4990   } else {
4991     PetscCall(PetscObjectReference((PetscObject)iscol));
4992     iscol_s = iscol;
4993   }
4994 
4995   PetscCall(MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat));
4996 
4997   if (!rsorted || !csorted) {
4998     Mat      new_mat;
4999     IS       is_perm_r,is_perm_c;
5000 
5001     if (!rsorted) {
5002       PetscInt *idxs_r,i;
5003       PetscCall(PetscMalloc1(rsize,&idxs_r));
5004       for (i=0;i<rsize;i++) {
5005         idxs_r[idxs_perm_r[i]] = i;
5006       }
5007       PetscCall(PetscFree(idxs_perm_r));
5008       PetscCall(ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r));
5009     } else {
5010       PetscCall(ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r));
5011     }
5012     PetscCall(ISSetPermutation(is_perm_r));
5013 
5014     if (!csorted) {
5015       if (isrow_s == iscol_s) {
5016         PetscCall(PetscObjectReference((PetscObject)is_perm_r));
5017         is_perm_c = is_perm_r;
5018       } else {
5019         PetscInt *idxs_c,i;
5020         PetscCheck(idxs_perm_c,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
5021         PetscCall(PetscMalloc1(csize,&idxs_c));
5022         for (i=0;i<csize;i++) {
5023           idxs_c[idxs_perm_c[i]] = i;
5024         }
5025         PetscCall(PetscFree(idxs_perm_c));
5026         PetscCall(ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c));
5027       }
5028     } else {
5029       PetscCall(ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c));
5030     }
5031     PetscCall(ISSetPermutation(is_perm_c));
5032 
5033     PetscCall(MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat));
5034     PetscCall(MatDestroy(&work_mat[0]));
5035     work_mat[0] = new_mat;
5036     PetscCall(ISDestroy(&is_perm_r));
5037     PetscCall(ISDestroy(&is_perm_c));
5038   }
5039 
5040   PetscCall(PetscObjectReference((PetscObject)work_mat[0]));
5041   *B = work_mat[0];
5042   PetscCall(MatDestroyMatrices(1,&work_mat));
5043   PetscCall(ISDestroy(&isrow_s));
5044   PetscCall(ISDestroy(&iscol_s));
5045   PetscFunctionReturn(0);
5046 }
5047 
5048 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5049 {
5050   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5051   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5052   Mat            new_mat,lA;
5053   IS             is_local,is_global;
5054   PetscInt       local_size;
5055   PetscBool      isseqaij,issym,isset;
5056 
5057   PetscFunctionBegin;
5058   PetscCall(MatDestroy(&pcbddc->local_mat));
5059   PetscCall(MatGetSize(matis->A,&local_size,NULL));
5060   PetscCall(ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local));
5061   PetscCall(ISLocalToGlobalMappingApplyIS(matis->rmapping,is_local,&is_global));
5062   PetscCall(ISDestroy(&is_local));
5063   PetscCall(MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat));
5064   PetscCall(ISDestroy(&is_global));
5065 
5066   if (pcbddc->dbg_flag) {
5067     Vec       x,x_change;
5068     PetscReal error;
5069 
5070     PetscCall(MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change));
5071     PetscCall(VecSetRandom(x,NULL));
5072     PetscCall(MatMult(ChangeOfBasisMatrix,x,x_change));
5073     PetscCall(VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD));
5074     PetscCall(VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD));
5075     PetscCall(MatMult(new_mat,matis->x,matis->y));
5076     if (!pcbddc->change_interior) {
5077       const PetscScalar *x,*y,*v;
5078       PetscReal         lerror = 0.;
5079       PetscInt          i;
5080 
5081       PetscCall(VecGetArrayRead(matis->x,&x));
5082       PetscCall(VecGetArrayRead(matis->y,&y));
5083       PetscCall(VecGetArrayRead(matis->counter,&v));
5084       for (i=0;i<local_size;i++)
5085         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5086           lerror = PetscAbsScalar(x[i]-y[i]);
5087       PetscCall(VecRestoreArrayRead(matis->x,&x));
5088       PetscCall(VecRestoreArrayRead(matis->y,&y));
5089       PetscCall(VecRestoreArrayRead(matis->counter,&v));
5090       PetscCall(MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPIU_MAX,PetscObjectComm((PetscObject)pc)));
5091       if (error > PETSC_SMALL) {
5092         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5093           SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",(double)error);
5094         } else {
5095           SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",(double)error);
5096         }
5097       }
5098     }
5099     PetscCall(VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE));
5100     PetscCall(VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE));
5101     PetscCall(VecAXPY(x,-1.0,x_change));
5102     PetscCall(VecNorm(x,NORM_INFINITY,&error));
5103     if (error > PETSC_SMALL) {
5104       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5105         SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",(double)error);
5106       } else {
5107         SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",(double)error);
5108       }
5109     }
5110     PetscCall(VecDestroy(&x));
5111     PetscCall(VecDestroy(&x_change));
5112   }
5113 
5114   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5115   PetscCall(PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA));
5116 
5117   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5118   PetscCall(PetscObjectBaseTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij));
5119   if (isseqaij) {
5120     PetscCall(MatDestroy(&pcbddc->local_mat));
5121     PetscCall(MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat));
5122     if (lA) {
5123       Mat work;
5124       PetscCall(MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work));
5125       PetscCall(PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work));
5126       PetscCall(MatDestroy(&work));
5127     }
5128   } else {
5129     Mat work_mat;
5130 
5131     PetscCall(MatDestroy(&pcbddc->local_mat));
5132     PetscCall(MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat));
5133     PetscCall(MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat));
5134     PetscCall(MatDestroy(&work_mat));
5135     if (lA) {
5136       Mat work;
5137       PetscCall(MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat));
5138       PetscCall(MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work));
5139       PetscCall(PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work));
5140       PetscCall(MatDestroy(&work));
5141     }
5142   }
5143   PetscCall(MatIsSymmetricKnown(matis->A,&isset,&issym));
5144   if (isset) PetscCall(MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,issym));
5145   PetscCall(MatDestroy(&new_mat));
5146   PetscFunctionReturn(0);
5147 }
5148 
5149 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5150 {
5151   PC_IS*          pcis = (PC_IS*)(pc->data);
5152   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5153   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5154   PetscInt        *idx_R_local=NULL;
5155   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5156   PetscInt        vbs,bs;
5157   PetscBT         bitmask=NULL;
5158 
5159   PetscFunctionBegin;
5160   /*
5161     No need to setup local scatters if
5162       - primal space is unchanged
5163         AND
5164       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5165         AND
5166       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5167   */
5168   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5169     PetscFunctionReturn(0);
5170   }
5171   /* destroy old objects */
5172   PetscCall(ISDestroy(&pcbddc->is_R_local));
5173   PetscCall(VecScatterDestroy(&pcbddc->R_to_B));
5174   PetscCall(VecScatterDestroy(&pcbddc->R_to_D));
5175   /* Set Non-overlapping dimensions */
5176   n_B = pcis->n_B;
5177   n_D = pcis->n - n_B;
5178   n_vertices = pcbddc->n_vertices;
5179 
5180   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5181 
5182   /* create auxiliary bitmask and allocate workspace */
5183   if (!sub_schurs || !sub_schurs->reuse_solver) {
5184     PetscCall(PetscMalloc1(pcis->n-n_vertices,&idx_R_local));
5185     PetscCall(PetscBTCreate(pcis->n,&bitmask));
5186     for (i=0;i<n_vertices;i++) {
5187       PetscCall(PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]));
5188     }
5189 
5190     for (i=0, n_R=0; i<pcis->n; i++) {
5191       if (!PetscBTLookup(bitmask,i)) {
5192         idx_R_local[n_R++] = i;
5193       }
5194     }
5195   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5196     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5197 
5198     PetscCall(ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local));
5199     PetscCall(ISGetLocalSize(reuse_solver->is_R,&n_R));
5200   }
5201 
5202   /* Block code */
5203   vbs = 1;
5204   PetscCall(MatGetBlockSize(pcbddc->local_mat,&bs));
5205   if (bs>1 && !(n_vertices%bs)) {
5206     PetscBool is_blocked = PETSC_TRUE;
5207     PetscInt  *vary;
5208     if (!sub_schurs || !sub_schurs->reuse_solver) {
5209       PetscCall(PetscMalloc1(pcis->n/bs,&vary));
5210       PetscCall(PetscArrayzero(vary,pcis->n/bs));
5211       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5212       /* it is ok to check this way since local_primal_ref_node are always sorted by local numbering and idx_R_local is obtained as a complement */
5213       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5214       for (i=0; i<pcis->n/bs; i++) {
5215         if (vary[i]!=0 && vary[i]!=bs) {
5216           is_blocked = PETSC_FALSE;
5217           break;
5218         }
5219       }
5220       PetscCall(PetscFree(vary));
5221     } else {
5222       /* Verify directly the R set */
5223       for (i=0; i<n_R/bs; i++) {
5224         PetscInt j,node=idx_R_local[bs*i];
5225         for (j=1; j<bs; j++) {
5226           if (node != idx_R_local[bs*i+j]-j) {
5227             is_blocked = PETSC_FALSE;
5228             break;
5229           }
5230         }
5231       }
5232     }
5233     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5234       vbs = bs;
5235       for (i=0;i<n_R/vbs;i++) {
5236         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5237       }
5238     }
5239   }
5240   PetscCall(ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local));
5241   if (sub_schurs && sub_schurs->reuse_solver) {
5242     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5243 
5244     PetscCall(ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local));
5245     PetscCall(ISDestroy(&reuse_solver->is_R));
5246     PetscCall(PetscObjectReference((PetscObject)pcbddc->is_R_local));
5247     reuse_solver->is_R = pcbddc->is_R_local;
5248   } else {
5249     PetscCall(PetscFree(idx_R_local));
5250   }
5251 
5252   /* print some info if requested */
5253   if (pcbddc->dbg_flag) {
5254     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n"));
5255     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
5256     PetscCall(PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer));
5257     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank));
5258     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %" PetscInt_FMT ", dirichlet_size = %" PetscInt_FMT ", boundary_size = %" PetscInt_FMT "\n",pcis->n,n_D,n_B));
5259     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %" PetscInt_FMT ", v_size = %" PetscInt_FMT ", constraints = %" PetscInt_FMT ", local_primal_size = %" PetscInt_FMT "\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices-pcbddc->benign_n,pcbddc->local_primal_size));
5260     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
5261   }
5262 
5263   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5264   if (!sub_schurs || !sub_schurs->reuse_solver) {
5265     IS       is_aux1,is_aux2;
5266     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5267 
5268     PetscCall(ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local));
5269     PetscCall(PetscMalloc1(pcis->n_B-n_vertices,&aux_array1));
5270     PetscCall(PetscMalloc1(pcis->n_B-n_vertices,&aux_array2));
5271     PetscCall(ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices));
5272     for (i=0; i<n_D; i++) {
5273       PetscCall(PetscBTSet(bitmask,is_indices[i]));
5274     }
5275     PetscCall(ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices));
5276     for (i=0, j=0; i<n_R; i++) {
5277       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5278         aux_array1[j++] = i;
5279       }
5280     }
5281     PetscCall(ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1));
5282     PetscCall(ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices));
5283     for (i=0, j=0; i<n_B; i++) {
5284       if (!PetscBTLookup(bitmask,is_indices[i])) {
5285         aux_array2[j++] = i;
5286       }
5287     }
5288     PetscCall(ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices));
5289     PetscCall(ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2));
5290     PetscCall(VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B));
5291     PetscCall(ISDestroy(&is_aux1));
5292     PetscCall(ISDestroy(&is_aux2));
5293 
5294     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5295       PetscCall(PetscMalloc1(n_D,&aux_array1));
5296       for (i=0, j=0; i<n_R; i++) {
5297         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5298           aux_array1[j++] = i;
5299         }
5300       }
5301       PetscCall(ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1));
5302       PetscCall(VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D));
5303       PetscCall(ISDestroy(&is_aux1));
5304     }
5305     PetscCall(PetscBTDestroy(&bitmask));
5306     PetscCall(ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local));
5307   } else {
5308     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5309     IS                 tis;
5310     PetscInt           schur_size;
5311 
5312     PetscCall(ISGetLocalSize(reuse_solver->is_B,&schur_size));
5313     PetscCall(ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis));
5314     PetscCall(VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B));
5315     PetscCall(ISDestroy(&tis));
5316     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5317       PetscCall(ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis));
5318       PetscCall(VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D));
5319       PetscCall(ISDestroy(&tis));
5320     }
5321   }
5322   PetscFunctionReturn(0);
5323 }
5324 
5325 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5326 {
5327   MatNullSpace   NullSpace;
5328   Mat            dmat;
5329   const Vec      *nullvecs;
5330   Vec            v,v2,*nullvecs2;
5331   VecScatter     sct = NULL;
5332   PetscContainer c;
5333   PetscScalar    *ddata;
5334   PetscInt       k,nnsp_size,bsiz,bsiz2,n,N,bs;
5335   PetscBool      nnsp_has_cnst;
5336 
5337   PetscFunctionBegin;
5338   if (!is && !B) { /* MATIS */
5339     Mat_IS* matis = (Mat_IS*)A->data;
5340 
5341     if (!B) {
5342       PetscCall(MatISGetLocalMat(A,&B));
5343     }
5344     sct  = matis->cctx;
5345     PetscCall(PetscObjectReference((PetscObject)sct));
5346   } else {
5347     PetscCall(MatGetNullSpace(B,&NullSpace));
5348     if (!NullSpace) {
5349       PetscCall(MatGetNearNullSpace(B,&NullSpace));
5350     }
5351     if (NullSpace) PetscFunctionReturn(0);
5352   }
5353   PetscCall(MatGetNullSpace(A,&NullSpace));
5354   if (!NullSpace) {
5355     PetscCall(MatGetNearNullSpace(A,&NullSpace));
5356   }
5357   if (!NullSpace) PetscFunctionReturn(0);
5358 
5359   PetscCall(MatCreateVecs(A,&v,NULL));
5360   PetscCall(MatCreateVecs(B,&v2,NULL));
5361   if (!sct) {
5362     PetscCall(VecScatterCreate(v,is,v2,NULL,&sct));
5363   }
5364   PetscCall(MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs));
5365   bsiz = bsiz2 = nnsp_size+!!nnsp_has_cnst;
5366   PetscCall(PetscMalloc1(bsiz,&nullvecs2));
5367   PetscCall(VecGetBlockSize(v2,&bs));
5368   PetscCall(VecGetSize(v2,&N));
5369   PetscCall(VecGetLocalSize(v2,&n));
5370   PetscCall(PetscMalloc1(n*bsiz,&ddata));
5371   for (k=0;k<nnsp_size;k++) {
5372     PetscCall(VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*k,&nullvecs2[k]));
5373     PetscCall(VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD));
5374     PetscCall(VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD));
5375   }
5376   if (nnsp_has_cnst) {
5377     PetscCall(VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*nnsp_size,&nullvecs2[nnsp_size]));
5378     PetscCall(VecSet(nullvecs2[nnsp_size],1.0));
5379   }
5380   PetscCall(PCBDDCOrthonormalizeVecs(&bsiz2,nullvecs2));
5381   PetscCall(MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz2,nullvecs2,&NullSpace));
5382 
5383   PetscCall(MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz2,ddata,&dmat));
5384   PetscCall(PetscContainerCreate(PetscObjectComm((PetscObject)B),&c));
5385   PetscCall(PetscContainerSetPointer(c,ddata));
5386   PetscCall(PetscContainerSetUserDestroy(c,PetscContainerUserDestroyDefault));
5387   PetscCall(PetscObjectCompose((PetscObject)dmat,"_PBDDC_Null_dmat_arr",(PetscObject)c));
5388   PetscCall(PetscContainerDestroy(&c));
5389   PetscCall(PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat));
5390   PetscCall(MatDestroy(&dmat));
5391 
5392   for (k=0;k<bsiz;k++) {
5393     PetscCall(VecDestroy(&nullvecs2[k]));
5394   }
5395   PetscCall(PetscFree(nullvecs2));
5396   PetscCall(MatSetNearNullSpace(B,NullSpace));
5397   PetscCall(MatNullSpaceDestroy(&NullSpace));
5398   PetscCall(VecDestroy(&v));
5399   PetscCall(VecDestroy(&v2));
5400   PetscCall(VecScatterDestroy(&sct));
5401   PetscFunctionReturn(0);
5402 }
5403 
5404 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5405 {
5406   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5407   PC_IS          *pcis = (PC_IS*)pc->data;
5408   PC             pc_temp;
5409   Mat            A_RR;
5410   MatNullSpace   nnsp;
5411   MatReuse       reuse;
5412   PetscScalar    m_one = -1.0;
5413   PetscReal      value;
5414   PetscInt       n_D,n_R;
5415   PetscBool      issbaij,opts,isset,issym;
5416   void           (*f)(void) = NULL;
5417   char           dir_prefix[256],neu_prefix[256],str_level[16];
5418   size_t         len;
5419 
5420   PetscFunctionBegin;
5421   PetscCall(PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0));
5422   /* approximate solver, propagate NearNullSpace if needed */
5423   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5424     MatNullSpace gnnsp1,gnnsp2;
5425     PetscBool    lhas,ghas;
5426 
5427     PetscCall(MatGetNearNullSpace(pcbddc->local_mat,&nnsp));
5428     PetscCall(MatGetNearNullSpace(pc->pmat,&gnnsp1));
5429     PetscCall(MatGetNullSpace(pc->pmat,&gnnsp2));
5430     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5431     PetscCall(MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc)));
5432     if (!ghas && (gnnsp1 || gnnsp2)) {
5433       PetscCall(MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL));
5434     }
5435   }
5436 
5437   /* compute prefixes */
5438   PetscCall(PetscStrcpy(dir_prefix,""));
5439   PetscCall(PetscStrcpy(neu_prefix,""));
5440   if (!pcbddc->current_level) {
5441     PetscCall(PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix)));
5442     PetscCall(PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix)));
5443     PetscCall(PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix)));
5444     PetscCall(PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix)));
5445   } else {
5446     PetscCall(PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level)));
5447     PetscCall(PetscStrlen(((PetscObject)pc)->prefix,&len));
5448     len -= 15; /* remove "pc_bddc_coarse_" */
5449     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5450     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5451     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5452     PetscCall(PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1));
5453     PetscCall(PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1));
5454     PetscCall(PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix)));
5455     PetscCall(PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix)));
5456     PetscCall(PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix)));
5457     PetscCall(PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix)));
5458   }
5459 
5460   /* DIRICHLET PROBLEM */
5461   if (dirichlet) {
5462     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5463     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5464       PetscCheck(sub_schurs && sub_schurs->reuse_solver,PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5465       if (pcbddc->dbg_flag) {
5466         Mat    A_IIn;
5467 
5468         PetscCall(PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn));
5469         PetscCall(MatDestroy(&pcis->A_II));
5470         pcis->A_II = A_IIn;
5471       }
5472     }
5473     PetscCall(MatIsSymmetricKnown(pcbddc->local_mat,&isset,&issym));
5474     if (isset) PetscCall(MatSetOption(pcis->A_II,MAT_SYMMETRIC,issym));
5475 
5476     /* Matrix for Dirichlet problem is pcis->A_II */
5477     n_D  = pcis->n - pcis->n_B;
5478     opts = PETSC_FALSE;
5479     if (!pcbddc->ksp_D) { /* create object if not yet build */
5480       opts = PETSC_TRUE;
5481       PetscCall(KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D));
5482       PetscCall(PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1));
5483       /* default */
5484       PetscCall(KSPSetType(pcbddc->ksp_D,KSPPREONLY));
5485       PetscCall(KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix));
5486       PetscCall(PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij));
5487       PetscCall(KSPGetPC(pcbddc->ksp_D,&pc_temp));
5488       if (issbaij) {
5489         PetscCall(PCSetType(pc_temp,PCCHOLESKY));
5490       } else {
5491         PetscCall(PCSetType(pc_temp,PCLU));
5492       }
5493       PetscCall(KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure));
5494     }
5495     PetscCall(MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix));
5496     PetscCall(KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II));
5497     /* Allow user's customization */
5498     if (opts) PetscCall(KSPSetFromOptions(pcbddc->ksp_D));
5499     PetscCall(MatGetNearNullSpace(pcis->pA_II,&nnsp));
5500     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5501       PetscCall(MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II));
5502     }
5503     PetscCall(MatGetNearNullSpace(pcis->pA_II,&nnsp));
5504     PetscCall(KSPGetPC(pcbddc->ksp_D,&pc_temp));
5505     PetscCall(PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f));
5506     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5507       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5508       const PetscInt *idxs;
5509       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5510 
5511       PetscCall(ISGetLocalSize(pcis->is_I_local,&nl));
5512       PetscCall(ISGetIndices(pcis->is_I_local,&idxs));
5513       PetscCall(PetscMalloc1(nl*cdim,&scoords));
5514       for (i=0;i<nl;i++) {
5515         for (d=0;d<cdim;d++) {
5516           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5517         }
5518       }
5519       PetscCall(ISRestoreIndices(pcis->is_I_local,&idxs));
5520       PetscCall(PCSetCoordinates(pc_temp,cdim,nl,scoords));
5521       PetscCall(PetscFree(scoords));
5522     }
5523     if (sub_schurs && sub_schurs->reuse_solver) {
5524       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5525 
5526       PetscCall(KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver));
5527     }
5528 
5529     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5530     if (!n_D) {
5531       PetscCall(KSPGetPC(pcbddc->ksp_D,&pc_temp));
5532       PetscCall(PCSetType(pc_temp,PCNONE));
5533     }
5534     PetscCall(KSPSetUp(pcbddc->ksp_D));
5535     /* set ksp_D into pcis data */
5536     PetscCall(PetscObjectReference((PetscObject)pcbddc->ksp_D));
5537     PetscCall(KSPDestroy(&pcis->ksp_D));
5538     pcis->ksp_D = pcbddc->ksp_D;
5539   }
5540 
5541   /* NEUMANN PROBLEM */
5542   A_RR = NULL;
5543   if (neumann) {
5544     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5545     PetscInt        ibs,mbs;
5546     PetscBool       issbaij, reuse_neumann_solver,isset,issym;
5547     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5548 
5549     reuse_neumann_solver = PETSC_FALSE;
5550     if (sub_schurs && sub_schurs->reuse_solver) {
5551       IS iP;
5552 
5553       reuse_neumann_solver = PETSC_TRUE;
5554       PetscCall(PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP));
5555       if (iP) reuse_neumann_solver = PETSC_FALSE;
5556     }
5557     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5558     PetscCall(ISGetSize(pcbddc->is_R_local,&n_R));
5559     if (pcbddc->ksp_R) { /* already created ksp */
5560       PetscInt nn_R;
5561       PetscCall(KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR));
5562       PetscCall(PetscObjectReference((PetscObject)A_RR));
5563       PetscCall(MatGetSize(A_RR,&nn_R,NULL));
5564       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5565         PetscCall(KSPReset(pcbddc->ksp_R));
5566         PetscCall(MatDestroy(&A_RR));
5567         reuse = MAT_INITIAL_MATRIX;
5568       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5569         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5570           PetscCall(MatDestroy(&A_RR));
5571           reuse = MAT_INITIAL_MATRIX;
5572         } else { /* safe to reuse the matrix */
5573           reuse = MAT_REUSE_MATRIX;
5574         }
5575       }
5576       /* last check */
5577       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5578         PetscCall(MatDestroy(&A_RR));
5579         reuse = MAT_INITIAL_MATRIX;
5580       }
5581     } else { /* first time, so we need to create the matrix */
5582       reuse = MAT_INITIAL_MATRIX;
5583     }
5584     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection
5585        TODO: Get Rid of these conversions */
5586     PetscCall(MatGetBlockSize(pcbddc->local_mat,&mbs));
5587     PetscCall(ISGetBlockSize(pcbddc->is_R_local,&ibs));
5588     PetscCall(PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij));
5589     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5590       if (matis->A == pcbddc->local_mat) {
5591         PetscCall(MatDestroy(&pcbddc->local_mat));
5592         PetscCall(MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat));
5593       } else {
5594         PetscCall(MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat));
5595       }
5596     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5597       if (matis->A == pcbddc->local_mat) {
5598         PetscCall(MatDestroy(&pcbddc->local_mat));
5599         PetscCall(MatConvert(matis->A,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat));
5600       } else {
5601         PetscCall(MatConvert(pcbddc->local_mat,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat));
5602       }
5603     }
5604     /* extract A_RR */
5605     if (reuse_neumann_solver) {
5606       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5607 
5608       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5609         PetscCall(MatDestroy(&A_RR));
5610         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5611           PetscCall(PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR));
5612         } else {
5613           PetscCall(MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR));
5614         }
5615       } else {
5616         PetscCall(MatDestroy(&A_RR));
5617         PetscCall(PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL));
5618         PetscCall(PetscObjectReference((PetscObject)A_RR));
5619       }
5620     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5621       PetscCall(MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR));
5622     }
5623     PetscCall(MatIsSymmetricKnown(pcbddc->local_mat,&isset,&issym));
5624     if (isset) PetscCall(MatSetOption(A_RR,MAT_SYMMETRIC,issym));
5625     opts = PETSC_FALSE;
5626     if (!pcbddc->ksp_R) { /* create object if not present */
5627       opts = PETSC_TRUE;
5628       PetscCall(KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R));
5629       PetscCall(PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1));
5630       /* default */
5631       PetscCall(KSPSetType(pcbddc->ksp_R,KSPPREONLY));
5632       PetscCall(KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix));
5633       PetscCall(KSPGetPC(pcbddc->ksp_R,&pc_temp));
5634       PetscCall(PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij));
5635       if (issbaij) {
5636         PetscCall(PCSetType(pc_temp,PCCHOLESKY));
5637       } else {
5638         PetscCall(PCSetType(pc_temp,PCLU));
5639       }
5640       PetscCall(KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure));
5641     }
5642     PetscCall(KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR));
5643     PetscCall(MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix));
5644     if (opts) { /* Allow user's customization once */
5645       PetscCall(KSPSetFromOptions(pcbddc->ksp_R));
5646     }
5647     PetscCall(MatGetNearNullSpace(A_RR,&nnsp));
5648     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5649       PetscCall(MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR));
5650     }
5651     PetscCall(MatGetNearNullSpace(A_RR,&nnsp));
5652     PetscCall(KSPGetPC(pcbddc->ksp_R,&pc_temp));
5653     PetscCall(PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f));
5654     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5655       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5656       const PetscInt *idxs;
5657       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5658 
5659       PetscCall(ISGetLocalSize(pcbddc->is_R_local,&nl));
5660       PetscCall(ISGetIndices(pcbddc->is_R_local,&idxs));
5661       PetscCall(PetscMalloc1(nl*cdim,&scoords));
5662       for (i=0;i<nl;i++) {
5663         for (d=0;d<cdim;d++) {
5664           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5665         }
5666       }
5667       PetscCall(ISRestoreIndices(pcbddc->is_R_local,&idxs));
5668       PetscCall(PCSetCoordinates(pc_temp,cdim,nl,scoords));
5669       PetscCall(PetscFree(scoords));
5670     }
5671 
5672     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5673     if (!n_R) {
5674       PetscCall(KSPGetPC(pcbddc->ksp_R,&pc_temp));
5675       PetscCall(PCSetType(pc_temp,PCNONE));
5676     }
5677     /* Reuse solver if it is present */
5678     if (reuse_neumann_solver) {
5679       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5680 
5681       PetscCall(KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver));
5682     }
5683     PetscCall(KSPSetUp(pcbddc->ksp_R));
5684   }
5685 
5686   if (pcbddc->dbg_flag) {
5687     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
5688     PetscCall(PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer));
5689     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n"));
5690   }
5691   PetscCall(PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0));
5692 
5693   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5694   if (pcbddc->NullSpace_corr[0]) {
5695     PetscCall(PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE));
5696   }
5697   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5698     PetscCall(PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]));
5699   }
5700   if (neumann && pcbddc->NullSpace_corr[2]) {
5701     PetscCall(PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]));
5702   }
5703   /* check Dirichlet and Neumann solvers */
5704   if (pcbddc->dbg_flag) {
5705     if (dirichlet) { /* Dirichlet */
5706       PetscCall(VecSetRandom(pcis->vec1_D,NULL));
5707       PetscCall(MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D));
5708       PetscCall(KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D));
5709       PetscCall(KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D));
5710       PetscCall(VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D));
5711       PetscCall(VecNorm(pcis->vec1_D,NORM_INFINITY,&value));
5712       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,(double)value));
5713       PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
5714     }
5715     if (neumann) { /* Neumann */
5716       PetscCall(VecSetRandom(pcbddc->vec1_R,NULL));
5717       PetscCall(MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R));
5718       PetscCall(KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R));
5719       PetscCall(KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R));
5720       PetscCall(VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R));
5721       PetscCall(VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value));
5722       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e\n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,(double)value));
5723       PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
5724     }
5725   }
5726   /* free Neumann problem's matrix */
5727   PetscCall(MatDestroy(&A_RR));
5728   PetscFunctionReturn(0);
5729 }
5730 
5731 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5732 {
5733   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5734   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5735   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE) : PETSC_FALSE;
5736 
5737   PetscFunctionBegin;
5738   if (!reuse_solver) {
5739     PetscCall(VecSet(pcbddc->vec1_R,0.));
5740   }
5741   if (!pcbddc->switch_static) {
5742     if (applytranspose && pcbddc->local_auxmat1) {
5743       PetscCall(MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C));
5744       PetscCall(MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B));
5745     }
5746     if (!reuse_solver) {
5747       PetscCall(VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE));
5748       PetscCall(VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE));
5749     } else {
5750       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5751 
5752       PetscCall(VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD));
5753       PetscCall(VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD));
5754     }
5755   } else {
5756     PetscCall(VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE));
5757     PetscCall(VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE));
5758     PetscCall(VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE));
5759     PetscCall(VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE));
5760     if (applytranspose && pcbddc->local_auxmat1) {
5761       PetscCall(MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C));
5762       PetscCall(MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B));
5763       PetscCall(VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE));
5764       PetscCall(VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE));
5765     }
5766   }
5767   PetscCall(PetscLogEventBegin(PC_BDDC_Solves[pcbddc->current_level][1],pc,0,0,0));
5768   if (!reuse_solver || pcbddc->switch_static) {
5769     if (applytranspose) {
5770       PetscCall(KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R));
5771     } else {
5772       PetscCall(KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R));
5773     }
5774     PetscCall(KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R));
5775   } else {
5776     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5777 
5778     if (applytranspose) {
5779       PetscCall(MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B));
5780     } else {
5781       PetscCall(MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B));
5782     }
5783   }
5784   PetscCall(PetscLogEventEnd(PC_BDDC_Solves[pcbddc->current_level][1],pc,0,0,0));
5785   PetscCall(VecSet(inout_B,0.));
5786   if (!pcbddc->switch_static) {
5787     if (!reuse_solver) {
5788       PetscCall(VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD));
5789       PetscCall(VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD));
5790     } else {
5791       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5792 
5793       PetscCall(VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE));
5794       PetscCall(VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE));
5795     }
5796     if (!applytranspose && pcbddc->local_auxmat1) {
5797       PetscCall(MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C));
5798       PetscCall(MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B));
5799     }
5800   } else {
5801     PetscCall(VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD));
5802     PetscCall(VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD));
5803     PetscCall(VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD));
5804     PetscCall(VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD));
5805     if (!applytranspose && pcbddc->local_auxmat1) {
5806       PetscCall(MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C));
5807       PetscCall(MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R));
5808     }
5809     PetscCall(VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD));
5810     PetscCall(VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD));
5811     PetscCall(VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD));
5812     PetscCall(VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD));
5813   }
5814   PetscFunctionReturn(0);
5815 }
5816 
5817 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5818 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5819 {
5820   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5821   PC_IS*            pcis = (PC_IS*)  (pc->data);
5822   const PetscScalar zero = 0.0;
5823 
5824   PetscFunctionBegin;
5825   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5826   if (!pcbddc->benign_apply_coarse_only) {
5827     if (applytranspose) {
5828       PetscCall(MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P));
5829       if (pcbddc->switch_static) PetscCall(MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P));
5830     } else {
5831       PetscCall(MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P));
5832       if (pcbddc->switch_static) PetscCall(MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P));
5833     }
5834   } else {
5835     PetscCall(VecSet(pcbddc->vec1_P,zero));
5836   }
5837 
5838   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5839   if (pcbddc->benign_n) {
5840     PetscScalar *array;
5841     PetscInt    j;
5842 
5843     PetscCall(VecGetArray(pcbddc->vec1_P,&array));
5844     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5845     PetscCall(VecRestoreArray(pcbddc->vec1_P,&array));
5846   }
5847 
5848   /* start communications from local primal nodes to rhs of coarse solver */
5849   PetscCall(VecSet(pcbddc->coarse_vec,zero));
5850   PetscCall(PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD));
5851   PetscCall(PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD));
5852 
5853   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5854   if (pcbddc->coarse_ksp) {
5855     Mat          coarse_mat;
5856     Vec          rhs,sol;
5857     MatNullSpace nullsp;
5858     PetscBool    isbddc = PETSC_FALSE;
5859 
5860     if (pcbddc->benign_have_null) {
5861       PC        coarse_pc;
5862 
5863       PetscCall(KSPGetPC(pcbddc->coarse_ksp,&coarse_pc));
5864       PetscCall(PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc));
5865       /* we need to propagate to coarser levels the need for a possible benign correction */
5866       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5867         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5868         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5869         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5870       }
5871     }
5872     PetscCall(KSPGetRhs(pcbddc->coarse_ksp,&rhs));
5873     PetscCall(KSPGetSolution(pcbddc->coarse_ksp,&sol));
5874     PetscCall(KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL));
5875     if (applytranspose) {
5876       PetscCheck(!pcbddc->benign_apply_coarse_only,PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5877       PetscCall(PetscLogEventBegin(PC_BDDC_Solves[pcbddc->current_level][2],pc,0,0,0));
5878       PetscCall(KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol));
5879       PetscCall(PetscLogEventEnd(PC_BDDC_Solves[pcbddc->current_level][2],pc,0,0,0));
5880       PetscCall(KSPCheckSolve(pcbddc->coarse_ksp,pc,sol));
5881       PetscCall(MatGetTransposeNullSpace(coarse_mat,&nullsp));
5882       if (nullsp) PetscCall(MatNullSpaceRemove(nullsp,sol));
5883     } else {
5884       PetscCall(MatGetNullSpace(coarse_mat,&nullsp));
5885       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5886         PC        coarse_pc;
5887 
5888         if (nullsp) PetscCall(MatNullSpaceRemove(nullsp,rhs));
5889         PetscCall(KSPGetPC(pcbddc->coarse_ksp,&coarse_pc));
5890         PetscCall(PCPreSolve(coarse_pc,pcbddc->coarse_ksp));
5891         PetscCall(PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol));
5892         PetscCall(PCPostSolve(coarse_pc,pcbddc->coarse_ksp));
5893       } else {
5894         PetscCall(PetscLogEventBegin(PC_BDDC_Solves[pcbddc->current_level][2],pc,0,0,0));
5895         PetscCall(KSPSolve(pcbddc->coarse_ksp,rhs,sol));
5896         PetscCall(PetscLogEventEnd(PC_BDDC_Solves[pcbddc->current_level][2],pc,0,0,0));
5897         PetscCall(KSPCheckSolve(pcbddc->coarse_ksp,pc,sol));
5898         if (nullsp) PetscCall(MatNullSpaceRemove(nullsp,sol));
5899       }
5900     }
5901     /* we don't need the benign correction at coarser levels anymore */
5902     if (pcbddc->benign_have_null && isbddc) {
5903       PC        coarse_pc;
5904       PC_BDDC*  coarsepcbddc;
5905 
5906       PetscCall(KSPGetPC(pcbddc->coarse_ksp,&coarse_pc));
5907       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5908       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5909       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5910     }
5911   }
5912 
5913   /* Local solution on R nodes */
5914   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5915     PetscCall(PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose));
5916   }
5917   /* communications from coarse sol to local primal nodes */
5918   PetscCall(PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE));
5919   PetscCall(PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE));
5920 
5921   /* Sum contributions from the two levels */
5922   if (!pcbddc->benign_apply_coarse_only) {
5923     if (applytranspose) {
5924       PetscCall(MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B));
5925       if (pcbddc->switch_static) PetscCall(MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D));
5926     } else {
5927       PetscCall(MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B));
5928       if (pcbddc->switch_static) PetscCall(MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D));
5929     }
5930     /* store p0 */
5931     if (pcbddc->benign_n) {
5932       PetscScalar *array;
5933       PetscInt    j;
5934 
5935       PetscCall(VecGetArray(pcbddc->vec1_P,&array));
5936       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5937       PetscCall(VecRestoreArray(pcbddc->vec1_P,&array));
5938     }
5939   } else { /* expand the coarse solution */
5940     if (applytranspose) {
5941       PetscCall(MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B));
5942     } else {
5943       PetscCall(MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B));
5944     }
5945   }
5946   PetscFunctionReturn(0);
5947 }
5948 
5949 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5950 {
5951   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5952   Vec               from,to;
5953   const PetscScalar *array;
5954 
5955   PetscFunctionBegin;
5956   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5957     from = pcbddc->coarse_vec;
5958     to = pcbddc->vec1_P;
5959     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5960       Vec tvec;
5961 
5962       PetscCall(KSPGetRhs(pcbddc->coarse_ksp,&tvec));
5963       PetscCall(VecResetArray(tvec));
5964       PetscCall(KSPGetSolution(pcbddc->coarse_ksp,&tvec));
5965       PetscCall(VecGetArrayRead(tvec,&array));
5966       PetscCall(VecPlaceArray(from,array));
5967       PetscCall(VecRestoreArrayRead(tvec,&array));
5968     }
5969   } else { /* from local to global -> put data in coarse right hand side */
5970     from = pcbddc->vec1_P;
5971     to = pcbddc->coarse_vec;
5972   }
5973   PetscCall(VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode));
5974   PetscFunctionReturn(0);
5975 }
5976 
5977 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5978 {
5979   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5980   Vec               from,to;
5981   const PetscScalar *array;
5982 
5983   PetscFunctionBegin;
5984   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5985     from = pcbddc->coarse_vec;
5986     to = pcbddc->vec1_P;
5987   } else { /* from local to global -> put data in coarse right hand side */
5988     from = pcbddc->vec1_P;
5989     to = pcbddc->coarse_vec;
5990   }
5991   PetscCall(VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode));
5992   if (smode == SCATTER_FORWARD) {
5993     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5994       Vec tvec;
5995 
5996       PetscCall(KSPGetRhs(pcbddc->coarse_ksp,&tvec));
5997       PetscCall(VecGetArrayRead(to,&array));
5998       PetscCall(VecPlaceArray(tvec,array));
5999       PetscCall(VecRestoreArrayRead(to,&array));
6000     }
6001   } else {
6002     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
6003      PetscCall(VecResetArray(from));
6004     }
6005   }
6006   PetscFunctionReturn(0);
6007 }
6008 
6009 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
6010 {
6011   PC_IS*            pcis = (PC_IS*)(pc->data);
6012   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
6013   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6014   /* one and zero */
6015   PetscScalar       one=1.0,zero=0.0;
6016   /* space to store constraints and their local indices */
6017   PetscScalar       *constraints_data;
6018   PetscInt          *constraints_idxs,*constraints_idxs_B;
6019   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
6020   PetscInt          *constraints_n;
6021   /* iterators */
6022   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
6023   /* BLAS integers */
6024   PetscBLASInt      lwork,lierr;
6025   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
6026   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
6027   /* reuse */
6028   PetscInt          olocal_primal_size,olocal_primal_size_cc;
6029   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
6030   /* change of basis */
6031   PetscBool         qr_needed;
6032   PetscBT           change_basis,qr_needed_idx;
6033   /* auxiliary stuff */
6034   PetscInt          *nnz,*is_indices;
6035   PetscInt          ncc;
6036   /* some quantities */
6037   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6038   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6039   PetscReal         tol; /* tolerance for retaining eigenmodes */
6040 
6041   PetscFunctionBegin;
6042   tol  = PetscSqrtReal(PETSC_SMALL);
6043   /* Destroy Mat objects computed previously */
6044   PetscCall(MatDestroy(&pcbddc->ChangeOfBasisMatrix));
6045   PetscCall(MatDestroy(&pcbddc->ConstraintMatrix));
6046   PetscCall(MatDestroy(&pcbddc->switch_static_change));
6047   /* save info on constraints from previous setup (if any) */
6048   olocal_primal_size = pcbddc->local_primal_size;
6049   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6050   PetscCall(PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult));
6051   PetscCall(PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc));
6052   PetscCall(PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc));
6053   PetscCall(PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult));
6054   PetscCall(PetscFree(pcbddc->primal_indices_local_idxs));
6055 
6056   if (!pcbddc->adaptive_selection) {
6057     IS           ISForVertices,*ISForFaces,*ISForEdges;
6058     MatNullSpace nearnullsp;
6059     const Vec    *nearnullvecs;
6060     Vec          *localnearnullsp;
6061     PetscScalar  *array;
6062     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size,o_nf,o_ne;
6063     PetscBool    nnsp_has_cnst;
6064     /* LAPACK working arrays for SVD or POD */
6065     PetscBool    skip_lapack,boolforchange;
6066     PetscScalar  *work;
6067     PetscReal    *singular_vals;
6068 #if defined(PETSC_USE_COMPLEX)
6069     PetscReal    *rwork;
6070 #endif
6071     PetscScalar  *temp_basis = NULL,*correlation_mat = NULL;
6072     PetscBLASInt dummy_int=1;
6073     PetscScalar  dummy_scalar=1.;
6074     PetscBool    use_pod = PETSC_FALSE;
6075 
6076     /* MKL SVD with same input gives different results on different processes! */
6077 #if defined(PETSC_MISSING_LAPACK_GESVD) || defined(PETSC_HAVE_MKL_LIBS)
6078     use_pod = PETSC_TRUE;
6079 #endif
6080     /* Get index sets for faces, edges and vertices from graph */
6081     PetscCall(PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices));
6082     o_nf = n_ISForFaces;
6083     o_ne = n_ISForEdges;
6084     n_vertices = 0;
6085     if (ISForVertices) PetscCall(ISGetSize(ISForVertices,&n_vertices));
6086     /* print some info */
6087     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6088 
6089       if (!pcbddc->dbg_viewer) pcbddc->dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pc));
6090       PetscCall(PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer));
6091       PetscCall(PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer));
6092       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n"));
6093       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02" PetscInt_FMT " local candidate vertices (%d)\n",PetscGlobalRank,n_vertices,pcbddc->use_vertices));
6094       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02" PetscInt_FMT " local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges));
6095       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02" PetscInt_FMT " local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces));
6096       PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
6097       PetscCall(PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer));
6098     }
6099 
6100     if (!pcbddc->use_vertices) n_vertices = 0;
6101     if (!pcbddc->use_edges) n_ISForEdges = 0;
6102     if (!pcbddc->use_faces) n_ISForFaces = 0;
6103 
6104     /* check if near null space is attached to global mat */
6105     if (pcbddc->use_nnsp) {
6106       PetscCall(MatGetNearNullSpace(pc->pmat,&nearnullsp));
6107     } else nearnullsp = NULL;
6108 
6109     if (nearnullsp) {
6110       PetscCall(MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs));
6111       /* remove any stored info */
6112       PetscCall(MatNullSpaceDestroy(&pcbddc->onearnullspace));
6113       PetscCall(PetscFree(pcbddc->onearnullvecs_state));
6114       /* store information for BDDC solver reuse */
6115       PetscCall(PetscObjectReference((PetscObject)nearnullsp));
6116       pcbddc->onearnullspace = nearnullsp;
6117       PetscCall(PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state));
6118       for (i=0;i<nnsp_size;i++) {
6119         PetscCall(PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]));
6120       }
6121     } else { /* if near null space is not provided BDDC uses constants by default */
6122       nnsp_size = 0;
6123       nnsp_has_cnst = PETSC_TRUE;
6124     }
6125     /* get max number of constraints on a single cc */
6126     max_constraints = nnsp_size;
6127     if (nnsp_has_cnst) max_constraints++;
6128 
6129     /*
6130          Evaluate maximum storage size needed by the procedure
6131          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6132          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6133          There can be multiple constraints per connected component
6134                                                                                                                                                            */
6135     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6136     PetscCall(PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n));
6137 
6138     total_counts = n_ISForFaces+n_ISForEdges;
6139     total_counts *= max_constraints;
6140     total_counts += n_vertices;
6141     PetscCall(PetscBTCreate(total_counts,&change_basis));
6142 
6143     total_counts = 0;
6144     max_size_of_constraint = 0;
6145     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6146       IS used_is;
6147       if (i<n_ISForEdges) {
6148         used_is = ISForEdges[i];
6149       } else {
6150         used_is = ISForFaces[i-n_ISForEdges];
6151       }
6152       PetscCall(ISGetSize(used_is,&j));
6153       total_counts += j;
6154       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6155     }
6156     PetscCall(PetscMalloc3(total_counts*max_constraints+n_vertices,&constraints_data,total_counts+n_vertices,&constraints_idxs,total_counts+n_vertices,&constraints_idxs_B));
6157 
6158     /* get local part of global near null space vectors */
6159     PetscCall(PetscMalloc1(nnsp_size,&localnearnullsp));
6160     for (k=0;k<nnsp_size;k++) {
6161       PetscCall(VecDuplicate(pcis->vec1_N,&localnearnullsp[k]));
6162       PetscCall(VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD));
6163       PetscCall(VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD));
6164     }
6165 
6166     /* whether or not to skip lapack calls */
6167     skip_lapack = PETSC_TRUE;
6168     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6169 
6170     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6171     if (!skip_lapack) {
6172       PetscScalar temp_work;
6173 
6174       if (use_pod) {
6175         /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6176         PetscCall(PetscMalloc1(max_constraints*max_constraints,&correlation_mat));
6177         PetscCall(PetscMalloc1(max_constraints,&singular_vals));
6178         PetscCall(PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis));
6179 #if defined(PETSC_USE_COMPLEX)
6180         PetscCall(PetscMalloc1(3*max_constraints,&rwork));
6181 #endif
6182         /* now we evaluate the optimal workspace using query with lwork=-1 */
6183         PetscCall(PetscBLASIntCast(max_constraints,&Blas_N));
6184         PetscCall(PetscBLASIntCast(max_constraints,&Blas_LDA));
6185         lwork = -1;
6186         PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6187 #if !defined(PETSC_USE_COMPLEX)
6188         PetscCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6189 #else
6190         PetscCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6191 #endif
6192         PetscCall(PetscFPTrapPop());
6193         PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6194       } else {
6195 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6196         /* SVD */
6197         PetscInt max_n,min_n;
6198         max_n = max_size_of_constraint;
6199         min_n = max_constraints;
6200         if (max_size_of_constraint < max_constraints) {
6201           min_n = max_size_of_constraint;
6202           max_n = max_constraints;
6203         }
6204         PetscCall(PetscMalloc1(min_n,&singular_vals));
6205 #if defined(PETSC_USE_COMPLEX)
6206         PetscCall(PetscMalloc1(5*min_n,&rwork));
6207 #endif
6208         /* now we evaluate the optimal workspace using query with lwork=-1 */
6209         lwork = -1;
6210         PetscCall(PetscBLASIntCast(max_n,&Blas_M));
6211         PetscCall(PetscBLASIntCast(min_n,&Blas_N));
6212         PetscCall(PetscBLASIntCast(max_n,&Blas_LDA));
6213         PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6214 #if !defined(PETSC_USE_COMPLEX)
6215         PetscCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,&lierr));
6216 #else
6217         PetscCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,&constraints_data[0],&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,&temp_work,&lwork,rwork,&lierr));
6218 #endif
6219         PetscCall(PetscFPTrapPop());
6220         PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6221 #else
6222         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6223 #endif /* on missing GESVD */
6224       }
6225       /* Allocate optimal workspace */
6226       PetscCall(PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork));
6227       PetscCall(PetscMalloc1(lwork,&work));
6228     }
6229     /* Now we can loop on constraining sets */
6230     total_counts = 0;
6231     constraints_idxs_ptr[0] = 0;
6232     constraints_data_ptr[0] = 0;
6233     /* vertices */
6234     if (n_vertices) {
6235       PetscCall(ISGetIndices(ISForVertices,(const PetscInt**)&is_indices));
6236       PetscCall(PetscArraycpy(constraints_idxs,is_indices,n_vertices));
6237       for (i=0;i<n_vertices;i++) {
6238         constraints_n[total_counts] = 1;
6239         constraints_data[total_counts] = 1.0;
6240         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6241         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6242         total_counts++;
6243       }
6244       PetscCall(ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices));
6245     }
6246 
6247     /* edges and faces */
6248     total_counts_cc = total_counts;
6249     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6250       IS        used_is;
6251       PetscBool idxs_copied = PETSC_FALSE;
6252 
6253       if (ncc<n_ISForEdges) {
6254         used_is = ISForEdges[ncc];
6255         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6256       } else {
6257         used_is = ISForFaces[ncc-n_ISForEdges];
6258         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6259       }
6260       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6261 
6262       PetscCall(ISGetSize(used_is,&size_of_constraint));
6263       if (!size_of_constraint) continue;
6264       PetscCall(ISGetIndices(used_is,(const PetscInt**)&is_indices));
6265       /* change of basis should not be performed on local periodic nodes */
6266       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6267       if (nnsp_has_cnst) {
6268         PetscScalar quad_value;
6269 
6270         PetscCall(PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint));
6271         idxs_copied = PETSC_TRUE;
6272 
6273         if (!pcbddc->use_nnsp_true) {
6274           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6275         } else {
6276           quad_value = 1.0;
6277         }
6278         for (j=0;j<size_of_constraint;j++) {
6279           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6280         }
6281         temp_constraints++;
6282         total_counts++;
6283       }
6284       for (k=0;k<nnsp_size;k++) {
6285         PetscReal real_value;
6286         PetscScalar *ptr_to_data;
6287 
6288         PetscCall(VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array));
6289         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6290         for (j=0;j<size_of_constraint;j++) {
6291           ptr_to_data[j] = array[is_indices[j]];
6292         }
6293         PetscCall(VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array));
6294         /* check if array is null on the connected component */
6295         PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_N));
6296         PetscCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6297         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6298           temp_constraints++;
6299           total_counts++;
6300           if (!idxs_copied) {
6301             PetscCall(PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint));
6302             idxs_copied = PETSC_TRUE;
6303           }
6304         }
6305       }
6306       PetscCall(ISRestoreIndices(used_is,(const PetscInt**)&is_indices));
6307       valid_constraints = temp_constraints;
6308       if (!pcbddc->use_nnsp_true && temp_constraints) {
6309         if (temp_constraints == 1) { /* just normalize the constraint */
6310           PetscScalar norm,*ptr_to_data;
6311 
6312           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6313           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_N));
6314           PetscCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6315           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6316           PetscCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6317         } else { /* perform SVD */
6318           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6319 
6320           if (use_pod) {
6321             /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6322                POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6323                -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6324                   the constraints basis will differ (by a complex factor with absolute value equal to 1)
6325                   from that computed using LAPACKgesvd
6326                -> This is due to a different computation of eigenvectors in LAPACKheev
6327                -> The quality of the POD-computed basis will be the same */
6328             PetscCall(PetscArrayzero(correlation_mat,temp_constraints*temp_constraints));
6329             /* Store upper triangular part of correlation matrix */
6330             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_N));
6331             PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6332             for (j=0;j<temp_constraints;j++) {
6333               for (k=0;k<j+1;k++) {
6334                 PetscCallBLAS("BLASdot",correlation_mat[j*temp_constraints+k] = BLASdot_(&Blas_N,ptr_to_data+k*size_of_constraint,&Blas_one,ptr_to_data+j*size_of_constraint,&Blas_one));
6335               }
6336             }
6337             /* compute eigenvalues and eigenvectors of correlation matrix */
6338             PetscCall(PetscBLASIntCast(temp_constraints,&Blas_N));
6339             PetscCall(PetscBLASIntCast(temp_constraints,&Blas_LDA));
6340 #if !defined(PETSC_USE_COMPLEX)
6341             PetscCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6342 #else
6343             PetscCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6344 #endif
6345             PetscCall(PetscFPTrapPop());
6346             PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6347             /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6348             j = 0;
6349             while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6350             total_counts = total_counts-j;
6351             valid_constraints = temp_constraints-j;
6352             /* scale and copy POD basis into used quadrature memory */
6353             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_M));
6354             PetscCall(PetscBLASIntCast(temp_constraints,&Blas_N));
6355             PetscCall(PetscBLASIntCast(temp_constraints,&Blas_K));
6356             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDA));
6357             PetscCall(PetscBLASIntCast(temp_constraints,&Blas_LDB));
6358             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDC));
6359             if (j<temp_constraints) {
6360               PetscInt ii;
6361               for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6362               PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6363               PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,ptr_to_data,&Blas_LDA,correlation_mat,&Blas_LDB,&zero,temp_basis,&Blas_LDC));
6364               PetscCall(PetscFPTrapPop());
6365               for (k=0;k<temp_constraints-j;k++) {
6366                 for (ii=0;ii<size_of_constraint;ii++) {
6367                   ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6368                 }
6369               }
6370             }
6371           } else {
6372 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6373             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_M));
6374             PetscCall(PetscBLASIntCast(temp_constraints,&Blas_N));
6375             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDA));
6376             PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6377 #if !defined(PETSC_USE_COMPLEX)
6378             PetscCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,&lierr));
6379 #else
6380             PetscCallBLAS("LAPACKgesvd",LAPACKgesvd_("O","N",&Blas_M,&Blas_N,ptr_to_data,&Blas_LDA,singular_vals,&dummy_scalar,&dummy_int,&dummy_scalar,&dummy_int,work,&lwork,rwork,&lierr));
6381 #endif
6382             PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6383             PetscCall(PetscFPTrapPop());
6384             /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6385             k = temp_constraints;
6386             if (k > size_of_constraint) k = size_of_constraint;
6387             j = 0;
6388             while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6389             valid_constraints = k-j;
6390             total_counts = total_counts-temp_constraints+valid_constraints;
6391 #else
6392             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6393 #endif /* on missing GESVD */
6394           }
6395         }
6396       }
6397       /* update pointers information */
6398       if (valid_constraints) {
6399         constraints_n[total_counts_cc] = valid_constraints;
6400         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6401         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6402         /* set change_of_basis flag */
6403         if (boolforchange) {
6404           PetscBTSet(change_basis,total_counts_cc);
6405         }
6406         total_counts_cc++;
6407       }
6408     }
6409     /* free workspace */
6410     if (!skip_lapack) {
6411       PetscCall(PetscFree(work));
6412 #if defined(PETSC_USE_COMPLEX)
6413       PetscCall(PetscFree(rwork));
6414 #endif
6415       PetscCall(PetscFree(singular_vals));
6416       PetscCall(PetscFree(correlation_mat));
6417       PetscCall(PetscFree(temp_basis));
6418     }
6419     for (k=0;k<nnsp_size;k++) {
6420       PetscCall(VecDestroy(&localnearnullsp[k]));
6421     }
6422     PetscCall(PetscFree(localnearnullsp));
6423     /* free index sets of faces, edges and vertices */
6424     PetscCall(PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,&o_nf,&ISForFaces,&o_ne,&ISForEdges,&ISForVertices));
6425   } else {
6426     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6427 
6428     total_counts = 0;
6429     n_vertices = 0;
6430     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6431       PetscCall(ISGetLocalSize(sub_schurs->is_vertices,&n_vertices));
6432     }
6433     max_constraints = 0;
6434     total_counts_cc = 0;
6435     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6436       total_counts += pcbddc->adaptive_constraints_n[i];
6437       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6438       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6439     }
6440     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6441     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6442     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6443     constraints_data = pcbddc->adaptive_constraints_data;
6444     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6445     PetscCall(PetscMalloc1(total_counts_cc,&constraints_n));
6446     total_counts_cc = 0;
6447     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6448       if (pcbddc->adaptive_constraints_n[i]) {
6449         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6450       }
6451     }
6452 
6453     max_size_of_constraint = 0;
6454     for (i=0;i<total_counts_cc;i++) max_size_of_constraint = PetscMax(max_size_of_constraint,constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i]);
6455     PetscCall(PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B));
6456     /* Change of basis */
6457     PetscCall(PetscBTCreate(total_counts_cc,&change_basis));
6458     if (pcbddc->use_change_of_basis) {
6459       for (i=0;i<sub_schurs->n_subs;i++) {
6460         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6461           PetscCall(PetscBTSet(change_basis,i+n_vertices));
6462         }
6463       }
6464     }
6465   }
6466   pcbddc->local_primal_size = total_counts;
6467   PetscCall(PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs));
6468 
6469   /* map constraints_idxs in boundary numbering */
6470   if (pcbddc->use_change_of_basis) {
6471     PetscCall(ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B));
6472     PetscCheck(i == constraints_idxs_ptr[total_counts_cc],PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %" PetscInt_FMT " != %" PetscInt_FMT,constraints_idxs_ptr[total_counts_cc],i);
6473   }
6474 
6475   /* Create constraint matrix */
6476   PetscCall(MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix));
6477   PetscCall(MatSetType(pcbddc->ConstraintMatrix,MATAIJ));
6478   PetscCall(MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n));
6479 
6480   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6481   /* determine if a QR strategy is needed for change of basis */
6482   qr_needed = pcbddc->use_qr_single;
6483   PetscCall(PetscBTCreate(total_counts_cc,&qr_needed_idx));
6484   total_primal_vertices=0;
6485   pcbddc->local_primal_size_cc = 0;
6486   for (i=0;i<total_counts_cc;i++) {
6487     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6488     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6489       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6490       pcbddc->local_primal_size_cc += 1;
6491     } else if (PetscBTLookup(change_basis,i)) {
6492       for (k=0;k<constraints_n[i];k++) {
6493         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6494       }
6495       pcbddc->local_primal_size_cc += constraints_n[i];
6496       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6497         PetscBTSet(qr_needed_idx,i);
6498         qr_needed = PETSC_TRUE;
6499       }
6500     } else {
6501       pcbddc->local_primal_size_cc += 1;
6502     }
6503   }
6504   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6505   pcbddc->n_vertices = total_primal_vertices;
6506   /* permute indices in order to have a sorted set of vertices */
6507   PetscCall(PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs));
6508   PetscCall(PetscMalloc2(pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_node,pcbddc->local_primal_size_cc+pcbddc->benign_n,&pcbddc->local_primal_ref_mult));
6509   PetscCall(PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices));
6510   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6511 
6512   /* nonzero structure of constraint matrix */
6513   /* and get reference dof for local constraints */
6514   PetscCall(PetscMalloc1(pcbddc->local_primal_size,&nnz));
6515   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6516 
6517   j = total_primal_vertices;
6518   total_counts = total_primal_vertices;
6519   cum = total_primal_vertices;
6520   for (i=n_vertices;i<total_counts_cc;i++) {
6521     if (!PetscBTLookup(change_basis,i)) {
6522       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6523       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6524       cum++;
6525       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6526       for (k=0;k<constraints_n[i];k++) {
6527         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6528         nnz[j+k] = size_of_constraint;
6529       }
6530       j += constraints_n[i];
6531     }
6532   }
6533   PetscCall(MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz));
6534   PetscCall(MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE));
6535   PetscCall(PetscFree(nnz));
6536 
6537   /* set values in constraint matrix */
6538   for (i=0;i<total_primal_vertices;i++) {
6539     PetscCall(MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES));
6540   }
6541   total_counts = total_primal_vertices;
6542   for (i=n_vertices;i<total_counts_cc;i++) {
6543     if (!PetscBTLookup(change_basis,i)) {
6544       PetscInt *cols;
6545 
6546       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6547       cols = constraints_idxs+constraints_idxs_ptr[i];
6548       for (k=0;k<constraints_n[i];k++) {
6549         PetscInt    row = total_counts+k;
6550         PetscScalar *vals;
6551 
6552         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6553         PetscCall(MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES));
6554       }
6555       total_counts += constraints_n[i];
6556     }
6557   }
6558   /* assembling */
6559   PetscCall(MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY));
6560   PetscCall(MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY));
6561   PetscCall(MatViewFromOptions(pcbddc->ConstraintMatrix,(PetscObject)pc,"-pc_bddc_constraint_mat_view"));
6562 
6563   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6564   if (pcbddc->use_change_of_basis) {
6565     /* dual and primal dofs on a single cc */
6566     PetscInt     dual_dofs,primal_dofs;
6567     /* working stuff for GEQRF */
6568     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6569     PetscBLASInt lqr_work;
6570     /* working stuff for UNGQR */
6571     PetscScalar  *gqr_work = NULL,lgqr_work_t=0.0;
6572     PetscBLASInt lgqr_work;
6573     /* working stuff for TRTRS */
6574     PetscScalar  *trs_rhs = NULL;
6575     PetscBLASInt Blas_NRHS;
6576     /* pointers for values insertion into change of basis matrix */
6577     PetscInt     *start_rows,*start_cols;
6578     PetscScalar  *start_vals;
6579     /* working stuff for values insertion */
6580     PetscBT      is_primal;
6581     PetscInt     *aux_primal_numbering_B;
6582     /* matrix sizes */
6583     PetscInt     global_size,local_size;
6584     /* temporary change of basis */
6585     Mat          localChangeOfBasisMatrix;
6586     /* extra space for debugging */
6587     PetscScalar  *dbg_work = NULL;
6588 
6589     PetscCall(MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix));
6590     PetscCall(MatSetType(localChangeOfBasisMatrix,MATAIJ));
6591     PetscCall(MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n));
6592     /* nonzeros for local mat */
6593     PetscCall(PetscMalloc1(pcis->n,&nnz));
6594     if (!pcbddc->benign_change || pcbddc->fake_change) {
6595       for (i=0;i<pcis->n;i++) nnz[i]=1;
6596     } else {
6597       const PetscInt *ii;
6598       PetscInt       n;
6599       PetscBool      flg_row;
6600       PetscCall(MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row));
6601       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6602       PetscCall(MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row));
6603     }
6604     for (i=n_vertices;i<total_counts_cc;i++) {
6605       if (PetscBTLookup(change_basis,i)) {
6606         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6607         if (PetscBTLookup(qr_needed_idx,i)) {
6608           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6609         } else {
6610           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6611           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6612         }
6613       }
6614     }
6615     PetscCall(MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz));
6616     PetscCall(MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE));
6617     PetscCall(PetscFree(nnz));
6618     /* Set interior change in the matrix */
6619     if (!pcbddc->benign_change || pcbddc->fake_change) {
6620       for (i=0;i<pcis->n;i++) {
6621         PetscCall(MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES));
6622       }
6623     } else {
6624       const PetscInt *ii,*jj;
6625       PetscScalar    *aa;
6626       PetscInt       n;
6627       PetscBool      flg_row;
6628       PetscCall(MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row));
6629       PetscCall(MatSeqAIJGetArray(pcbddc->benign_change,&aa));
6630       for (i=0;i<n;i++) {
6631         PetscCall(MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES));
6632       }
6633       PetscCall(MatSeqAIJRestoreArray(pcbddc->benign_change,&aa));
6634       PetscCall(MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row));
6635     }
6636 
6637     if (pcbddc->dbg_flag) {
6638       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n"));
6639       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank));
6640     }
6641 
6642     /* Now we loop on the constraints which need a change of basis */
6643     /*
6644        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6645        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6646 
6647        Basic blocks of change of basis matrix T computed:
6648 
6649           - By using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6650 
6651             | 1        0   ...        0         s_1/S |
6652             | 0        1   ...        0         s_2/S |
6653             |              ...                        |
6654             | 0        ...            1     s_{n-1}/S |
6655             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6656 
6657             with S = \sum_{i=1}^n s_i^2
6658             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6659                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6660 
6661           - QR decomposition of constraints otherwise
6662     */
6663     if (qr_needed && max_size_of_constraint) {
6664       /* space to store Q */
6665       PetscCall(PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis));
6666       /* array to store scaling factors for reflectors */
6667       PetscCall(PetscMalloc1(max_constraints,&qr_tau));
6668       /* first we issue queries for optimal work */
6669       PetscCall(PetscBLASIntCast(max_size_of_constraint,&Blas_M));
6670       PetscCall(PetscBLASIntCast(max_constraints,&Blas_N));
6671       PetscCall(PetscBLASIntCast(max_size_of_constraint,&Blas_LDA));
6672       lqr_work = -1;
6673       PetscCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6674       PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6675       PetscCall(PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work));
6676       PetscCall(PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work));
6677       lgqr_work = -1;
6678       PetscCall(PetscBLASIntCast(max_size_of_constraint,&Blas_M));
6679       PetscCall(PetscBLASIntCast(max_size_of_constraint,&Blas_N));
6680       PetscCall(PetscBLASIntCast(max_constraints,&Blas_K));
6681       PetscCall(PetscBLASIntCast(max_size_of_constraint,&Blas_LDA));
6682       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6683       PetscCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6684       PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6685       PetscCall(PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work));
6686       PetscCall(PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work));
6687       /* array to store rhs and solution of triangular solver */
6688       PetscCall(PetscMalloc1(max_constraints*max_constraints,&trs_rhs));
6689       /* allocating workspace for check */
6690       if (pcbddc->dbg_flag) {
6691         PetscCall(PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work));
6692       }
6693     }
6694     /* array to store whether a node is primal or not */
6695     PetscCall(PetscBTCreate(pcis->n_B,&is_primal));
6696     PetscCall(PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B));
6697     PetscCall(ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B));
6698     PetscCheck(i == total_primal_vertices,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %" PetscInt_FMT " != %" PetscInt_FMT,total_primal_vertices,i);
6699     for (i=0;i<total_primal_vertices;i++) {
6700       PetscCall(PetscBTSet(is_primal,aux_primal_numbering_B[i]));
6701     }
6702     PetscCall(PetscFree(aux_primal_numbering_B));
6703 
6704     /* loop on constraints and see whether or not they need a change of basis and compute it */
6705     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6706       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6707       if (PetscBTLookup(change_basis,total_counts)) {
6708         /* get constraint info */
6709         primal_dofs = constraints_n[total_counts];
6710         dual_dofs = size_of_constraint-primal_dofs;
6711 
6712         if (pcbddc->dbg_flag) {
6713           PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %" PetscInt_FMT ": %" PetscInt_FMT " need a change of basis (size %" PetscInt_FMT ")\n",total_counts,primal_dofs,size_of_constraint));
6714         }
6715 
6716         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6717 
6718           /* copy quadrature constraints for change of basis check */
6719           if (pcbddc->dbg_flag) {
6720             PetscCall(PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs));
6721           }
6722           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6723           PetscCall(PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs));
6724 
6725           /* compute QR decomposition of constraints */
6726           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_M));
6727           PetscCall(PetscBLASIntCast(primal_dofs,&Blas_N));
6728           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDA));
6729           PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6730           PetscCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6731           PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6732           PetscCall(PetscFPTrapPop());
6733 
6734           /* explicitly compute R^-T */
6735           PetscCall(PetscArrayzero(trs_rhs,primal_dofs*primal_dofs));
6736           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6737           PetscCall(PetscBLASIntCast(primal_dofs,&Blas_N));
6738           PetscCall(PetscBLASIntCast(primal_dofs,&Blas_NRHS));
6739           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDA));
6740           PetscCall(PetscBLASIntCast(primal_dofs,&Blas_LDB));
6741           PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6742           PetscCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6743           PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6744           PetscCall(PetscFPTrapPop());
6745 
6746           /* explicitly compute all columns of Q (Q = [Q1 | Q2]) overwriting QR factorization in qr_basis */
6747           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_M));
6748           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_N));
6749           PetscCall(PetscBLASIntCast(primal_dofs,&Blas_K));
6750           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDA));
6751           PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6752           PetscCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6753           PetscCheck(!lierr,PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6754           PetscCall(PetscFPTrapPop());
6755 
6756           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6757              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6758              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6759           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_M));
6760           PetscCall(PetscBLASIntCast(primal_dofs,&Blas_N));
6761           PetscCall(PetscBLASIntCast(primal_dofs,&Blas_K));
6762           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDA));
6763           PetscCall(PetscBLASIntCast(primal_dofs,&Blas_LDB));
6764           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDC));
6765           PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6766           PetscCallBLAS("BLASgemm",BLASgemm_("N","N",&Blas_M,&Blas_N,&Blas_K,&one,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&zero,constraints_data+constraints_data_ptr[total_counts],&Blas_LDC));
6767           PetscCall(PetscFPTrapPop());
6768           PetscCall(PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs));
6769 
6770           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6771           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6772           /* insert cols for primal dofs */
6773           for (j=0;j<primal_dofs;j++) {
6774             start_vals = &qr_basis[j*size_of_constraint];
6775             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6776             PetscCall(MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES));
6777           }
6778           /* insert cols for dual dofs */
6779           for (j=0,k=0;j<dual_dofs;k++) {
6780             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6781               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6782               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6783               PetscCall(MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES));
6784               j++;
6785             }
6786           }
6787 
6788           /* check change of basis */
6789           if (pcbddc->dbg_flag) {
6790             PetscInt   ii,jj;
6791             PetscBool valid_qr=PETSC_TRUE;
6792             PetscCall(PetscBLASIntCast(primal_dofs,&Blas_M));
6793             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_N));
6794             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_K));
6795             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDA));
6796             PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_LDB));
6797             PetscCall(PetscBLASIntCast(primal_dofs,&Blas_LDC));
6798             PetscCall(PetscFPTrapPush(PETSC_FP_TRAP_OFF));
6799             PetscCallBLAS("BLASgemm",BLASgemm_("T","N",&Blas_M,&Blas_N,&Blas_K,&one,dbg_work,&Blas_LDA,qr_basis,&Blas_LDB,&zero,&dbg_work[size_of_constraint*primal_dofs],&Blas_LDC));
6800             PetscCall(PetscFPTrapPop());
6801             for (jj=0;jj<size_of_constraint;jj++) {
6802               for (ii=0;ii<primal_dofs;ii++) {
6803                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6804                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6805               }
6806             }
6807             if (!valid_qr) {
6808               PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n"));
6809               for (jj=0;jj<size_of_constraint;jj++) {
6810                 for (ii=0;ii<primal_dofs;ii++) {
6811                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6812                     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %" PetscInt_FMT " is not orthogonal to constraint %" PetscInt_FMT " (%1.14e)!\n",jj,ii,(double)PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii])));
6813                   }
6814                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6815                     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %" PetscInt_FMT " is not unitary w.r.t constraint %" PetscInt_FMT " (%1.14e)!\n",jj,ii,(double)PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii])));
6816                   }
6817                 }
6818               }
6819             } else {
6820               PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n"));
6821             }
6822           }
6823         } else { /* simple transformation block */
6824           PetscInt    row,col;
6825           PetscScalar val,norm;
6826 
6827           PetscCall(PetscBLASIntCast(size_of_constraint,&Blas_N));
6828           PetscCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6829           for (j=0;j<size_of_constraint;j++) {
6830             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6831             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6832             if (!PetscBTLookup(is_primal,row_B)) {
6833               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6834               PetscCall(MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES));
6835               PetscCall(MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES));
6836             } else {
6837               for (k=0;k<size_of_constraint;k++) {
6838                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6839                 if (row != col) {
6840                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6841                 } else {
6842                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6843                 }
6844                 PetscCall(MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES));
6845               }
6846             }
6847           }
6848           if (pcbddc->dbg_flag) {
6849             PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n"));
6850           }
6851         }
6852       } else {
6853         if (pcbddc->dbg_flag) {
6854           PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %" PetscInt_FMT " does not need a change of basis (size %" PetscInt_FMT ")\n",total_counts,size_of_constraint));
6855         }
6856       }
6857     }
6858 
6859     /* free workspace */
6860     if (qr_needed) {
6861       if (pcbddc->dbg_flag) PetscCall(PetscFree(dbg_work));
6862       PetscCall(PetscFree(trs_rhs));
6863       PetscCall(PetscFree(qr_tau));
6864       PetscCall(PetscFree(qr_work));
6865       PetscCall(PetscFree(gqr_work));
6866       PetscCall(PetscFree(qr_basis));
6867     }
6868     PetscCall(PetscBTDestroy(&is_primal));
6869     PetscCall(MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY));
6870     PetscCall(MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY));
6871 
6872     /* assembling of global change of variable */
6873     if (!pcbddc->fake_change) {
6874       Mat      tmat;
6875       PetscInt bs;
6876 
6877       PetscCall(VecGetSize(pcis->vec1_global,&global_size));
6878       PetscCall(VecGetLocalSize(pcis->vec1_global,&local_size));
6879       PetscCall(MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat));
6880       PetscCall(MatISSetLocalMat(tmat,localChangeOfBasisMatrix));
6881       PetscCall(MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY));
6882       PetscCall(MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY));
6883       PetscCall(MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix));
6884       PetscCall(MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ));
6885       PetscCall(MatGetBlockSize(pc->pmat,&bs));
6886       PetscCall(MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs));
6887       PetscCall(MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size));
6888       PetscCall(MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE));
6889       PetscCall(MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix));
6890       PetscCall(MatDestroy(&tmat));
6891       PetscCall(VecSet(pcis->vec1_global,0.0));
6892       PetscCall(VecSet(pcis->vec1_N,1.0));
6893       PetscCall(VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE));
6894       PetscCall(VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE));
6895       PetscCall(VecReciprocal(pcis->vec1_global));
6896       PetscCall(MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL));
6897 
6898       /* check */
6899       if (pcbddc->dbg_flag) {
6900         PetscReal error;
6901         Vec       x,x_change;
6902 
6903         PetscCall(VecDuplicate(pcis->vec1_global,&x));
6904         PetscCall(VecDuplicate(pcis->vec1_global,&x_change));
6905         PetscCall(VecSetRandom(x,NULL));
6906         PetscCall(VecCopy(x,pcis->vec1_global));
6907         PetscCall(VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD));
6908         PetscCall(VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD));
6909         PetscCall(MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N));
6910         PetscCall(VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE));
6911         PetscCall(VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE));
6912         PetscCall(MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change));
6913         PetscCall(VecAXPY(x,-1.0,x_change));
6914         PetscCall(VecNorm(x,NORM_INFINITY,&error));
6915         PetscCheck(error <= PETSC_SMALL,PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",(double)error);
6916         PetscCall(VecDestroy(&x));
6917         PetscCall(VecDestroy(&x_change));
6918       }
6919       /* adapt sub_schurs computed (if any) */
6920       if (pcbddc->use_deluxe_scaling) {
6921         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6922 
6923         PetscCheck(!pcbddc->use_change_of_basis || !pcbddc->adaptive_userdefined,PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Cannot mix automatic change of basis, adaptive selection and user-defined constraints");
6924         if (sub_schurs && sub_schurs->S_Ej_all) {
6925           Mat                    S_new,tmat;
6926           IS                     is_all_N,is_V_Sall = NULL;
6927 
6928           PetscCall(ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N));
6929           PetscCall(MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat));
6930           if (pcbddc->deluxe_zerorows) {
6931             ISLocalToGlobalMapping NtoSall;
6932             IS                     is_V;
6933             PetscCall(ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V));
6934             PetscCall(ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall));
6935             PetscCall(ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall));
6936             PetscCall(ISLocalToGlobalMappingDestroy(&NtoSall));
6937             PetscCall(ISDestroy(&is_V));
6938           }
6939           PetscCall(ISDestroy(&is_all_N));
6940           PetscCall(MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new));
6941           PetscCall(MatDestroy(&sub_schurs->S_Ej_all));
6942           PetscCall(PetscObjectReference((PetscObject)S_new));
6943           if (pcbddc->deluxe_zerorows) {
6944             const PetscScalar *array;
6945             const PetscInt    *idxs_V,*idxs_all;
6946             PetscInt          i,n_V;
6947 
6948             PetscCall(MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL));
6949             PetscCall(ISGetLocalSize(is_V_Sall,&n_V));
6950             PetscCall(ISGetIndices(is_V_Sall,&idxs_V));
6951             PetscCall(ISGetIndices(sub_schurs->is_Ej_all,&idxs_all));
6952             PetscCall(VecGetArrayRead(pcis->D,&array));
6953             for (i=0;i<n_V;i++) {
6954               PetscScalar val;
6955               PetscInt    idx;
6956 
6957               idx = idxs_V[i];
6958               val = array[idxs_all[idxs_V[i]]];
6959               PetscCall(MatSetValue(S_new,idx,idx,val,INSERT_VALUES));
6960             }
6961             PetscCall(MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY));
6962             PetscCall(MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY));
6963             PetscCall(VecRestoreArrayRead(pcis->D,&array));
6964             PetscCall(ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all));
6965             PetscCall(ISRestoreIndices(is_V_Sall,&idxs_V));
6966           }
6967           sub_schurs->S_Ej_all = S_new;
6968           PetscCall(MatDestroy(&S_new));
6969           if (sub_schurs->sum_S_Ej_all) {
6970             PetscCall(MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new));
6971             PetscCall(MatDestroy(&sub_schurs->sum_S_Ej_all));
6972             PetscCall(PetscObjectReference((PetscObject)S_new));
6973             if (pcbddc->deluxe_zerorows) PetscCall(MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL));
6974             sub_schurs->sum_S_Ej_all = S_new;
6975             PetscCall(MatDestroy(&S_new));
6976           }
6977           PetscCall(ISDestroy(&is_V_Sall));
6978           PetscCall(MatDestroy(&tmat));
6979         }
6980         /* destroy any change of basis context in sub_schurs */
6981         if (sub_schurs && sub_schurs->change) {
6982           PetscInt i;
6983 
6984           for (i=0;i<sub_schurs->n_subs;i++) {
6985             PetscCall(KSPDestroy(&sub_schurs->change[i]));
6986           }
6987           PetscCall(PetscFree(sub_schurs->change));
6988         }
6989       }
6990       if (pcbddc->switch_static) { /* need to save the local change */
6991         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6992       } else {
6993         PetscCall(MatDestroy(&localChangeOfBasisMatrix));
6994       }
6995       /* determine if any process has changed the pressures locally */
6996       pcbddc->change_interior = pcbddc->benign_have_null;
6997     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6998       PetscCall(MatDestroy(&pcbddc->ConstraintMatrix));
6999       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
7000       pcbddc->use_qr_single = qr_needed;
7001     }
7002   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
7003     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
7004       PetscCall(PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix));
7005       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
7006     } else {
7007       Mat benign_global = NULL;
7008       if (pcbddc->benign_have_null) {
7009         Mat M;
7010 
7011         pcbddc->change_interior = PETSC_TRUE;
7012         PetscCall(VecCopy(matis->counter,pcis->vec1_N));
7013         PetscCall(VecReciprocal(pcis->vec1_N));
7014         PetscCall(MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global));
7015         if (pcbddc->benign_change) {
7016           PetscCall(MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M));
7017           PetscCall(MatDiagonalScale(M,pcis->vec1_N,NULL));
7018         } else {
7019           PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M));
7020           PetscCall(MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES));
7021         }
7022         PetscCall(MatISSetLocalMat(benign_global,M));
7023         PetscCall(MatDestroy(&M));
7024         PetscCall(MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY));
7025         PetscCall(MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY));
7026       }
7027       if (pcbddc->user_ChangeOfBasisMatrix) {
7028         PetscCall(MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix));
7029         PetscCall(MatDestroy(&benign_global));
7030       } else if (pcbddc->benign_have_null) {
7031         pcbddc->ChangeOfBasisMatrix = benign_global;
7032       }
7033     }
7034     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7035       IS             is_global;
7036       const PetscInt *gidxs;
7037 
7038       PetscCall(ISLocalToGlobalMappingGetIndices(matis->rmapping,&gidxs));
7039       PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global));
7040       PetscCall(ISLocalToGlobalMappingRestoreIndices(matis->rmapping,&gidxs));
7041       PetscCall(MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change));
7042       PetscCall(ISDestroy(&is_global));
7043     }
7044   }
7045   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7046     PetscCall(VecDuplicate(pcis->vec1_global,&pcbddc->work_change));
7047   }
7048 
7049   if (!pcbddc->fake_change) {
7050     /* add pressure dofs to set of primal nodes for numbering purposes */
7051     for (i=0;i<pcbddc->benign_n;i++) {
7052       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7053       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7054       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7055       pcbddc->local_primal_size_cc++;
7056       pcbddc->local_primal_size++;
7057     }
7058 
7059     /* check if a new primal space has been introduced (also take into account benign trick) */
7060     pcbddc->new_primal_space_local = PETSC_TRUE;
7061     if (olocal_primal_size == pcbddc->local_primal_size) {
7062       PetscCall(PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local));
7063       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7064       if (!pcbddc->new_primal_space_local) {
7065         PetscCall(PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local));
7066         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7067       }
7068     }
7069     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7070     PetscCall(MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc)));
7071   }
7072   PetscCall(PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult));
7073 
7074   /* flush dbg viewer */
7075   if (pcbddc->dbg_flag) PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
7076 
7077   /* free workspace */
7078   PetscCall(PetscBTDestroy(&qr_needed_idx));
7079   PetscCall(PetscBTDestroy(&change_basis));
7080   if (!pcbddc->adaptive_selection) {
7081     PetscCall(PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n));
7082     PetscCall(PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B));
7083   } else {
7084     PetscCall(PetscFree5(pcbddc->adaptive_constraints_n,pcbddc->adaptive_constraints_idxs_ptr,pcbddc->adaptive_constraints_data_ptr,pcbddc->adaptive_constraints_idxs,pcbddc->adaptive_constraints_data));
7085     PetscCall(PetscFree(constraints_n));
7086     PetscCall(PetscFree(constraints_idxs_B));
7087   }
7088   PetscFunctionReturn(0);
7089 }
7090 
7091 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7092 {
7093   ISLocalToGlobalMapping map;
7094   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7095   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7096   PetscInt               i,N;
7097   PetscBool              rcsr = PETSC_FALSE;
7098 
7099   PetscFunctionBegin;
7100   if (pcbddc->recompute_topography) {
7101     pcbddc->graphanalyzed = PETSC_FALSE;
7102     /* Reset previously computed graph */
7103     PetscCall(PCBDDCGraphReset(pcbddc->mat_graph));
7104     /* Init local Graph struct */
7105     PetscCall(MatGetSize(pc->pmat,&N,NULL));
7106     PetscCall(MatISGetLocalToGlobalMapping(pc->pmat,&map,NULL));
7107     PetscCall(PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount));
7108 
7109     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7110       PetscCall(PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local));
7111     }
7112     /* Check validity of the csr graph passed in by the user */
7113     PetscCheck(!pcbddc->mat_graph->nvtxs_csr || pcbddc->mat_graph->nvtxs_csr == pcbddc->mat_graph->nvtxs,PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %" PetscInt_FMT ", expected %" PetscInt_FMT,pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
7114 
7115     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7116     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7117       PetscInt  *xadj,*adjncy;
7118       PetscInt  nvtxs;
7119       PetscBool flg_row=PETSC_FALSE;
7120 
7121       PetscCall(MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row));
7122       if (flg_row) {
7123         PetscCall(PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES));
7124         pcbddc->computed_rowadj = PETSC_TRUE;
7125       }
7126       PetscCall(MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row));
7127       rcsr = PETSC_TRUE;
7128     }
7129     if (pcbddc->dbg_flag) PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
7130 
7131     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7132       PetscReal    *lcoords;
7133       PetscInt     n;
7134       MPI_Datatype dimrealtype;
7135 
7136       /* TODO: support for blocked */
7137       PetscCheck(pcbddc->mat_graph->cnloc == pc->pmat->rmap->n,PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %" PetscInt_FMT ", expected %" PetscInt_FMT,pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
7138       PetscCall(MatGetLocalSize(matis->A,&n,NULL));
7139       PetscCall(PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords));
7140       PetscCallMPI(MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype));
7141       PetscCallMPI(MPI_Type_commit(&dimrealtype));
7142       PetscCall(PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords,MPI_REPLACE));
7143       PetscCall(PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords,MPI_REPLACE));
7144       PetscCallMPI(MPI_Type_free(&dimrealtype));
7145       PetscCall(PetscFree(pcbddc->mat_graph->coords));
7146 
7147       pcbddc->mat_graph->coords = lcoords;
7148       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7149       pcbddc->mat_graph->cnloc  = n;
7150     }
7151     PetscCheck(!pcbddc->mat_graph->cnloc || pcbddc->mat_graph->cnloc == pcbddc->mat_graph->nvtxs,PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %" PetscInt_FMT ", expected %" PetscInt_FMT,pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
7152     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && pcbddc->mat_graph->cdim && !pcbddc->corner_selected);
7153 
7154     /* Setup of Graph */
7155     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7156     PetscCall(PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local));
7157 
7158     /* attach info on disconnected subdomains if present */
7159     if (pcbddc->n_local_subs) {
7160       PetscInt *local_subs,n,totn;
7161 
7162       PetscCall(MatGetLocalSize(matis->A,&n,NULL));
7163       PetscCall(PetscMalloc1(n,&local_subs));
7164       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7165       for (i=0;i<pcbddc->n_local_subs;i++) {
7166         const PetscInt *idxs;
7167         PetscInt       nl,j;
7168 
7169         PetscCall(ISGetLocalSize(pcbddc->local_subs[i],&nl));
7170         PetscCall(ISGetIndices(pcbddc->local_subs[i],&idxs));
7171         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7172         PetscCall(ISRestoreIndices(pcbddc->local_subs[i],&idxs));
7173       }
7174       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7175       pcbddc->mat_graph->n_local_subs = totn + 1;
7176       pcbddc->mat_graph->local_subs = local_subs;
7177     }
7178   }
7179 
7180   if (!pcbddc->graphanalyzed) {
7181     /* Graph's connected components analysis */
7182     PetscCall(PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph));
7183     pcbddc->graphanalyzed = PETSC_TRUE;
7184     pcbddc->corner_selected = pcbddc->corner_selection;
7185   }
7186   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7187   PetscFunctionReturn(0);
7188 }
7189 
7190 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt *nio, Vec vecs[])
7191 {
7192   PetscInt       i,j,n;
7193   PetscScalar    *alphas;
7194   PetscReal      norm,*onorms;
7195 
7196   PetscFunctionBegin;
7197   n = *nio;
7198   if (!n) PetscFunctionReturn(0);
7199   PetscCall(PetscMalloc2(n,&alphas,n,&onorms));
7200   PetscCall(VecNormalize(vecs[0],&norm));
7201   if (norm < PETSC_SMALL) {
7202     onorms[0] = 0.0;
7203     PetscCall(VecSet(vecs[0],0.0));
7204   } else {
7205     onorms[0] = norm;
7206   }
7207 
7208   for (i=1;i<n;i++) {
7209     PetscCall(VecMDot(vecs[i],i,vecs,alphas));
7210     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7211     PetscCall(VecMAXPY(vecs[i],i,alphas,vecs));
7212     PetscCall(VecNormalize(vecs[i],&norm));
7213     if (norm < PETSC_SMALL) {
7214       onorms[i] = 0.0;
7215       PetscCall(VecSet(vecs[i],0.0));
7216     } else {
7217       onorms[i] = norm;
7218     }
7219   }
7220   /* push nonzero vectors at the beginning */
7221   for (i=0;i<n;i++) {
7222     if (onorms[i] == 0.0) {
7223       for (j=i+1;j<n;j++) {
7224         if (onorms[j] != 0.0) {
7225           PetscCall(VecCopy(vecs[j],vecs[i]));
7226           onorms[j] = 0.0;
7227         }
7228       }
7229     }
7230   }
7231   for (i=0,*nio=0;i<n;i++) *nio += onorms[i] != 0.0 ? 1 : 0;
7232   PetscCall(PetscFree2(alphas,onorms));
7233   PetscFunctionReturn(0);
7234 }
7235 
7236 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7237 {
7238   ISLocalToGlobalMapping mapping;
7239   Mat                    A;
7240   PetscInt               n_neighs,*neighs,*n_shared,**shared;
7241   PetscMPIInt            size,rank,color;
7242   PetscInt               *xadj,*adjncy;
7243   PetscInt               *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7244   PetscInt               im_active,active_procs,N,n,i,j,threshold = 2;
7245   PetscInt               void_procs,*procs_candidates = NULL;
7246   PetscInt               xadj_count,*count;
7247   PetscBool              ismatis,use_vwgt=PETSC_FALSE;
7248   PetscSubcomm           psubcomm;
7249   MPI_Comm               subcomm;
7250 
7251   PetscFunctionBegin;
7252   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7253   PetscCall(PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis));
7254   PetscCheck(ismatis,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
7255   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7256   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7257   PetscCheck(*n_subdomains >0,PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %" PetscInt_FMT,*n_subdomains);
7258 
7259   if (have_void) *have_void = PETSC_FALSE;
7260   PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size));
7261   PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank));
7262   PetscCall(MatISGetLocalMat(mat,&A));
7263   PetscCall(MatGetLocalSize(A,&n,NULL));
7264   im_active = !!n;
7265   PetscCall(MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat)));
7266   void_procs = size - active_procs;
7267   /* get ranks of of non-active processes in mat communicator */
7268   if (void_procs) {
7269     PetscInt ncand;
7270 
7271     if (have_void) *have_void = PETSC_TRUE;
7272     PetscCall(PetscMalloc1(size,&procs_candidates));
7273     PetscCallMPI(MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat)));
7274     for (i=0,ncand=0;i<size;i++) {
7275       if (!procs_candidates[i]) {
7276         procs_candidates[ncand++] = i;
7277       }
7278     }
7279     /* force n_subdomains to be not greater that the number of non-active processes */
7280     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7281   }
7282 
7283   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7284      number of subdomains requested 1 -> send to rank-0 or first candidate in voids  */
7285   PetscCall(MatGetSize(mat,&N,NULL));
7286   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7287     PetscInt issize,isidx,dest;
7288     if (*n_subdomains == 1) dest = 0;
7289     else dest = rank;
7290     if (im_active) {
7291       issize = 1;
7292       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7293         isidx = procs_candidates[dest];
7294       } else {
7295         isidx = dest;
7296       }
7297     } else {
7298       issize = 0;
7299       isidx = -1;
7300     }
7301     if (*n_subdomains != 1) *n_subdomains = active_procs;
7302     PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends));
7303     PetscCall(PetscFree(procs_candidates));
7304     PetscFunctionReturn(0);
7305   }
7306   PetscCall(PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL));
7307   PetscCall(PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL));
7308   threshold = PetscMax(threshold,2);
7309 
7310   /* Get info on mapping */
7311   PetscCall(MatISGetLocalToGlobalMapping(mat,&mapping,NULL));
7312   PetscCall(ISLocalToGlobalMappingGetInfo(mapping,&n_neighs,&neighs,&n_shared,&shared));
7313 
7314   /* build local CSR graph of subdomains' connectivity */
7315   PetscCall(PetscMalloc1(2,&xadj));
7316   xadj[0] = 0;
7317   xadj[1] = PetscMax(n_neighs-1,0);
7318   PetscCall(PetscMalloc1(xadj[1],&adjncy));
7319   PetscCall(PetscMalloc1(xadj[1],&adjncy_wgt));
7320   PetscCall(PetscCalloc1(n,&count));
7321   for (i=1;i<n_neighs;i++)
7322     for (j=0;j<n_shared[i];j++)
7323       count[shared[i][j]] += 1;
7324 
7325   xadj_count = 0;
7326   for (i=1;i<n_neighs;i++) {
7327     for (j=0;j<n_shared[i];j++) {
7328       if (count[shared[i][j]] < threshold) {
7329         adjncy[xadj_count] = neighs[i];
7330         adjncy_wgt[xadj_count] = n_shared[i];
7331         xadj_count++;
7332         break;
7333       }
7334     }
7335   }
7336   xadj[1] = xadj_count;
7337   PetscCall(PetscFree(count));
7338   PetscCall(ISLocalToGlobalMappingRestoreInfo(mapping,&n_neighs,&neighs,&n_shared,&shared));
7339   PetscCall(PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt));
7340 
7341   PetscCall(PetscMalloc1(1,&ranks_send_to_idx));
7342 
7343   /* Restrict work on active processes only */
7344   PetscCall(PetscMPIIntCast(im_active,&color));
7345   if (void_procs) {
7346     PetscCall(PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm));
7347     PetscCall(PetscSubcommSetNumber(psubcomm,2)); /* 2 groups, active process and not active processes */
7348     PetscCall(PetscSubcommSetTypeGeneral(psubcomm,color,rank));
7349     subcomm = PetscSubcommChild(psubcomm);
7350   } else {
7351     psubcomm = NULL;
7352     subcomm = PetscObjectComm((PetscObject)mat);
7353   }
7354 
7355   v_wgt = NULL;
7356   if (!color) {
7357     PetscCall(PetscFree(xadj));
7358     PetscCall(PetscFree(adjncy));
7359     PetscCall(PetscFree(adjncy_wgt));
7360   } else {
7361     Mat             subdomain_adj;
7362     IS              new_ranks,new_ranks_contig;
7363     MatPartitioning partitioner;
7364     PetscInt        rstart=0,rend=0;
7365     PetscInt        *is_indices,*oldranks;
7366     PetscMPIInt     size;
7367     PetscBool       aggregate;
7368 
7369     PetscCallMPI(MPI_Comm_size(subcomm,&size));
7370     if (void_procs) {
7371       PetscInt prank = rank;
7372       PetscCall(PetscMalloc1(size,&oldranks));
7373       PetscCallMPI(MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm));
7374       for (i=0;i<xadj[1];i++) {
7375         PetscCall(PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]));
7376       }
7377       PetscCall(PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt));
7378     } else {
7379       oldranks = NULL;
7380     }
7381     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7382     if (aggregate) { /* TODO: all this part could be made more efficient */
7383       PetscInt    lrows,row,ncols,*cols;
7384       PetscMPIInt nrank;
7385       PetscScalar *vals;
7386 
7387       PetscCallMPI(MPI_Comm_rank(subcomm,&nrank));
7388       lrows = 0;
7389       if (nrank<redprocs) {
7390         lrows = size/redprocs;
7391         if (nrank<size%redprocs) lrows++;
7392       }
7393       PetscCall(MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj));
7394       PetscCall(MatGetOwnershipRange(subdomain_adj,&rstart,&rend));
7395       PetscCall(MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE));
7396       PetscCall(MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE));
7397       row = nrank;
7398       ncols = xadj[1]-xadj[0];
7399       cols = adjncy;
7400       PetscCall(PetscMalloc1(ncols,&vals));
7401       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7402       PetscCall(MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES));
7403       PetscCall(MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY));
7404       PetscCall(MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY));
7405       PetscCall(PetscFree(xadj));
7406       PetscCall(PetscFree(adjncy));
7407       PetscCall(PetscFree(adjncy_wgt));
7408       PetscCall(PetscFree(vals));
7409       if (use_vwgt) {
7410         Vec               v;
7411         const PetscScalar *array;
7412         PetscInt          nl;
7413 
7414         PetscCall(MatCreateVecs(subdomain_adj,&v,NULL));
7415         PetscCall(VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES));
7416         PetscCall(VecAssemblyBegin(v));
7417         PetscCall(VecAssemblyEnd(v));
7418         PetscCall(VecGetLocalSize(v,&nl));
7419         PetscCall(VecGetArrayRead(v,&array));
7420         PetscCall(PetscMalloc1(nl,&v_wgt));
7421         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7422         PetscCall(VecRestoreArrayRead(v,&array));
7423         PetscCall(VecDestroy(&v));
7424       }
7425     } else {
7426       PetscCall(MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj));
7427       if (use_vwgt) {
7428         PetscCall(PetscMalloc1(1,&v_wgt));
7429         v_wgt[0] = n;
7430       }
7431     }
7432     /* PetscCall(MatView(subdomain_adj,0)); */
7433 
7434     /* Partition */
7435     PetscCall(MatPartitioningCreate(subcomm,&partitioner));
7436 #if defined(PETSC_HAVE_PTSCOTCH)
7437     PetscCall(MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH));
7438 #elif defined(PETSC_HAVE_PARMETIS)
7439     PetscCall(MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS));
7440 #else
7441     PetscCall(MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE));
7442 #endif
7443     PetscCall(MatPartitioningSetAdjacency(partitioner,subdomain_adj));
7444     if (v_wgt) PetscCall(MatPartitioningSetVertexWeights(partitioner,v_wgt));
7445     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7446     PetscCall(MatPartitioningSetNParts(partitioner,*n_subdomains));
7447     PetscCall(MatPartitioningSetFromOptions(partitioner));
7448     PetscCall(MatPartitioningApply(partitioner,&new_ranks));
7449     /* PetscCall(MatPartitioningView(partitioner,0)); */
7450 
7451     /* renumber new_ranks to avoid "holes" in new set of processors */
7452     PetscCall(ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig));
7453     PetscCall(ISDestroy(&new_ranks));
7454     PetscCall(ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices));
7455     if (!aggregate) {
7456       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7457         PetscAssert(oldranks,PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7458         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7459       } else if (oldranks) {
7460         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7461       } else {
7462         ranks_send_to_idx[0] = is_indices[0];
7463       }
7464     } else {
7465       PetscInt    idx = 0;
7466       PetscMPIInt tag;
7467       MPI_Request *reqs;
7468 
7469       PetscCall(PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag));
7470       PetscCall(PetscMalloc1(rend-rstart,&reqs));
7471       for (i=rstart;i<rend;i++) {
7472         PetscCallMPI(MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]));
7473       }
7474       PetscCallMPI(MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE));
7475       PetscCallMPI(MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE));
7476       PetscCall(PetscFree(reqs));
7477       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7478         PetscAssert(oldranks,PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7479         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7480       } else if (oldranks) {
7481         ranks_send_to_idx[0] = oldranks[idx];
7482       } else {
7483         ranks_send_to_idx[0] = idx;
7484       }
7485     }
7486     PetscCall(ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices));
7487     /* clean up */
7488     PetscCall(PetscFree(oldranks));
7489     PetscCall(ISDestroy(&new_ranks_contig));
7490     PetscCall(MatDestroy(&subdomain_adj));
7491     PetscCall(MatPartitioningDestroy(&partitioner));
7492   }
7493   PetscCall(PetscSubcommDestroy(&psubcomm));
7494   PetscCall(PetscFree(procs_candidates));
7495 
7496   /* assemble parallel IS for sends */
7497   i = 1;
7498   if (!color) i=0;
7499   PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends));
7500   PetscFunctionReturn(0);
7501 }
7502 
7503 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7504 
7505 PetscErrorCode PCBDDCMatISSubassemble(Mat mat, IS is_sends, PetscInt n_subdomains, PetscBool restrict_comm, PetscBool restrict_full, PetscBool reuse, Mat *mat_n, PetscInt nis, IS isarray[], PetscInt nvecs, Vec nnsp_vec[])
7506 {
7507   Mat                    local_mat;
7508   IS                     is_sends_internal;
7509   PetscInt               rows,cols,new_local_rows;
7510   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7511   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7512   ISLocalToGlobalMapping l2gmap;
7513   PetscInt*              l2gmap_indices;
7514   const PetscInt*        is_indices;
7515   MatType                new_local_type;
7516   /* buffers */
7517   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7518   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7519   PetscInt               *recv_buffer_idxs_local;
7520   PetscScalar            *ptr_vals,*recv_buffer_vals;
7521   const PetscScalar      *send_buffer_vals;
7522   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7523   /* MPI */
7524   MPI_Comm               comm,comm_n;
7525   PetscSubcomm           subcomm;
7526   PetscMPIInt            n_sends,n_recvs,size;
7527   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7528   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7529   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7530   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7531   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7532 
7533   PetscFunctionBegin;
7534   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7535   PetscCall(PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis));
7536   PetscCheck(ismatis,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
7537   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7538   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7539   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7540   PetscValidLogicalCollectiveBool(mat,reuse,6);
7541   PetscValidLogicalCollectiveInt(mat,nis,8);
7542   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7543   if (nvecs) {
7544     PetscCheck(nvecs <= 1,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7545     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7546   }
7547   /* further checks */
7548   PetscCall(MatISGetLocalMat(mat,&local_mat));
7549   PetscCall(PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense));
7550   PetscCheck(isdense,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7551   PetscCall(MatGetSize(local_mat,&rows,&cols));
7552   PetscCheck(rows == cols,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7553   if (reuse && *mat_n) {
7554     PetscInt mrows,mcols,mnrows,mncols;
7555     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7556     PetscCall(PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis));
7557     PetscCheck(ismatis,PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7558     PetscCall(MatGetSize(mat,&mrows,&mcols));
7559     PetscCall(MatGetSize(*mat_n,&mnrows,&mncols));
7560     PetscCheck(mrows == mnrows,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %" PetscInt_FMT " != %" PetscInt_FMT,mrows,mnrows);
7561     PetscCheck(mcols == mncols,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %" PetscInt_FMT " != %" PetscInt_FMT,mcols,mncols);
7562   }
7563   PetscCall(MatGetBlockSize(local_mat,&bs));
7564   PetscValidLogicalCollectiveInt(mat,bs,1);
7565 
7566   /* prepare IS for sending if not provided */
7567   if (!is_sends) {
7568     PetscCheck(n_subdomains,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7569     PetscCall(PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL));
7570   } else {
7571     PetscCall(PetscObjectReference((PetscObject)is_sends));
7572     is_sends_internal = is_sends;
7573   }
7574 
7575   /* get comm */
7576   PetscCall(PetscObjectGetComm((PetscObject)mat,&comm));
7577 
7578   /* compute number of sends */
7579   PetscCall(ISGetLocalSize(is_sends_internal,&i));
7580   PetscCall(PetscMPIIntCast(i,&n_sends));
7581 
7582   /* compute number of receives */
7583   PetscCallMPI(MPI_Comm_size(comm,&size));
7584   PetscCall(PetscMalloc1(size,&iflags));
7585   PetscCall(PetscArrayzero(iflags,size));
7586   PetscCall(ISGetIndices(is_sends_internal,&is_indices));
7587   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7588   PetscCall(PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs));
7589   PetscCall(PetscFree(iflags));
7590 
7591   /* restrict comm if requested */
7592   subcomm = NULL;
7593   destroy_mat = PETSC_FALSE;
7594   if (restrict_comm) {
7595     PetscMPIInt color,subcommsize;
7596 
7597     color = 0;
7598     if (restrict_full) {
7599       if (!n_recvs) color = 1; /* processes not receiving anything will not participate in new comm (full restriction) */
7600     } else {
7601       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not participate in new comm */
7602     }
7603     PetscCall(MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm));
7604     subcommsize = size - subcommsize;
7605     /* check if reuse has been requested */
7606     if (reuse) {
7607       if (*mat_n) {
7608         PetscMPIInt subcommsize2;
7609         PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2));
7610         PetscCheck(subcommsize == subcommsize2,PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7611         comm_n = PetscObjectComm((PetscObject)*mat_n);
7612       } else {
7613         comm_n = PETSC_COMM_SELF;
7614       }
7615     } else { /* MAT_INITIAL_MATRIX */
7616       PetscMPIInt rank;
7617 
7618       PetscCallMPI(MPI_Comm_rank(comm,&rank));
7619       PetscCall(PetscSubcommCreate(comm,&subcomm));
7620       PetscCall(PetscSubcommSetNumber(subcomm,2));
7621       PetscCall(PetscSubcommSetTypeGeneral(subcomm,color,rank));
7622       comm_n = PetscSubcommChild(subcomm);
7623     }
7624     /* flag to destroy *mat_n if not significative */
7625     if (color) destroy_mat = PETSC_TRUE;
7626   } else {
7627     comm_n = comm;
7628   }
7629 
7630   /* prepare send/receive buffers */
7631   PetscCall(PetscMalloc1(size,&ilengths_idxs));
7632   PetscCall(PetscArrayzero(ilengths_idxs,size));
7633   PetscCall(PetscMalloc1(size,&ilengths_vals));
7634   PetscCall(PetscArrayzero(ilengths_vals,size));
7635   if (nis) {
7636     PetscCall(PetscCalloc1(size,&ilengths_idxs_is));
7637   }
7638 
7639   /* Get data from local matrices */
7640   PetscCheck(isdense,PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7641     /* TODO: See below some guidelines on how to prepare the local buffers */
7642     /*
7643        send_buffer_vals should contain the raw values of the local matrix
7644        send_buffer_idxs should contain:
7645        - MatType_PRIVATE type
7646        - PetscInt        size_of_l2gmap
7647        - PetscInt        global_row_indices[size_of_l2gmap]
7648        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7649     */
7650   {
7651     ISLocalToGlobalMapping mapping;
7652 
7653     PetscCall(MatISGetLocalToGlobalMapping(mat,&mapping,NULL));
7654     PetscCall(MatDenseGetArrayRead(local_mat,&send_buffer_vals));
7655     PetscCall(ISLocalToGlobalMappingGetSize(mapping,&i));
7656     PetscCall(PetscMalloc1(i+2,&send_buffer_idxs));
7657     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7658     send_buffer_idxs[1] = i;
7659     PetscCall(ISLocalToGlobalMappingGetIndices(mapping,(const PetscInt**)&ptr_idxs));
7660     PetscCall(PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i));
7661     PetscCall(ISLocalToGlobalMappingRestoreIndices(mapping,(const PetscInt**)&ptr_idxs));
7662     PetscCall(PetscMPIIntCast(i,&len));
7663     for (i=0;i<n_sends;i++) {
7664       ilengths_vals[is_indices[i]] = len*len;
7665       ilengths_idxs[is_indices[i]] = len+2;
7666     }
7667   }
7668   PetscCall(PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals));
7669   /* additional is (if any) */
7670   if (nis) {
7671     PetscMPIInt psum;
7672     PetscInt j;
7673     for (j=0,psum=0;j<nis;j++) {
7674       PetscInt plen;
7675       PetscCall(ISGetLocalSize(isarray[j],&plen));
7676       PetscCall(PetscMPIIntCast(plen,&len));
7677       psum += len+1; /* indices + length */
7678     }
7679     PetscCall(PetscMalloc1(psum,&send_buffer_idxs_is));
7680     for (j=0,psum=0;j<nis;j++) {
7681       PetscInt plen;
7682       const PetscInt *is_array_idxs;
7683       PetscCall(ISGetLocalSize(isarray[j],&plen));
7684       send_buffer_idxs_is[psum] = plen;
7685       PetscCall(ISGetIndices(isarray[j],&is_array_idxs));
7686       PetscCall(PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen));
7687       PetscCall(ISRestoreIndices(isarray[j],&is_array_idxs));
7688       psum += plen+1; /* indices + length */
7689     }
7690     for (i=0;i<n_sends;i++) {
7691       ilengths_idxs_is[is_indices[i]] = psum;
7692     }
7693     PetscCall(PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is));
7694   }
7695   PetscCall(MatISRestoreLocalMat(mat,&local_mat));
7696 
7697   buf_size_idxs = 0;
7698   buf_size_vals = 0;
7699   buf_size_idxs_is = 0;
7700   buf_size_vecs = 0;
7701   for (i=0;i<n_recvs;i++) {
7702     buf_size_idxs += (PetscInt)olengths_idxs[i];
7703     buf_size_vals += (PetscInt)olengths_vals[i];
7704     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7705     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7706   }
7707   PetscCall(PetscMalloc1(buf_size_idxs,&recv_buffer_idxs));
7708   PetscCall(PetscMalloc1(buf_size_vals,&recv_buffer_vals));
7709   PetscCall(PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is));
7710   PetscCall(PetscMalloc1(buf_size_vecs,&recv_buffer_vecs));
7711 
7712   /* get new tags for clean communications */
7713   PetscCall(PetscObjectGetNewTag((PetscObject)mat,&tag_idxs));
7714   PetscCall(PetscObjectGetNewTag((PetscObject)mat,&tag_vals));
7715   PetscCall(PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is));
7716   PetscCall(PetscObjectGetNewTag((PetscObject)mat,&tag_vecs));
7717 
7718   /* allocate for requests */
7719   PetscCall(PetscMalloc1(n_sends,&send_req_idxs));
7720   PetscCall(PetscMalloc1(n_sends,&send_req_vals));
7721   PetscCall(PetscMalloc1(n_sends,&send_req_idxs_is));
7722   PetscCall(PetscMalloc1(n_sends,&send_req_vecs));
7723   PetscCall(PetscMalloc1(n_recvs,&recv_req_idxs));
7724   PetscCall(PetscMalloc1(n_recvs,&recv_req_vals));
7725   PetscCall(PetscMalloc1(n_recvs,&recv_req_idxs_is));
7726   PetscCall(PetscMalloc1(n_recvs,&recv_req_vecs));
7727 
7728   /* communications */
7729   ptr_idxs = recv_buffer_idxs;
7730   ptr_vals = recv_buffer_vals;
7731   ptr_idxs_is = recv_buffer_idxs_is;
7732   ptr_vecs = recv_buffer_vecs;
7733   for (i=0;i<n_recvs;i++) {
7734     source_dest = onodes[i];
7735     PetscCallMPI(MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]));
7736     PetscCallMPI(MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]));
7737     ptr_idxs += olengths_idxs[i];
7738     ptr_vals += olengths_vals[i];
7739     if (nis) {
7740       source_dest = onodes_is[i];
7741       PetscCallMPI(MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]));
7742       ptr_idxs_is += olengths_idxs_is[i];
7743     }
7744     if (nvecs) {
7745       source_dest = onodes[i];
7746       PetscCallMPI(MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]));
7747       ptr_vecs += olengths_idxs[i]-2;
7748     }
7749   }
7750   for (i=0;i<n_sends;i++) {
7751     PetscCall(PetscMPIIntCast(is_indices[i],&source_dest));
7752     PetscCallMPI(MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]));
7753     PetscCallMPI(MPI_Isend((PetscScalar*)send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]));
7754     if (nis) {
7755       PetscCallMPI(MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]));
7756     }
7757     if (nvecs) {
7758       PetscCall(VecGetArray(nnsp_vec[0],&send_buffer_vecs));
7759       PetscCallMPI(MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]));
7760     }
7761   }
7762   PetscCall(ISRestoreIndices(is_sends_internal,&is_indices));
7763   PetscCall(ISDestroy(&is_sends_internal));
7764 
7765   /* assemble new l2g map */
7766   PetscCallMPI(MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE));
7767   ptr_idxs = recv_buffer_idxs;
7768   new_local_rows = 0;
7769   for (i=0;i<n_recvs;i++) {
7770     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7771     ptr_idxs += olengths_idxs[i];
7772   }
7773   PetscCall(PetscMalloc1(new_local_rows,&l2gmap_indices));
7774   ptr_idxs = recv_buffer_idxs;
7775   new_local_rows = 0;
7776   for (i=0;i<n_recvs;i++) {
7777     PetscCall(PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1)));
7778     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7779     ptr_idxs += olengths_idxs[i];
7780   }
7781   PetscCall(PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices));
7782   PetscCall(ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap));
7783   PetscCall(PetscFree(l2gmap_indices));
7784 
7785   /* infer new local matrix type from received local matrices type */
7786   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7787   /* it also assumes that if the block size is set, than it is the same among all local matrices (see checks at the beginning of the function) */
7788   if (n_recvs) {
7789     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7790     ptr_idxs = recv_buffer_idxs;
7791     for (i=0;i<n_recvs;i++) {
7792       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7793         new_local_type_private = MATAIJ_PRIVATE;
7794         break;
7795       }
7796       ptr_idxs += olengths_idxs[i];
7797     }
7798     switch (new_local_type_private) {
7799       case MATDENSE_PRIVATE:
7800         new_local_type = MATSEQAIJ;
7801         bs = 1;
7802         break;
7803       case MATAIJ_PRIVATE:
7804         new_local_type = MATSEQAIJ;
7805         bs = 1;
7806         break;
7807       case MATBAIJ_PRIVATE:
7808         new_local_type = MATSEQBAIJ;
7809         break;
7810       case MATSBAIJ_PRIVATE:
7811         new_local_type = MATSEQSBAIJ;
7812         break;
7813       default:
7814         SETERRQ(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7815     }
7816   } else { /* by default, new_local_type is seqaij */
7817     new_local_type = MATSEQAIJ;
7818     bs = 1;
7819   }
7820 
7821   /* create MATIS object if needed */
7822   if (!reuse) {
7823     PetscCall(MatGetSize(mat,&rows,&cols));
7824     PetscCall(MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,l2gmap,mat_n));
7825   } else {
7826     /* it also destroys the local matrices */
7827     if (*mat_n) {
7828       PetscCall(MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap));
7829     } else { /* this is a fake object */
7830       PetscCall(MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,l2gmap,mat_n));
7831     }
7832   }
7833   PetscCall(MatISGetLocalMat(*mat_n,&local_mat));
7834   PetscCall(MatSetType(local_mat,new_local_type));
7835 
7836   PetscCallMPI(MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE));
7837 
7838   /* Global to local map of received indices */
7839   PetscCall(PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local)); /* needed for values insertion */
7840   PetscCall(ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local));
7841   PetscCall(ISLocalToGlobalMappingDestroy(&l2gmap));
7842 
7843   /* restore attributes -> type of incoming data and its size */
7844   buf_size_idxs = 0;
7845   for (i=0;i<n_recvs;i++) {
7846     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7847     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7848     buf_size_idxs += (PetscInt)olengths_idxs[i];
7849   }
7850   PetscCall(PetscFree(recv_buffer_idxs));
7851 
7852   /* set preallocation */
7853   PetscCall(PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense));
7854   if (!newisdense) {
7855     PetscInt *new_local_nnz=NULL;
7856 
7857     ptr_idxs = recv_buffer_idxs_local;
7858     if (n_recvs) {
7859       PetscCall(PetscCalloc1(new_local_rows,&new_local_nnz));
7860     }
7861     for (i=0;i<n_recvs;i++) {
7862       PetscInt j;
7863       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7864         for (j=0;j<*(ptr_idxs+1);j++) {
7865           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7866         }
7867       } else {
7868         /* TODO */
7869       }
7870       ptr_idxs += olengths_idxs[i];
7871     }
7872     if (new_local_nnz) {
7873       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7874       PetscCall(MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz));
7875       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7876       PetscCall(MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz));
7877       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7878       PetscCall(MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz));
7879     } else {
7880       PetscCall(MatSetUp(local_mat));
7881     }
7882     PetscCall(PetscFree(new_local_nnz));
7883   } else {
7884     PetscCall(MatSetUp(local_mat));
7885   }
7886 
7887   /* set values */
7888   ptr_vals = recv_buffer_vals;
7889   ptr_idxs = recv_buffer_idxs_local;
7890   for (i=0;i<n_recvs;i++) {
7891     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7892       PetscCall(MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE));
7893       PetscCall(MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES));
7894       PetscCall(MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY));
7895       PetscCall(MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY));
7896       PetscCall(MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE));
7897     } else {
7898       /* TODO */
7899     }
7900     ptr_idxs += olengths_idxs[i];
7901     ptr_vals += olengths_vals[i];
7902   }
7903   PetscCall(MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY));
7904   PetscCall(MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY));
7905   PetscCall(MatISRestoreLocalMat(*mat_n,&local_mat));
7906   PetscCall(MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY));
7907   PetscCall(MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY));
7908   PetscCall(PetscFree(recv_buffer_vals));
7909 
7910 #if 0
7911   if (!restrict_comm) { /* check */
7912     Vec       lvec,rvec;
7913     PetscReal infty_error;
7914 
7915     PetscCall(MatCreateVecs(mat,&rvec,&lvec));
7916     PetscCall(VecSetRandom(rvec,NULL));
7917     PetscCall(MatMult(mat,rvec,lvec));
7918     PetscCall(VecScale(lvec,-1.0));
7919     PetscCall(MatMultAdd(*mat_n,rvec,lvec,lvec));
7920     PetscCall(VecNorm(lvec,NORM_INFINITY,&infty_error));
7921     PetscCall(PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error));
7922     PetscCall(VecDestroy(&rvec));
7923     PetscCall(VecDestroy(&lvec));
7924   }
7925 #endif
7926 
7927   /* assemble new additional is (if any) */
7928   if (nis) {
7929     PetscInt **temp_idxs,*count_is,j,psum;
7930 
7931     PetscCallMPI(MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE));
7932     PetscCall(PetscCalloc1(nis,&count_is));
7933     ptr_idxs = recv_buffer_idxs_is;
7934     psum = 0;
7935     for (i=0;i<n_recvs;i++) {
7936       for (j=0;j<nis;j++) {
7937         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7938         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7939         psum += plen;
7940         ptr_idxs += plen+1; /* shift pointer to received data */
7941       }
7942     }
7943     PetscCall(PetscMalloc1(nis,&temp_idxs));
7944     PetscCall(PetscMalloc1(psum,&temp_idxs[0]));
7945     for (i=1;i<nis;i++) {
7946       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7947     }
7948     PetscCall(PetscArrayzero(count_is,nis));
7949     ptr_idxs = recv_buffer_idxs_is;
7950     for (i=0;i<n_recvs;i++) {
7951       for (j=0;j<nis;j++) {
7952         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7953         PetscCall(PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen));
7954         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7955         ptr_idxs += plen+1; /* shift pointer to received data */
7956       }
7957     }
7958     for (i=0;i<nis;i++) {
7959       PetscCall(ISDestroy(&isarray[i]));
7960       PetscCall(PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]));
7961       PetscCall(ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]));
7962     }
7963     PetscCall(PetscFree(count_is));
7964     PetscCall(PetscFree(temp_idxs[0]));
7965     PetscCall(PetscFree(temp_idxs));
7966   }
7967   /* free workspace */
7968   PetscCall(PetscFree(recv_buffer_idxs_is));
7969   PetscCallMPI(MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE));
7970   PetscCall(PetscFree(send_buffer_idxs));
7971   PetscCallMPI(MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE));
7972   if (isdense) {
7973     PetscCall(MatISGetLocalMat(mat,&local_mat));
7974     PetscCall(MatDenseRestoreArrayRead(local_mat,&send_buffer_vals));
7975     PetscCall(MatISRestoreLocalMat(mat,&local_mat));
7976   } else {
7977     /* PetscCall(PetscFree(send_buffer_vals)); */
7978   }
7979   if (nis) {
7980     PetscCallMPI(MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE));
7981     PetscCall(PetscFree(send_buffer_idxs_is));
7982   }
7983 
7984   if (nvecs) {
7985     PetscCallMPI(MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE));
7986     PetscCallMPI(MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE));
7987     PetscCall(VecRestoreArray(nnsp_vec[0],&send_buffer_vecs));
7988     PetscCall(VecDestroy(&nnsp_vec[0]));
7989     PetscCall(VecCreate(comm_n,&nnsp_vec[0]));
7990     PetscCall(VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE));
7991     PetscCall(VecSetType(nnsp_vec[0],VECSTANDARD));
7992     /* set values */
7993     ptr_vals = recv_buffer_vecs;
7994     ptr_idxs = recv_buffer_idxs_local;
7995     PetscCall(VecGetArray(nnsp_vec[0],&send_buffer_vecs));
7996     for (i=0;i<n_recvs;i++) {
7997       PetscInt j;
7998       for (j=0;j<*(ptr_idxs+1);j++) {
7999         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
8000       }
8001       ptr_idxs += olengths_idxs[i];
8002       ptr_vals += olengths_idxs[i]-2;
8003     }
8004     PetscCall(VecRestoreArray(nnsp_vec[0],&send_buffer_vecs));
8005     PetscCall(VecAssemblyBegin(nnsp_vec[0]));
8006     PetscCall(VecAssemblyEnd(nnsp_vec[0]));
8007   }
8008 
8009   PetscCall(PetscFree(recv_buffer_vecs));
8010   PetscCall(PetscFree(recv_buffer_idxs_local));
8011   PetscCall(PetscFree(recv_req_idxs));
8012   PetscCall(PetscFree(recv_req_vals));
8013   PetscCall(PetscFree(recv_req_vecs));
8014   PetscCall(PetscFree(recv_req_idxs_is));
8015   PetscCall(PetscFree(send_req_idxs));
8016   PetscCall(PetscFree(send_req_vals));
8017   PetscCall(PetscFree(send_req_vecs));
8018   PetscCall(PetscFree(send_req_idxs_is));
8019   PetscCall(PetscFree(ilengths_vals));
8020   PetscCall(PetscFree(ilengths_idxs));
8021   PetscCall(PetscFree(olengths_vals));
8022   PetscCall(PetscFree(olengths_idxs));
8023   PetscCall(PetscFree(onodes));
8024   if (nis) {
8025     PetscCall(PetscFree(ilengths_idxs_is));
8026     PetscCall(PetscFree(olengths_idxs_is));
8027     PetscCall(PetscFree(onodes_is));
8028   }
8029   PetscCall(PetscSubcommDestroy(&subcomm));
8030   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not participate */
8031     PetscCall(MatDestroy(mat_n));
8032     for (i=0;i<nis;i++) {
8033       PetscCall(ISDestroy(&isarray[i]));
8034     }
8035     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
8036       PetscCall(VecDestroy(&nnsp_vec[0]));
8037     }
8038     *mat_n = NULL;
8039   }
8040   PetscFunctionReturn(0);
8041 }
8042 
8043 /* temporary hack into ksp private data structure */
8044 #include <petsc/private/kspimpl.h>
8045 
8046 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8047 {
8048   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8049   PC_IS                  *pcis = (PC_IS*)pc->data;
8050   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8051   Mat                    coarsedivudotp = NULL;
8052   Mat                    coarseG,t_coarse_mat_is;
8053   MatNullSpace           CoarseNullSpace = NULL;
8054   ISLocalToGlobalMapping coarse_islg;
8055   IS                     coarse_is,*isarray,corners;
8056   PetscInt               i,im_active=-1,active_procs=-1;
8057   PetscInt               nis,nisdofs,nisneu,nisvert;
8058   PetscInt               coarse_eqs_per_proc;
8059   PC                     pc_temp;
8060   PCType                 coarse_pc_type;
8061   KSPType                coarse_ksp_type;
8062   PetscBool              multilevel_requested,multilevel_allowed;
8063   PetscBool              coarse_reuse;
8064   PetscInt               ncoarse,nedcfield;
8065   PetscBool              compute_vecs = PETSC_FALSE;
8066   PetscScalar            *array;
8067   MatReuse               coarse_mat_reuse;
8068   PetscBool              restr, full_restr, have_void;
8069   PetscMPIInt            size;
8070 
8071   PetscFunctionBegin;
8072   PetscCall(PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0));
8073   /* Assign global numbering to coarse dofs */
8074   if (pcbddc->new_primal_space || pcbddc->coarse_size == -1) { /* a new primal space is present or it is the first initialization, so recompute global numbering */
8075     PetscInt ocoarse_size;
8076     compute_vecs = PETSC_TRUE;
8077 
8078     pcbddc->new_primal_space = PETSC_TRUE;
8079     ocoarse_size = pcbddc->coarse_size;
8080     PetscCall(PetscFree(pcbddc->global_primal_indices));
8081     PetscCall(PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices));
8082     /* see if we can avoid some work */
8083     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8084       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8085       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8086         PetscCall(KSPReset(pcbddc->coarse_ksp));
8087         coarse_reuse = PETSC_FALSE;
8088       } else { /* we can safely reuse already computed coarse matrix */
8089         coarse_reuse = PETSC_TRUE;
8090       }
8091     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8092       coarse_reuse = PETSC_FALSE;
8093     }
8094     /* reset any subassembling information */
8095     if (!coarse_reuse || pcbddc->recompute_topography) {
8096       PetscCall(ISDestroy(&pcbddc->coarse_subassembling));
8097     }
8098   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8099     coarse_reuse = PETSC_TRUE;
8100   }
8101   if (coarse_reuse && pcbddc->coarse_ksp) {
8102     PetscCall(KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL));
8103     PetscCall(PetscObjectReference((PetscObject)coarse_mat));
8104     coarse_mat_reuse = MAT_REUSE_MATRIX;
8105   } else {
8106     coarse_mat = NULL;
8107     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8108   }
8109 
8110   /* creates temporary l2gmap and IS for coarse indexes */
8111   PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is));
8112   PetscCall(ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg));
8113 
8114   /* creates temporary MATIS object for coarse matrix */
8115   PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense));
8116   PetscCall(MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,coarse_islg,&t_coarse_mat_is));
8117   PetscCall(MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense));
8118   PetscCall(MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY));
8119   PetscCall(MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY));
8120   PetscCall(MatDestroy(&coarse_submat_dense));
8121 
8122   /* count "active" (i.e. with positive local size) and "void" processes */
8123   im_active = !!(pcis->n);
8124   PetscCall(MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc)));
8125 
8126   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8127   /* restr : whether we want to exclude senders (which are not receivers) from the subassembling pattern */
8128   /* full_restr : just use the receivers from the subassembling pattern */
8129   PetscCallMPI(MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size));
8130   coarse_mat_is        = NULL;
8131   multilevel_allowed   = PETSC_FALSE;
8132   multilevel_requested = PETSC_FALSE;
8133   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8134   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8135   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8136   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8137   if (multilevel_requested) {
8138     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8139     restr      = PETSC_FALSE;
8140     full_restr = PETSC_FALSE;
8141   } else {
8142     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8143     restr      = PETSC_TRUE;
8144     full_restr = PETSC_TRUE;
8145   }
8146   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8147   ncoarse = PetscMax(1,ncoarse);
8148   if (!pcbddc->coarse_subassembling) {
8149     if (pcbddc->coarsening_ratio > 1) {
8150       if (multilevel_requested) {
8151         PetscCall(PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void));
8152       } else {
8153         PetscCall(PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void));
8154       }
8155     } else {
8156       PetscMPIInt rank;
8157 
8158       PetscCallMPI(MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank));
8159       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8160       PetscCall(ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling));
8161     }
8162   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8163     PetscInt    psum;
8164     if (pcbddc->coarse_ksp) psum = 1;
8165     else psum = 0;
8166     PetscCall(MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc)));
8167     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8168   }
8169   /* determine if we can go multilevel */
8170   if (multilevel_requested) {
8171     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8172     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8173   }
8174   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8175 
8176   /* dump subassembling pattern */
8177   if (pcbddc->dbg_flag && multilevel_allowed) {
8178     PetscCall(ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer));
8179   }
8180   /* compute dofs splitting and neumann boundaries for coarse dofs */
8181   nedcfield = -1;
8182   corners = NULL;
8183   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8184     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8185     const PetscInt         *idxs;
8186     ISLocalToGlobalMapping tmap;
8187 
8188     /* create map between primal indices (in local representative ordering) and local primal numbering */
8189     PetscCall(ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap));
8190     /* allocate space for temporary storage */
8191     PetscCall(PetscMalloc1(pcbddc->local_primal_size,&tidxs));
8192     PetscCall(PetscMalloc1(pcbddc->local_primal_size,&tidxs2));
8193     /* allocate for IS array */
8194     nisdofs = pcbddc->n_ISForDofsLocal;
8195     if (pcbddc->nedclocal) {
8196       if (pcbddc->nedfield > -1) {
8197         nedcfield = pcbddc->nedfield;
8198       } else {
8199         nedcfield = 0;
8200         PetscCheck(!nisdofs,PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%" PetscInt_FMT ")",nisdofs);
8201         nisdofs = 1;
8202       }
8203     }
8204     nisneu = !!pcbddc->NeumannBoundariesLocal;
8205     nisvert = 0; /* nisvert is not used */
8206     nis = nisdofs + nisneu + nisvert;
8207     PetscCall(PetscMalloc1(nis,&isarray));
8208     /* dofs splitting */
8209     for (i=0;i<nisdofs;i++) {
8210       /* PetscCall(ISView(pcbddc->ISForDofsLocal[i],0)); */
8211       if (nedcfield != i) {
8212         PetscCall(ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize));
8213         PetscCall(ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs));
8214         PetscCall(ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs));
8215         PetscCall(ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs));
8216       } else {
8217         PetscCall(ISGetLocalSize(pcbddc->nedclocal,&tsize));
8218         PetscCall(ISGetIndices(pcbddc->nedclocal,&idxs));
8219         PetscCall(ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs));
8220         PetscCheck(tsize == nout,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %" PetscInt_FMT " != %" PetscInt_FMT,tsize,nout);
8221         PetscCall(ISRestoreIndices(pcbddc->nedclocal,&idxs));
8222       }
8223       PetscCall(ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2));
8224       PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]));
8225       /* PetscCall(ISView(isarray[i],0)); */
8226     }
8227     /* neumann boundaries */
8228     if (pcbddc->NeumannBoundariesLocal) {
8229       /* PetscCall(ISView(pcbddc->NeumannBoundariesLocal,0)); */
8230       PetscCall(ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize));
8231       PetscCall(ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs));
8232       PetscCall(ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs));
8233       PetscCall(ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs));
8234       PetscCall(ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2));
8235       PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]));
8236       /* PetscCall(ISView(isarray[nisdofs],0)); */
8237     }
8238     /* coordinates */
8239     if (pcbddc->corner_selected) {
8240       PetscCall(PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners));
8241       PetscCall(ISGetLocalSize(corners,&tsize));
8242       PetscCall(ISGetIndices(corners,&idxs));
8243       PetscCall(ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs));
8244       PetscCheck(tsize == nout,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %" PetscInt_FMT " != %" PetscInt_FMT,tsize,nout);
8245       PetscCall(ISRestoreIndices(corners,&idxs));
8246       PetscCall(PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners));
8247       PetscCall(ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2));
8248       PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners));
8249     }
8250     PetscCall(PetscFree(tidxs));
8251     PetscCall(PetscFree(tidxs2));
8252     PetscCall(ISLocalToGlobalMappingDestroy(&tmap));
8253   } else {
8254     nis = 0;
8255     nisdofs = 0;
8256     nisneu = 0;
8257     nisvert = 0;
8258     isarray = NULL;
8259   }
8260   /* destroy no longer needed map */
8261   PetscCall(ISLocalToGlobalMappingDestroy(&coarse_islg));
8262 
8263   /* subassemble */
8264   if (multilevel_allowed) {
8265     Vec       vp[1];
8266     PetscInt  nvecs = 0;
8267     PetscBool reuse,reuser;
8268 
8269     if (coarse_mat) reuse = PETSC_TRUE;
8270     else reuse = PETSC_FALSE;
8271     PetscCall(MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc)));
8272     vp[0] = NULL;
8273     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8274       PetscCall(VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]));
8275       PetscCall(VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE));
8276       PetscCall(VecSetType(vp[0],VECSTANDARD));
8277       nvecs = 1;
8278 
8279       if (pcbddc->divudotp) {
8280         Mat      B,loc_divudotp;
8281         Vec      v,p;
8282         IS       dummy;
8283         PetscInt np;
8284 
8285         PetscCall(MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp));
8286         PetscCall(MatGetSize(loc_divudotp,&np,NULL));
8287         PetscCall(ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy));
8288         PetscCall(MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B));
8289         PetscCall(MatCreateVecs(B,&v,&p));
8290         PetscCall(VecSet(p,1.));
8291         PetscCall(MatMultTranspose(B,p,v));
8292         PetscCall(VecDestroy(&p));
8293         PetscCall(MatDestroy(&B));
8294         PetscCall(VecGetArray(vp[0],&array));
8295         PetscCall(VecPlaceArray(pcbddc->vec1_P,array));
8296         PetscCall(MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P));
8297         PetscCall(VecResetArray(pcbddc->vec1_P));
8298         PetscCall(VecRestoreArray(vp[0],&array));
8299         PetscCall(ISDestroy(&dummy));
8300         PetscCall(VecDestroy(&v));
8301       }
8302     }
8303     if (reuser) {
8304       PetscCall(PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp));
8305     } else {
8306       PetscCall(PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp));
8307     }
8308     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8309       PetscScalar       *arraym;
8310       const PetscScalar *arrayv;
8311       PetscInt          nl;
8312       PetscCall(VecGetLocalSize(vp[0],&nl));
8313       PetscCall(MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp));
8314       PetscCall(MatDenseGetArray(coarsedivudotp,&arraym));
8315       PetscCall(VecGetArrayRead(vp[0],&arrayv));
8316       PetscCall(PetscArraycpy(arraym,arrayv,nl));
8317       PetscCall(VecRestoreArrayRead(vp[0],&arrayv));
8318       PetscCall(MatDenseRestoreArray(coarsedivudotp,&arraym));
8319       PetscCall(VecDestroy(&vp[0]));
8320     } else {
8321       PetscCall(MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp));
8322     }
8323   } else {
8324     PetscCall(PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL));
8325   }
8326   if (coarse_mat_is || coarse_mat) {
8327     if (!multilevel_allowed) {
8328       PetscCall(MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat));
8329     } else {
8330       /* if this matrix is present, it means we are not reusing the coarse matrix */
8331       if (coarse_mat_is) {
8332         PetscCheck(!coarse_mat,PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8333         PetscCall(PetscObjectReference((PetscObject)coarse_mat_is));
8334         coarse_mat = coarse_mat_is;
8335       }
8336     }
8337   }
8338   PetscCall(MatDestroy(&t_coarse_mat_is));
8339   PetscCall(MatDestroy(&coarse_mat_is));
8340 
8341   /* create local to global scatters for coarse problem */
8342   if (compute_vecs) {
8343     PetscInt lrows;
8344     PetscCall(VecDestroy(&pcbddc->coarse_vec));
8345     if (coarse_mat) {
8346       PetscCall(MatGetLocalSize(coarse_mat,&lrows,NULL));
8347     } else {
8348       lrows = 0;
8349     }
8350     PetscCall(VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec));
8351     PetscCall(VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE));
8352     PetscCall(VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD));
8353     PetscCall(VecScatterDestroy(&pcbddc->coarse_loc_to_glob));
8354     PetscCall(VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob));
8355   }
8356   PetscCall(ISDestroy(&coarse_is));
8357 
8358   /* set defaults for coarse KSP and PC */
8359   if (multilevel_allowed) {
8360     coarse_ksp_type = KSPRICHARDSON;
8361     coarse_pc_type  = PCBDDC;
8362   } else {
8363     coarse_ksp_type = KSPPREONLY;
8364     coarse_pc_type  = PCREDUNDANT;
8365   }
8366 
8367   /* print some info if requested */
8368   if (pcbddc->dbg_flag) {
8369     if (!multilevel_allowed) {
8370       PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n"));
8371       if (multilevel_requested) {
8372         PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Not enough active processes on level %" PetscInt_FMT " (active processes %" PetscInt_FMT ", coarsening ratio %" PetscInt_FMT ")\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio));
8373       } else if (pcbddc->max_levels) {
8374         PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%" PetscInt_FMT ")\n",pcbddc->max_levels));
8375       }
8376       PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
8377     }
8378   }
8379 
8380   /* communicate coarse discrete gradient */
8381   coarseG = NULL;
8382   if (pcbddc->nedcG && multilevel_allowed) {
8383     MPI_Comm ccomm;
8384     if (coarse_mat) {
8385       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8386     } else {
8387       ccomm = MPI_COMM_NULL;
8388     }
8389     PetscCall(MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG));
8390   }
8391 
8392   /* create the coarse KSP object only once with defaults */
8393   if (coarse_mat) {
8394     PetscBool   isredundant,isbddc,force,valid;
8395     PetscViewer dbg_viewer = NULL;
8396     PetscBool   isset,issym,isher,isspd;
8397 
8398     if (pcbddc->dbg_flag) {
8399       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8400       PetscCall(PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level));
8401     }
8402     if (!pcbddc->coarse_ksp) {
8403       char      prefix[256],str_level[16];
8404       size_t    len;
8405 
8406       PetscCall(KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp));
8407       PetscCall(KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure));
8408       PetscCall(PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1));
8409       PetscCall(KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1));
8410       PetscCall(KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat));
8411       PetscCall(KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type));
8412       PetscCall(KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE));
8413       PetscCall(KSPGetPC(pcbddc->coarse_ksp,&pc_temp));
8414       /* TODO is this logic correct? should check for coarse_mat type */
8415       PetscCall(PCSetType(pc_temp,coarse_pc_type));
8416       /* prefix */
8417       PetscCall(PetscStrcpy(prefix,""));
8418       PetscCall(PetscStrcpy(str_level,""));
8419       if (!pcbddc->current_level) {
8420         PetscCall(PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix)));
8421         PetscCall(PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix)));
8422       } else {
8423         PetscCall(PetscStrlen(((PetscObject)pc)->prefix,&len));
8424         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8425         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8426         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8427         PetscCall(PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1));
8428         PetscCall(PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level)));
8429         PetscCall(PetscStrlcat(prefix,str_level,sizeof(prefix)));
8430       }
8431       PetscCall(KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix));
8432       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8433       PetscCall(PCBDDCSetLevel(pc_temp,pcbddc->current_level+1));
8434       PetscCall(PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio));
8435       PetscCall(PCBDDCSetLevels(pc_temp,pcbddc->max_levels));
8436       /* allow user customization */
8437       PetscCall(KSPSetFromOptions(pcbddc->coarse_ksp));
8438       /* get some info after set from options */
8439       PetscCall(KSPGetPC(pcbddc->coarse_ksp,&pc_temp));
8440       /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8441       force = PETSC_FALSE;
8442       PetscCall(PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL));
8443       PetscCall(PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,""));
8444       PetscCall(PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc));
8445       if (multilevel_allowed && !force && !valid) {
8446         isbddc = PETSC_TRUE;
8447         PetscCall(PCSetType(pc_temp,PCBDDC));
8448         PetscCall(PCBDDCSetLevel(pc_temp,pcbddc->current_level+1));
8449         PetscCall(PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio));
8450         PetscCall(PCBDDCSetLevels(pc_temp,pcbddc->max_levels));
8451         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8452           PetscObjectOptionsBegin((PetscObject)pc_temp);
8453           PetscCall((*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp));
8454           PetscCall(PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp));
8455           PetscOptionsEnd();
8456           pc_temp->setfromoptionscalled++;
8457         }
8458       }
8459     }
8460     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8461     PetscCall(KSPGetPC(pcbddc->coarse_ksp,&pc_temp));
8462     if (nisdofs) {
8463       PetscCall(PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray));
8464       for (i=0;i<nisdofs;i++) {
8465         PetscCall(ISDestroy(&isarray[i]));
8466       }
8467     }
8468     if (nisneu) {
8469       PetscCall(PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]));
8470       PetscCall(ISDestroy(&isarray[nisdofs]));
8471     }
8472     if (nisvert) {
8473       PetscCall(PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]));
8474       PetscCall(ISDestroy(&isarray[nis-1]));
8475     }
8476     if (coarseG) PetscCall(PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE));
8477 
8478     /* get some info after set from options */
8479     PetscCall(PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc));
8480 
8481     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8482     if (isbddc && !multilevel_allowed) {
8483       PetscCall(PCSetType(pc_temp,coarse_pc_type));
8484     }
8485     /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8486     force = PETSC_FALSE;
8487     PetscCall(PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL));
8488     PetscCall(PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,""));
8489     if (multilevel_requested && multilevel_allowed && !valid && !force) {
8490       PetscCall(PCSetType(pc_temp,PCBDDC));
8491     }
8492     PetscCall(PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant));
8493     if (isredundant) {
8494       KSP inner_ksp;
8495       PC  inner_pc;
8496 
8497       PetscCall(PCRedundantGetKSP(pc_temp,&inner_ksp));
8498       PetscCall(KSPGetPC(inner_ksp,&inner_pc));
8499     }
8500 
8501     /* parameters which miss an API */
8502     PetscCall(PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc));
8503     if (isbddc) {
8504       PC_BDDC*  pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8505 
8506       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8507       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8508       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8509       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8510       if (pcbddc_coarse->benign_saddle_point) {
8511         Mat                    coarsedivudotp_is;
8512         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8513         IS                     row,col;
8514         const PetscInt         *gidxs;
8515         PetscInt               n,st,M,N;
8516 
8517         PetscCall(MatGetSize(coarsedivudotp,&n,NULL));
8518         PetscCallMPI(MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat)));
8519         st   = st-n;
8520         PetscCall(ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row));
8521         PetscCall(MatISGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL));
8522         PetscCall(ISLocalToGlobalMappingGetSize(l2gmap,&n));
8523         PetscCall(ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs));
8524         PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col));
8525         PetscCall(ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs));
8526         PetscCall(ISLocalToGlobalMappingCreateIS(row,&rl2g));
8527         PetscCall(ISLocalToGlobalMappingCreateIS(col,&cl2g));
8528         PetscCall(ISGetSize(row,&M));
8529         PetscCall(MatGetSize(coarse_mat,&N,NULL));
8530         PetscCall(ISDestroy(&row));
8531         PetscCall(ISDestroy(&col));
8532         PetscCall(MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is));
8533         PetscCall(MatSetType(coarsedivudotp_is,MATIS));
8534         PetscCall(MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N));
8535         PetscCall(MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g));
8536         PetscCall(ISLocalToGlobalMappingDestroy(&rl2g));
8537         PetscCall(ISLocalToGlobalMappingDestroy(&cl2g));
8538         PetscCall(MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp));
8539         PetscCall(MatDestroy(&coarsedivudotp));
8540         PetscCall(PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL));
8541         PetscCall(MatDestroy(&coarsedivudotp_is));
8542         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8543         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8544       }
8545     }
8546 
8547     /* propagate symmetry info of coarse matrix */
8548     PetscCall(MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE));
8549     PetscCall(MatIsSymmetricKnown(pc->pmat,&isset,&issym));
8550     if (isset) PetscCall(MatSetOption(coarse_mat,MAT_SYMMETRIC,issym));
8551     PetscCall(MatIsHermitianKnown(pc->pmat,&isset,&isher));
8552     if (isset) PetscCall(MatSetOption(coarse_mat,MAT_HERMITIAN,isher));
8553     PetscCall(MatIsSPDKnown(pc->pmat,&isset,&isspd));
8554     if (isset) PetscCall(MatSetOption(coarse_mat,MAT_SPD,isspd));
8555 
8556     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8557       PetscCall(MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE));
8558     }
8559     /* set operators */
8560     PetscCall(MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view"));
8561     PetscCall(MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix));
8562     PetscCall(KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat));
8563     if (pcbddc->dbg_flag) PetscCall(PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level));
8564   }
8565   PetscCall(MatDestroy(&coarseG));
8566   PetscCall(PetscFree(isarray));
8567 #if 0
8568   {
8569     PetscViewer viewer;
8570     char filename[256];
8571     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8572     PetscCall(PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer));
8573     PetscCall(PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB));
8574     PetscCall(MatView(coarse_mat,viewer));
8575     PetscCall(PetscViewerPopFormat(viewer));
8576     PetscCall(PetscViewerDestroy(&viewer));
8577   }
8578 #endif
8579 
8580   if (corners) {
8581     Vec            gv;
8582     IS             is;
8583     const PetscInt *idxs;
8584     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8585     PetscScalar    *coords;
8586 
8587     PetscCheck(pcbddc->mat_graph->cloc,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8588     PetscCall(VecGetSize(pcbddc->coarse_vec,&N));
8589     PetscCall(VecGetLocalSize(pcbddc->coarse_vec,&n));
8590     PetscCall(VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv));
8591     PetscCall(VecSetBlockSize(gv,cdim));
8592     PetscCall(VecSetSizes(gv,n*cdim,N*cdim));
8593     PetscCall(VecSetType(gv,VECSTANDARD));
8594     PetscCall(VecSetFromOptions(gv));
8595     PetscCall(VecSet(gv,PETSC_MAX_REAL)); /* we only propagate coordinates from vertices constraints */
8596 
8597     PetscCall(PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is));
8598     PetscCall(ISGetLocalSize(is,&n));
8599     PetscCall(ISGetIndices(is,&idxs));
8600     PetscCall(PetscMalloc1(n*cdim,&coords));
8601     for (i=0;i<n;i++) {
8602       for (d=0;d<cdim;d++) {
8603         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8604       }
8605     }
8606     PetscCall(ISRestoreIndices(is,&idxs));
8607     PetscCall(PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is));
8608 
8609     PetscCall(ISGetLocalSize(corners,&n));
8610     PetscCall(ISGetIndices(corners,&idxs));
8611     PetscCall(VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES));
8612     PetscCall(ISRestoreIndices(corners,&idxs));
8613     PetscCall(PetscFree(coords));
8614     PetscCall(VecAssemblyBegin(gv));
8615     PetscCall(VecAssemblyEnd(gv));
8616     PetscCall(VecGetArray(gv,&coords));
8617     if (pcbddc->coarse_ksp) {
8618       PC        coarse_pc;
8619       PetscBool isbddc;
8620 
8621       PetscCall(KSPGetPC(pcbddc->coarse_ksp,&coarse_pc));
8622       PetscCall(PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc));
8623       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8624         PetscReal *realcoords;
8625 
8626         PetscCall(VecGetLocalSize(gv,&n));
8627 #if defined(PETSC_USE_COMPLEX)
8628         PetscCall(PetscMalloc1(n,&realcoords));
8629         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8630 #else
8631         realcoords = coords;
8632 #endif
8633         PetscCall(PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords));
8634 #if defined(PETSC_USE_COMPLEX)
8635         PetscCall(PetscFree(realcoords));
8636 #endif
8637       }
8638     }
8639     PetscCall(VecRestoreArray(gv,&coords));
8640     PetscCall(VecDestroy(&gv));
8641   }
8642   PetscCall(ISDestroy(&corners));
8643 
8644   if (pcbddc->coarse_ksp) {
8645     Vec crhs,csol;
8646 
8647     PetscCall(KSPGetSolution(pcbddc->coarse_ksp,&csol));
8648     PetscCall(KSPGetRhs(pcbddc->coarse_ksp,&crhs));
8649     if (!csol) {
8650       PetscCall(MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL));
8651     }
8652     if (!crhs) {
8653       PetscCall(MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs)));
8654     }
8655   }
8656   PetscCall(MatDestroy(&coarsedivudotp));
8657 
8658   /* compute null space for coarse solver if the benign trick has been requested */
8659   if (pcbddc->benign_null) {
8660 
8661     PetscCall(VecSet(pcbddc->vec1_P,0.));
8662     for (i=0;i<pcbddc->benign_n;i++) {
8663       PetscCall(VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES));
8664     }
8665     PetscCall(VecAssemblyBegin(pcbddc->vec1_P));
8666     PetscCall(VecAssemblyEnd(pcbddc->vec1_P));
8667     PetscCall(VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD));
8668     PetscCall(VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD));
8669     if (coarse_mat) {
8670       Vec         nullv;
8671       PetscScalar *array,*array2;
8672       PetscInt    nl;
8673 
8674       PetscCall(MatCreateVecs(coarse_mat,&nullv,NULL));
8675       PetscCall(VecGetLocalSize(nullv,&nl));
8676       PetscCall(VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array));
8677       PetscCall(VecGetArray(nullv,&array2));
8678       PetscCall(PetscArraycpy(array2,array,nl));
8679       PetscCall(VecRestoreArray(nullv,&array2));
8680       PetscCall(VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array));
8681       PetscCall(VecNormalize(nullv,NULL));
8682       PetscCall(MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace));
8683       PetscCall(VecDestroy(&nullv));
8684     }
8685   }
8686   PetscCall(PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0));
8687 
8688   PetscCall(PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0));
8689   if (pcbddc->coarse_ksp) {
8690     PetscBool ispreonly;
8691 
8692     if (CoarseNullSpace) {
8693       PetscBool isnull;
8694 
8695       PetscCall(MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull));
8696       if (isnull) PetscCall(MatSetNullSpace(coarse_mat,CoarseNullSpace));
8697       /* TODO: add local nullspaces (if any) */
8698     }
8699     /* setup coarse ksp */
8700     PetscCall(KSPSetUp(pcbddc->coarse_ksp));
8701     /* Check coarse problem if in debug mode or if solving with an iterative method */
8702     PetscCall(PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly));
8703     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates)) {
8704       KSP       check_ksp;
8705       KSPType   check_ksp_type;
8706       PC        check_pc;
8707       Vec       check_vec,coarse_vec;
8708       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8709       PetscInt  its;
8710       PetscBool compute_eigs;
8711       PetscReal *eigs_r,*eigs_c;
8712       PetscInt  neigs;
8713       const char *prefix;
8714 
8715       /* Create ksp object suitable for estimation of extreme eigenvalues */
8716       PetscCall(KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp));
8717       PetscCall(PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0));
8718       PetscCall(KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE));
8719       PetscCall(KSPSetOperators(check_ksp,coarse_mat,coarse_mat));
8720       PetscCall(KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size));
8721       /* prevent from setup unneeded object */
8722       PetscCall(KSPGetPC(check_ksp,&check_pc));
8723       PetscCall(PCSetType(check_pc,PCNONE));
8724       if (ispreonly) {
8725         check_ksp_type = KSPPREONLY;
8726         compute_eigs = PETSC_FALSE;
8727       } else {
8728         check_ksp_type = KSPGMRES;
8729         compute_eigs = PETSC_TRUE;
8730       }
8731       PetscCall(KSPSetType(check_ksp,check_ksp_type));
8732       PetscCall(KSPSetComputeSingularValues(check_ksp,compute_eigs));
8733       PetscCall(KSPSetComputeEigenvalues(check_ksp,compute_eigs));
8734       PetscCall(KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1));
8735       PetscCall(KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix));
8736       PetscCall(KSPSetOptionsPrefix(check_ksp,prefix));
8737       PetscCall(KSPAppendOptionsPrefix(check_ksp,"check_"));
8738       PetscCall(KSPSetFromOptions(check_ksp));
8739       PetscCall(KSPSetUp(check_ksp));
8740       PetscCall(KSPGetPC(pcbddc->coarse_ksp,&check_pc));
8741       PetscCall(KSPSetPC(check_ksp,check_pc));
8742       /* create random vec */
8743       PetscCall(MatCreateVecs(coarse_mat,&coarse_vec,&check_vec));
8744       PetscCall(VecSetRandom(check_vec,NULL));
8745       PetscCall(MatMult(coarse_mat,check_vec,coarse_vec));
8746       /* solve coarse problem */
8747       PetscCall(KSPSolve(check_ksp,coarse_vec,coarse_vec));
8748       PetscCall(KSPCheckSolve(check_ksp,pc,coarse_vec));
8749       /* set eigenvalue estimation if preonly has not been requested */
8750       if (compute_eigs) {
8751         PetscCall(PetscMalloc1(pcbddc->coarse_size+1,&eigs_r));
8752         PetscCall(PetscMalloc1(pcbddc->coarse_size+1,&eigs_c));
8753         PetscCall(KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs));
8754         if (neigs) {
8755           lambda_max = eigs_r[neigs-1];
8756           lambda_min = eigs_r[0];
8757           if (pcbddc->use_coarse_estimates) {
8758             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8759               PetscCall(KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min));
8760               PetscCall(KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min)));
8761             }
8762           }
8763         }
8764       }
8765 
8766       /* check coarse problem residual error */
8767       if (pcbddc->dbg_flag) {
8768         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8769         PetscCall(PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1)));
8770         PetscCall(VecAXPY(check_vec,-1.0,coarse_vec));
8771         PetscCall(VecNorm(check_vec,NORM_INFINITY,&infty_error));
8772         PetscCall(MatMult(coarse_mat,check_vec,coarse_vec));
8773         PetscCall(VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error));
8774         PetscCall(PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates));
8775         PetscCall(PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer));
8776         PetscCall(PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer));
8777         PetscCall(PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",(double)infty_error));
8778         PetscCall(PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",(double)abs_infty_error));
8779         if (CoarseNullSpace) {
8780           PetscCall(PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n"));
8781         }
8782         if (compute_eigs) {
8783           PetscReal          lambda_max_s,lambda_min_s;
8784           KSPConvergedReason reason;
8785           PetscCall(KSPGetType(check_ksp,&check_ksp_type));
8786           PetscCall(KSPGetIterationNumber(check_ksp,&its));
8787           PetscCall(KSPGetConvergedReason(check_ksp,&reason));
8788           PetscCall(KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s));
8789           PetscCall(PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem eigenvalues (estimated with %" PetscInt_FMT " iterations of %s, conv reason %d): %1.6e %1.6e (%1.6e %1.6e)\n",its,check_ksp_type,reason,(double)lambda_min,(double)lambda_max,(double)lambda_min_s,(double)lambda_max_s));
8790           for (i=0;i<neigs;i++) {
8791             PetscCall(PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",(double)eigs_r[i],(double)eigs_c[i]));
8792           }
8793         }
8794         PetscCall(PetscViewerFlush(dbg_viewer));
8795         PetscCall(PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1)));
8796       }
8797       PetscCall(VecDestroy(&check_vec));
8798       PetscCall(VecDestroy(&coarse_vec));
8799       PetscCall(KSPDestroy(&check_ksp));
8800       if (compute_eigs) {
8801         PetscCall(PetscFree(eigs_r));
8802         PetscCall(PetscFree(eigs_c));
8803       }
8804     }
8805   }
8806   PetscCall(MatNullSpaceDestroy(&CoarseNullSpace));
8807   /* print additional info */
8808   if (pcbddc->dbg_flag) {
8809     /* waits until all processes reaches this point */
8810     PetscCall(PetscBarrier((PetscObject)pc));
8811     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %" PetscInt_FMT "\n",pcbddc->current_level));
8812     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
8813   }
8814 
8815   /* free memory */
8816   PetscCall(MatDestroy(&coarse_mat));
8817   PetscCall(PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0));
8818   PetscFunctionReturn(0);
8819 }
8820 
8821 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8822 {
8823   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8824   PC_IS*         pcis = (PC_IS*)pc->data;
8825   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8826   IS             subset,subset_mult,subset_n;
8827   PetscInt       local_size,coarse_size=0;
8828   PetscInt       *local_primal_indices=NULL;
8829   const PetscInt *t_local_primal_indices;
8830 
8831   PetscFunctionBegin;
8832   /* Compute global number of coarse dofs */
8833   PetscCheck(!pcbddc->local_primal_size || pcbddc->local_primal_ref_node,PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8834   PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n));
8835   PetscCall(ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset));
8836   PetscCall(ISDestroy(&subset_n));
8837   PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult));
8838   PetscCall(ISRenumber(subset,subset_mult,&coarse_size,&subset_n));
8839   PetscCall(ISDestroy(&subset));
8840   PetscCall(ISDestroy(&subset_mult));
8841   PetscCall(ISGetLocalSize(subset_n,&local_size));
8842   PetscCheck(local_size == pcbddc->local_primal_size,PETSC_COMM_SELF,PETSC_ERR_PLIB,"Invalid number of local primal indices computed %" PetscInt_FMT " != %" PetscInt_FMT,local_size,pcbddc->local_primal_size);
8843   PetscCall(PetscMalloc1(local_size,&local_primal_indices));
8844   PetscCall(ISGetIndices(subset_n,&t_local_primal_indices));
8845   PetscCall(PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size));
8846   PetscCall(ISRestoreIndices(subset_n,&t_local_primal_indices));
8847   PetscCall(ISDestroy(&subset_n));
8848 
8849   /* check numbering */
8850   if (pcbddc->dbg_flag) {
8851     PetscScalar coarsesum,*array,*array2;
8852     PetscInt    i;
8853     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8854 
8855     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
8856     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n"));
8857     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n"));
8858     PetscCall(PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer));
8859     /* counter */
8860     PetscCall(VecSet(pcis->vec1_global,0.0));
8861     PetscCall(VecSet(pcis->vec1_N,1.0));
8862     PetscCall(VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE));
8863     PetscCall(VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE));
8864     PetscCall(VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD));
8865     PetscCall(VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD));
8866     PetscCall(VecSet(pcis->vec1_N,0.0));
8867     for (i=0;i<pcbddc->local_primal_size;i++) {
8868       PetscCall(VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES));
8869     }
8870     PetscCall(VecAssemblyBegin(pcis->vec1_N));
8871     PetscCall(VecAssemblyEnd(pcis->vec1_N));
8872     PetscCall(VecSet(pcis->vec1_global,0.0));
8873     PetscCall(VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE));
8874     PetscCall(VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE));
8875     PetscCall(VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD));
8876     PetscCall(VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD));
8877     PetscCall(VecGetArray(pcis->vec1_N,&array));
8878     PetscCall(VecGetArray(pcis->vec2_N,&array2));
8879     for (i=0;i<pcis->n;i++) {
8880       if (array[i] != 0.0 && array[i] != array2[i]) {
8881         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8882         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8883         set_error = PETSC_TRUE;
8884         PetscCall(ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi));
8885         PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %" PetscInt_FMT " (gid %" PetscInt_FMT ") owned by %" PetscInt_FMT " processes instead of %" PetscInt_FMT "!\n",PetscGlobalRank,i,gi,owned,neigh));
8886       }
8887     }
8888     PetscCall(VecRestoreArray(pcis->vec2_N,&array2));
8889     PetscCall(MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc)));
8890     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
8891     for (i=0;i<pcis->n;i++) {
8892       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8893     }
8894     PetscCall(VecRestoreArray(pcis->vec1_N,&array));
8895     PetscCall(VecSet(pcis->vec1_global,0.0));
8896     PetscCall(VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE));
8897     PetscCall(VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE));
8898     PetscCall(VecSum(pcis->vec1_global,&coarsesum));
8899     PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %" PetscInt_FMT " (%lf)\n",coarse_size,(double)PetscRealPart(coarsesum)));
8900     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8901       PetscInt *gidxs;
8902 
8903       PetscCall(PetscMalloc1(pcbddc->local_primal_size,&gidxs));
8904       PetscCall(ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs));
8905       PetscCall(PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n"));
8906       PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
8907       PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank));
8908       for (i=0;i<pcbddc->local_primal_size;i++) {
8909         PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%" PetscInt_FMT "]=%" PetscInt_FMT " (%" PetscInt_FMT ",%" PetscInt_FMT ")\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i],gidxs[i]));
8910       }
8911       PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
8912       PetscCall(PetscFree(gidxs));
8913     }
8914     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
8915     PetscCall(PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer));
8916     PetscCheck(!set_error_reduced,PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8917   }
8918 
8919   /* get back data */
8920   *coarse_size_n = coarse_size;
8921   *local_primal_indices_n = local_primal_indices;
8922   PetscFunctionReturn(0);
8923 }
8924 
8925 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8926 {
8927   IS             localis_t;
8928   PetscInt       i,lsize,*idxs,n;
8929   PetscScalar    *vals;
8930 
8931   PetscFunctionBegin;
8932   /* get indices in local ordering exploiting local to global map */
8933   PetscCall(ISGetLocalSize(globalis,&lsize));
8934   PetscCall(PetscMalloc1(lsize,&vals));
8935   for (i=0;i<lsize;i++) vals[i] = 1.0;
8936   PetscCall(ISGetIndices(globalis,(const PetscInt**)&idxs));
8937   PetscCall(VecSet(gwork,0.0));
8938   PetscCall(VecSet(lwork,0.0));
8939   if (idxs) { /* multilevel guard */
8940     PetscCall(VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE));
8941     PetscCall(VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES));
8942   }
8943   PetscCall(VecAssemblyBegin(gwork));
8944   PetscCall(ISRestoreIndices(globalis,(const PetscInt**)&idxs));
8945   PetscCall(PetscFree(vals));
8946   PetscCall(VecAssemblyEnd(gwork));
8947   /* now compute set in local ordering */
8948   PetscCall(VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD));
8949   PetscCall(VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD));
8950   PetscCall(VecGetArrayRead(lwork,(const PetscScalar**)&vals));
8951   PetscCall(VecGetSize(lwork,&n));
8952   for (i=0,lsize=0;i<n;i++) {
8953     if (PetscRealPart(vals[i]) > 0.5) {
8954       lsize++;
8955     }
8956   }
8957   PetscCall(PetscMalloc1(lsize,&idxs));
8958   for (i=0,lsize=0;i<n;i++) {
8959     if (PetscRealPart(vals[i]) > 0.5) {
8960       idxs[lsize++] = i;
8961     }
8962   }
8963   PetscCall(VecRestoreArrayRead(lwork,(const PetscScalar**)&vals));
8964   PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t));
8965   *localis = localis_t;
8966   PetscFunctionReturn(0);
8967 }
8968 
8969 PetscErrorCode PCBDDCComputeFakeChange(PC pc, PetscBool constraints, PCBDDCGraph graph, PCBDDCSubSchurs schurs, Mat *change, IS *change_primal, IS *change_primal_mult, PetscBool *change_with_qr)
8970 {
8971   PC_IS   *pcis = (PC_IS*)pc->data;
8972   PC_BDDC *pcbddc = (PC_BDDC*)pc->data;
8973   PC_IS   *pcisf;
8974   PC_BDDC *pcbddcf;
8975   PC      pcf;
8976 
8977   PetscFunctionBegin;
8978   PetscCall(PCCreate(PetscObjectComm((PetscObject)pc),&pcf));
8979   PetscCall(PetscLogObjectParent((PetscObject)pc,(PetscObject)pcf));
8980   PetscCall(PCSetOperators(pcf,pc->mat,pc->pmat));
8981   PetscCall(PCSetType(pcf,PCBDDC));
8982 
8983   pcisf   = (PC_IS*)pcf->data;
8984   pcbddcf = (PC_BDDC*)pcf->data;
8985 
8986   pcisf->is_B_local = pcis->is_B_local;
8987   pcisf->vec1_N     = pcis->vec1_N;
8988   pcisf->BtoNmap    = pcis->BtoNmap;
8989   pcisf->n          = pcis->n;
8990   pcisf->n_B        = pcis->n_B;
8991 
8992   PetscCall(PetscFree(pcbddcf->mat_graph));
8993   PetscCall(PetscFree(pcbddcf->sub_schurs));
8994   pcbddcf->mat_graph             = graph ? graph : pcbddc->mat_graph;
8995   pcbddcf->sub_schurs            = schurs;
8996   pcbddcf->adaptive_selection    = schurs ? PETSC_TRUE : PETSC_FALSE;
8997   pcbddcf->adaptive_threshold[0] = pcbddc->adaptive_threshold[0];
8998   pcbddcf->adaptive_threshold[1] = pcbddc->adaptive_threshold[1];
8999   pcbddcf->adaptive_nmin         = pcbddc->adaptive_nmin;
9000   pcbddcf->adaptive_nmax         = pcbddc->adaptive_nmax;
9001   pcbddcf->use_faces             = PETSC_TRUE;
9002   pcbddcf->use_change_of_basis   = (PetscBool)!constraints;
9003   pcbddcf->use_change_on_faces   = (PetscBool)!constraints;
9004   pcbddcf->use_qr_single         = (PetscBool)!constraints;
9005   pcbddcf->fake_change           = PETSC_TRUE;
9006   pcbddcf->dbg_flag              = pcbddc->dbg_flag;
9007 
9008   PetscCall(PCBDDCAdaptiveSelection(pcf));
9009   PetscCall(PCBDDCConstraintsSetUp(pcf));
9010 
9011   *change = pcbddcf->ConstraintMatrix;
9012   if (change_primal) PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc->pmat),pcbddcf->local_primal_size_cc,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,change_primal));
9013   if (change_primal_mult) PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc->pmat),pcbddcf->local_primal_size_cc,pcbddcf->local_primal_ref_mult,PETSC_COPY_VALUES,change_primal_mult));
9014   if (change_with_qr) *change_with_qr = pcbddcf->use_qr_single;
9015 
9016   if (schurs) pcbddcf->sub_schurs = NULL;
9017   pcbddcf->ConstraintMatrix       = NULL;
9018   pcbddcf->mat_graph              = NULL;
9019   pcisf->is_B_local               = NULL;
9020   pcisf->vec1_N                   = NULL;
9021   pcisf->BtoNmap                  = NULL;
9022   PetscCall(PCDestroy(&pcf));
9023   PetscFunctionReturn(0);
9024 }
9025 
9026 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
9027 {
9028   PC_IS               *pcis=(PC_IS*)pc->data;
9029   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9030   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
9031   Mat                 S_j;
9032   PetscInt            *used_xadj,*used_adjncy;
9033   PetscBool           free_used_adj;
9034 
9035   PetscFunctionBegin;
9036   PetscCall(PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0));
9037   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
9038   free_used_adj = PETSC_FALSE;
9039   if (pcbddc->sub_schurs_layers == -1) {
9040     used_xadj = NULL;
9041     used_adjncy = NULL;
9042   } else {
9043     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
9044       used_xadj = pcbddc->mat_graph->xadj;
9045       used_adjncy = pcbddc->mat_graph->adjncy;
9046     } else if (pcbddc->computed_rowadj) {
9047       used_xadj = pcbddc->mat_graph->xadj;
9048       used_adjncy = pcbddc->mat_graph->adjncy;
9049     } else {
9050       PetscBool      flg_row=PETSC_FALSE;
9051       const PetscInt *xadj,*adjncy;
9052       PetscInt       nvtxs;
9053 
9054       PetscCall(MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row));
9055       if (flg_row) {
9056         PetscCall(PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy));
9057         PetscCall(PetscArraycpy(used_xadj,xadj,nvtxs+1));
9058         PetscCall(PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]));
9059         free_used_adj = PETSC_TRUE;
9060       } else {
9061         pcbddc->sub_schurs_layers = -1;
9062         used_xadj = NULL;
9063         used_adjncy = NULL;
9064       }
9065       PetscCall(MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row));
9066     }
9067   }
9068 
9069   /* setup sub_schurs data */
9070   PetscCall(MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j));
9071   if (!sub_schurs->schur_explicit) {
9072     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
9073     PetscCall(MatSchurComplementSetKSP(S_j,pcbddc->ksp_D));
9074     PetscCall(PCBDDCSubSchursSetUp(sub_schurs,NULL,S_j,PETSC_FALSE,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,NULL,pcbddc->adaptive_selection,PETSC_FALSE,PETSC_FALSE,0,NULL,NULL,NULL,NULL));
9075   } else {
9076     Mat       change = NULL;
9077     Vec       scaling = NULL;
9078     IS        change_primal = NULL, iP;
9079     PetscInt  benign_n;
9080     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
9081     PetscBool need_change = PETSC_FALSE;
9082     PetscBool discrete_harmonic = PETSC_FALSE;
9083 
9084     if (!pcbddc->use_vertices && reuse_solvers) {
9085       PetscInt n_vertices;
9086 
9087       PetscCall(ISGetLocalSize(sub_schurs->is_vertices,&n_vertices));
9088       reuse_solvers = (PetscBool)!n_vertices;
9089     }
9090     if (!pcbddc->benign_change_explicit) {
9091       benign_n = pcbddc->benign_n;
9092     } else {
9093       benign_n = 0;
9094     }
9095     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9096        We need a global reduction to avoid possible deadlocks.
9097        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9098     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9099       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9100       PetscCall(MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc)));
9101       need_change = (PetscBool)(!need_change);
9102     }
9103     /* If the user defines additional constraints, we import them here */
9104     if (need_change) {
9105       PetscCheck(!pcbddc->sub_schurs_rebuild,PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9106       PetscCall(PCBDDCComputeFakeChange(pc,PETSC_FALSE,NULL,NULL,&change,&change_primal,NULL,&sub_schurs->change_with_qr));
9107 
9108     }
9109     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9110 
9111     PetscCall(PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP));
9112     if (iP) {
9113       PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");
9114       PetscCall(PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL));
9115       PetscOptionsEnd();
9116     }
9117     if (discrete_harmonic) {
9118       Mat A;
9119       PetscCall(MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A));
9120       PetscCall(MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL));
9121       PetscCall(PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP));
9122       PetscCall(PCBDDCSubSchursSetUp(sub_schurs,A,S_j,pcbddc->sub_schurs_exact_schur,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,scaling,pcbddc->adaptive_selection,reuse_solvers,pcbddc->benign_saddle_point,benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_zerodiag_subs,change,change_primal));
9123       PetscCall(MatDestroy(&A));
9124     } else {
9125       PetscCall(PCBDDCSubSchursSetUp(sub_schurs,pcbddc->local_mat,S_j,pcbddc->sub_schurs_exact_schur,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,scaling,pcbddc->adaptive_selection,reuse_solvers,pcbddc->benign_saddle_point,benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_zerodiag_subs,change,change_primal));
9126     }
9127     PetscCall(MatDestroy(&change));
9128     PetscCall(ISDestroy(&change_primal));
9129   }
9130   PetscCall(MatDestroy(&S_j));
9131 
9132   /* free adjacency */
9133   if (free_used_adj) PetscCall(PetscFree2(used_xadj,used_adjncy));
9134   PetscCall(PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0));
9135   PetscFunctionReturn(0);
9136 }
9137 
9138 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9139 {
9140   PC_IS               *pcis=(PC_IS*)pc->data;
9141   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9142   PCBDDCGraph         graph;
9143 
9144   PetscFunctionBegin;
9145   /* attach interface graph for determining subsets */
9146   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9147     IS       verticesIS,verticescomm;
9148     PetscInt vsize,*idxs;
9149 
9150     PetscCall(PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS));
9151     PetscCall(ISGetSize(verticesIS,&vsize));
9152     PetscCall(ISGetIndices(verticesIS,(const PetscInt**)&idxs));
9153     PetscCall(ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm));
9154     PetscCall(ISRestoreIndices(verticesIS,(const PetscInt**)&idxs));
9155     PetscCall(PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS));
9156     PetscCall(PCBDDCGraphCreate(&graph));
9157     PetscCall(PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount));
9158     PetscCall(PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm));
9159     PetscCall(ISDestroy(&verticescomm));
9160     PetscCall(PCBDDCGraphComputeConnectedComponents(graph));
9161   } else {
9162     graph = pcbddc->mat_graph;
9163   }
9164   /* print some info */
9165   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9166     IS       vertices;
9167     PetscInt nv,nedges,nfaces;
9168     PetscCall(PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer));
9169     PetscCall(PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices));
9170     PetscCall(ISGetSize(vertices,&nv));
9171     PetscCall(PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer));
9172     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n"));
9173     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02" PetscInt_FMT " local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices));
9174     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02" PetscInt_FMT " local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges));
9175     PetscCall(PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02" PetscInt_FMT " local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces));
9176     PetscCall(PetscViewerFlush(pcbddc->dbg_viewer));
9177     PetscCall(PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer));
9178     PetscCall(PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices));
9179   }
9180 
9181   /* sub_schurs init */
9182   if (!pcbddc->sub_schurs) {
9183     PetscCall(PCBDDCSubSchursCreate(&pcbddc->sub_schurs));
9184   }
9185   PetscCall(PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild,PETSC_FALSE));
9186 
9187   /* free graph struct */
9188   if (pcbddc->sub_schurs_rebuild) {
9189     PetscCall(PCBDDCGraphDestroy(&graph));
9190   }
9191   PetscFunctionReturn(0);
9192 }
9193 
9194 PetscErrorCode PCBDDCCheckOperator(PC pc)
9195 {
9196   PC_IS               *pcis=(PC_IS*)pc->data;
9197   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9198 
9199   PetscFunctionBegin;
9200   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9201     IS             zerodiag = NULL;
9202     Mat            S_j,B0_B=NULL;
9203     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9204     PetscScalar    *p0_check,*array,*array2;
9205     PetscReal      norm;
9206     PetscInt       i;
9207 
9208     /* B0 and B0_B */
9209     if (zerodiag) {
9210       IS       dummy;
9211 
9212       PetscCall(ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy));
9213       PetscCall(MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B));
9214       PetscCall(MatCreateVecs(B0_B,NULL,&dummy_vec));
9215       PetscCall(ISDestroy(&dummy));
9216     }
9217     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9218     PetscCall(VecDuplicate(pcbddc->vec1_P,&vec_scale_P));
9219     PetscCall(VecSet(pcbddc->vec1_P,1.0));
9220     PetscCall(VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD));
9221     PetscCall(VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD));
9222     PetscCall(VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE));
9223     PetscCall(VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE));
9224     PetscCall(VecReciprocal(vec_scale_P));
9225     /* S_j */
9226     PetscCall(MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j));
9227     PetscCall(MatSchurComplementSetKSP(S_j,pcbddc->ksp_D));
9228 
9229     /* mimic vector in \widetilde{W}_\Gamma */
9230     PetscCall(VecSetRandom(pcis->vec1_N,NULL));
9231     /* continuous in primal space */
9232     PetscCall(VecSetRandom(pcbddc->coarse_vec,NULL));
9233     PetscCall(VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE));
9234     PetscCall(VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE));
9235     PetscCall(VecGetArray(pcbddc->vec1_P,&array));
9236     PetscCall(PetscCalloc1(pcbddc->benign_n,&p0_check));
9237     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9238     PetscCall(VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES));
9239     PetscCall(VecRestoreArray(pcbddc->vec1_P,&array));
9240     PetscCall(VecAssemblyBegin(pcis->vec1_N));
9241     PetscCall(VecAssemblyEnd(pcis->vec1_N));
9242     PetscCall(VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD));
9243     PetscCall(VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD));
9244     PetscCall(VecDuplicate(pcis->vec2_B,&vec_check_B));
9245     PetscCall(VecCopy(pcis->vec2_B,vec_check_B));
9246 
9247     /* assemble rhs for coarse problem */
9248     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9249     /* local with Schur */
9250     PetscCall(MatMult(S_j,pcis->vec2_B,pcis->vec1_B));
9251     if (zerodiag) {
9252       PetscCall(VecGetArray(dummy_vec,&array));
9253       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9254       PetscCall(VecRestoreArray(dummy_vec,&array));
9255       PetscCall(MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B));
9256     }
9257     /* sum on primal nodes the local contributions */
9258     PetscCall(VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE));
9259     PetscCall(VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE));
9260     PetscCall(VecGetArray(pcis->vec1_N,&array));
9261     PetscCall(VecGetArray(pcbddc->vec1_P,&array2));
9262     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9263     PetscCall(VecRestoreArray(pcbddc->vec1_P,&array2));
9264     PetscCall(VecRestoreArray(pcis->vec1_N,&array));
9265     PetscCall(VecSet(pcbddc->coarse_vec,0.));
9266     PetscCall(VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD));
9267     PetscCall(VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD));
9268     PetscCall(VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE));
9269     PetscCall(VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE));
9270     PetscCall(VecGetArray(pcbddc->vec1_P,&array));
9271     /* scale primal nodes (BDDC sums contibutions) */
9272     PetscCall(VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P));
9273     PetscCall(VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES));
9274     PetscCall(VecRestoreArray(pcbddc->vec1_P,&array));
9275     PetscCall(VecAssemblyBegin(pcis->vec1_N));
9276     PetscCall(VecAssemblyEnd(pcis->vec1_N));
9277     PetscCall(VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD));
9278     PetscCall(VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD));
9279     /* global: \widetilde{B0}_B w_\Gamma */
9280     if (zerodiag) {
9281       PetscCall(MatMult(B0_B,pcis->vec2_B,dummy_vec));
9282       PetscCall(VecGetArray(dummy_vec,&array));
9283       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9284       PetscCall(VecRestoreArray(dummy_vec,&array));
9285     }
9286     /* BDDC */
9287     PetscCall(VecSet(pcis->vec1_D,0.));
9288     PetscCall(PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE));
9289 
9290     PetscCall(VecCopy(pcis->vec1_B,pcis->vec2_B));
9291     PetscCall(VecAXPY(pcis->vec1_B,-1.0,vec_check_B));
9292     PetscCall(VecNorm(pcis->vec1_B,NORM_INFINITY,&norm));
9293     PetscCall(PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,(double)norm));
9294     for (i=0;i<pcbddc->benign_n;i++) {
9295       PetscCall(PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%" PetscInt_FMT "] error is %1.4e\n",PetscGlobalRank,i,(double)PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i])));
9296     }
9297     PetscCall(PetscFree(p0_check));
9298     PetscCall(VecDestroy(&vec_scale_P));
9299     PetscCall(VecDestroy(&vec_check_B));
9300     PetscCall(VecDestroy(&dummy_vec));
9301     PetscCall(MatDestroy(&S_j));
9302     PetscCall(MatDestroy(&B0_B));
9303   }
9304   PetscFunctionReturn(0);
9305 }
9306 
9307 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9308 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9309 {
9310   Mat            At;
9311   IS             rows;
9312   PetscInt       rst,ren;
9313   PetscLayout    rmap;
9314 
9315   PetscFunctionBegin;
9316   rst = ren = 0;
9317   if (ccomm != MPI_COMM_NULL) {
9318     PetscCall(PetscLayoutCreate(ccomm,&rmap));
9319     PetscCall(PetscLayoutSetSize(rmap,A->rmap->N));
9320     PetscCall(PetscLayoutSetBlockSize(rmap,1));
9321     PetscCall(PetscLayoutSetUp(rmap));
9322     PetscCall(PetscLayoutGetRange(rmap,&rst,&ren));
9323   }
9324   PetscCall(ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows));
9325   PetscCall(MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At));
9326   PetscCall(ISDestroy(&rows));
9327 
9328   if (ccomm != MPI_COMM_NULL) {
9329     Mat_MPIAIJ *a,*b;
9330     IS         from,to;
9331     Vec        gvec;
9332     PetscInt   lsize;
9333 
9334     PetscCall(MatCreate(ccomm,B));
9335     PetscCall(MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N));
9336     PetscCall(MatSetType(*B,MATAIJ));
9337     PetscCall(PetscLayoutDestroy(&((*B)->rmap)));
9338     PetscCall(PetscLayoutSetUp((*B)->cmap));
9339     a    = (Mat_MPIAIJ*)At->data;
9340     b    = (Mat_MPIAIJ*)(*B)->data;
9341     PetscCallMPI(MPI_Comm_size(ccomm,&b->size));
9342     PetscCallMPI(MPI_Comm_rank(ccomm,&b->rank));
9343     PetscCall(PetscObjectReference((PetscObject)a->A));
9344     PetscCall(PetscObjectReference((PetscObject)a->B));
9345     b->A = a->A;
9346     b->B = a->B;
9347 
9348     b->donotstash      = a->donotstash;
9349     b->roworiented     = a->roworiented;
9350     b->rowindices      = NULL;
9351     b->rowvalues       = NULL;
9352     b->getrowactive    = PETSC_FALSE;
9353 
9354     (*B)->rmap         = rmap;
9355     (*B)->factortype   = A->factortype;
9356     (*B)->assembled    = PETSC_TRUE;
9357     (*B)->insertmode   = NOT_SET_VALUES;
9358     (*B)->preallocated = PETSC_TRUE;
9359 
9360     if (a->colmap) {
9361 #if defined(PETSC_USE_CTABLE)
9362       PetscCall(PetscTableCreateCopy(a->colmap,&b->colmap));
9363 #else
9364       PetscCall(PetscMalloc1(At->cmap->N,&b->colmap));
9365       PetscCall(PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt)));
9366       PetscCall(PetscArraycpy(b->colmap,a->colmap,At->cmap->N));
9367 #endif
9368     } else b->colmap = NULL;
9369     if (a->garray) {
9370       PetscInt len;
9371       len  = a->B->cmap->n;
9372       PetscCall(PetscMalloc1(len+1,&b->garray));
9373       PetscCall(PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt)));
9374       if (len) PetscCall(PetscArraycpy(b->garray,a->garray,len));
9375     } else b->garray = NULL;
9376 
9377     PetscCall(PetscObjectReference((PetscObject)a->lvec));
9378     b->lvec = a->lvec;
9379     PetscCall(PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec));
9380 
9381     /* cannot use VecScatterCopy */
9382     PetscCall(VecGetLocalSize(b->lvec,&lsize));
9383     PetscCall(ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from));
9384     PetscCall(ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to));
9385     PetscCall(MatCreateVecs(*B,&gvec,NULL));
9386     PetscCall(VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx));
9387     PetscCall(PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx));
9388     PetscCall(ISDestroy(&from));
9389     PetscCall(ISDestroy(&to));
9390     PetscCall(VecDestroy(&gvec));
9391   }
9392   PetscCall(MatDestroy(&At));
9393   PetscFunctionReturn(0);
9394 }
9395