xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 3272d46bb1b0d63be5ad674c07eb07fe893d2206)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.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 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
324   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
458   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
459   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
460   for (i=1,cum=0;i<n_neigh;i++) {
461     cum += n_shared[i];
462     for (j=0;j<n_shared[i];j++) {
463       ecount[shared[i][j]]++;
464     }
465   }
466   if (ne) {
467     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
468   }
469   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
470   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
471   for (i=1;i<n_neigh;i++) {
472     for (j=0;j<n_shared[i];j++) {
473       PetscInt k = shared[i][j];
474       eneighs[k][ecount[k]] = neigh[i];
475       ecount[k]++;
476     }
477   }
478   for (i=0;i<ne;i++) {
479     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
480   }
481   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
482   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
483   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
484   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
485   for (i=1,cum=0;i<n_neigh;i++) {
486     cum += n_shared[i];
487     for (j=0;j<n_shared[i];j++) {
488       vcount[shared[i][j]]++;
489     }
490   }
491   if (nv) {
492     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
493   }
494   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
495   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
496   for (i=1;i<n_neigh;i++) {
497     for (j=0;j<n_shared[i];j++) {
498       PetscInt k = shared[i][j];
499       vneighs[k][vcount[k]] = neigh[i];
500       vcount[k]++;
501     }
502   }
503   for (i=0;i<nv;i++) {
504     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
505   }
506   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
507 
508   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
509      for proper detection of coarse edges' endpoints */
510   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
511   for (i=0;i<ne;i++) {
512     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
513       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
514     }
515   }
516   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
517   if (!conforming) {
518     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
519     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
520   }
521   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
522   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
523   cum  = 0;
524   for (i=0;i<ne;i++) {
525     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
526     if (!PetscBTLookup(btee,i)) {
527       marks[cum++] = i;
528       continue;
529     }
530     /* set badly connected edge dofs as primal */
531     if (!conforming) {
532       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
533         marks[cum++] = i;
534         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
535         for (j=ii[i];j<ii[i+1];j++) {
536           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
537         }
538       } else {
539         /* every edge dofs should be connected trough a certain number of nodal dofs
540            to other edge dofs belonging to coarse edges
541            - at most 2 endpoints
542            - order-1 interior nodal dofs
543            - no undefined nodal dofs (nconn < order)
544         */
545         PetscInt ends = 0,ints = 0, undef = 0;
546         for (j=ii[i];j<ii[i+1];j++) {
547           PetscInt v = jj[j],k;
548           PetscInt nconn = iit[v+1]-iit[v];
549           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
550           if (nconn > order) ends++;
551           else if (nconn == order) ints++;
552           else undef++;
553         }
554         if (undef || ends > 2 || ints != order -1) {
555           marks[cum++] = i;
556           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
557           for (j=ii[i];j<ii[i+1];j++) {
558             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
559           }
560         }
561       }
562     }
563     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
564     if (!order && ii[i+1] != ii[i]) {
565       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
566       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
567     }
568   }
569   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
570   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
571   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
572   if (!conforming) {
573     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
574     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
575   }
576   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
577 
578   /* identify splitpoints and corner candidates */
579   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
580   if (print) {
581     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
582     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
583     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
584     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
585   }
586   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
587   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
588   for (i=0;i<nv;i++) {
589     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
590     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
591     if (!order) { /* variable order */
592       PetscReal vorder = 0.;
593 
594       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
595       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
596       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
597       ord  = 1;
598     }
599 #if defined(PETSC_USE_DEBUG)
600     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
601 #endif
602     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
603       if (PetscBTLookup(btbd,jj[j])) {
604         bdir = PETSC_TRUE;
605         break;
606       }
607       if (vc != ecount[jj[j]]) {
608         sneighs = PETSC_FALSE;
609       } else {
610         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
611         for (k=0;k<vc;k++) {
612           if (vn[k] != en[k]) {
613             sneighs = PETSC_FALSE;
614             break;
615           }
616         }
617       }
618     }
619     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
620       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
621       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
622     } else if (test == ord) {
623       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
624         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
625         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
626       } else {
627         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
628         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
629       }
630     }
631   }
632   ierr = PetscFree(ecount);CHKERRQ(ierr);
633   ierr = PetscFree(vcount);CHKERRQ(ierr);
634   if (ne) {
635     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
636   }
637   if (nv) {
638     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
639   }
640   ierr = PetscFree(eneighs);CHKERRQ(ierr);
641   ierr = PetscFree(vneighs);CHKERRQ(ierr);
642   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
643 
644   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
645   if (order != 1) {
646     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
647     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
648     for (i=0;i<nv;i++) {
649       if (PetscBTLookup(btvcand,i)) {
650         PetscBool found = PETSC_FALSE;
651         for (j=ii[i];j<ii[i+1] && !found;j++) {
652           PetscInt k,e = jj[j];
653           if (PetscBTLookup(bte,e)) continue;
654           for (k=iit[e];k<iit[e+1];k++) {
655             PetscInt v = jjt[k];
656             if (v != i && PetscBTLookup(btvcand,v)) {
657               found = PETSC_TRUE;
658               break;
659             }
660           }
661         }
662         if (!found) {
663           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
664           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
665         } else {
666           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
667         }
668       }
669     }
670     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
671   }
672   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
673   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
674   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
675 
676   /* Get the local G^T explicitly */
677   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
678   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
679   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
680 
681   /* Mark interior nodal dofs */
682   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
683   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
684   for (i=1;i<n_neigh;i++) {
685     for (j=0;j<n_shared[i];j++) {
686       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
687     }
688   }
689   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
690 
691   /* communicate corners and splitpoints */
692   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
693   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
694   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
695   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
696 
697   if (print) {
698     IS tbz;
699 
700     cum = 0;
701     for (i=0;i<nv;i++)
702       if (sfvleaves[i])
703         vmarks[cum++] = i;
704 
705     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
706     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
707     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
708     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
709   }
710 
711   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
712   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
713   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
714   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
715 
716   /* Zero rows of lGt corresponding to identified corners
717      and interior nodal dofs */
718   cum = 0;
719   for (i=0;i<nv;i++) {
720     if (sfvleaves[i]) {
721       vmarks[cum++] = i;
722       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
723     }
724     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
725   }
726   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
727   if (print) {
728     IS tbz;
729 
730     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
731     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
732     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
733     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
734   }
735   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
736   ierr = PetscFree(vmarks);CHKERRQ(ierr);
737   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
738   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
739 
740   /* Recompute G */
741   ierr = MatDestroy(&lG);CHKERRQ(ierr);
742   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
743   if (print) {
744     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
745     ierr = MatView(lG,NULL);CHKERRQ(ierr);
746     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
747     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
748   }
749 
750   /* Get primal dofs (if any) */
751   cum = 0;
752   for (i=0;i<ne;i++) {
753     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
754   }
755   if (fl2g) {
756     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
757   }
758   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
759   if (print) {
760     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
761     ierr = ISView(primals,NULL);CHKERRQ(ierr);
762   }
763   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
764   /* TODO: what if the user passed in some of them ?  */
765   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
766   ierr = ISDestroy(&primals);CHKERRQ(ierr);
767 
768   /* Compute edge connectivity */
769   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
770   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
771   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
772   if (fl2g) {
773     PetscBT   btf;
774     PetscInt  *iia,*jja,*iiu,*jju;
775     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
776 
777     /* create CSR for all local dofs */
778     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
779     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
780       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
781       iiu = pcbddc->mat_graph->xadj;
782       jju = pcbddc->mat_graph->adjncy;
783     } else if (pcbddc->use_local_adj) {
784       rest = PETSC_TRUE;
785       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
786     } else {
787       free   = PETSC_TRUE;
788       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
789       iiu[0] = 0;
790       for (i=0;i<n;i++) {
791         iiu[i+1] = i+1;
792         jju[i]   = -1;
793       }
794     }
795 
796     /* import sizes of CSR */
797     iia[0] = 0;
798     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
799 
800     /* overwrite entries corresponding to the Nedelec field */
801     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
802     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
803     for (i=0;i<ne;i++) {
804       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
805       iia[idxs[i]+1] = ii[i+1]-ii[i];
806     }
807 
808     /* iia in CSR */
809     for (i=0;i<n;i++) iia[i+1] += iia[i];
810 
811     /* jja in CSR */
812     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
813     for (i=0;i<n;i++)
814       if (!PetscBTLookup(btf,i))
815         for (j=0;j<iiu[i+1]-iiu[i];j++)
816           jja[iia[i]+j] = jju[iiu[i]+j];
817 
818     /* map edge dofs connectivity */
819     if (jj) {
820       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
821       for (i=0;i<ne;i++) {
822         PetscInt e = idxs[i];
823         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
824       }
825     }
826     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
827     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
828     if (rest) {
829       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
830     }
831     if (free) {
832       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
833     }
834     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
835   } else {
836     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
837   }
838 
839   /* Analyze interface for edge dofs */
840   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
841   pcbddc->mat_graph->twodim = PETSC_FALSE;
842 
843   /* Get coarse edges in the edge space */
844   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
845   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
846 
847   if (fl2g) {
848     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
849     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
850     for (i=0;i<nee;i++) {
851       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
852     }
853   } else {
854     eedges  = alleedges;
855     primals = allprimals;
856   }
857 
858   /* Mark fine edge dofs with their coarse edge id */
859   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
860   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
861   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
862   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
863   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
864   if (print) {
865     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
866     ierr = ISView(primals,NULL);CHKERRQ(ierr);
867   }
868 
869   maxsize = 0;
870   for (i=0;i<nee;i++) {
871     PetscInt size,mark = i+1;
872 
873     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
874     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     for (j=0;j<size;j++) marks[idxs[j]] = mark;
876     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
877     maxsize = PetscMax(maxsize,size);
878   }
879 
880   /* Find coarse edge endpoints */
881   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
882   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
883   for (i=0;i<nee;i++) {
884     PetscInt mark = i+1,size;
885 
886     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
887     if (!size && nedfieldlocal) continue;
888     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
889     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
890     if (print) {
891       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
892       ISView(eedges[i],NULL);
893     }
894     for (j=0;j<size;j++) {
895       PetscInt k, ee = idxs[j];
896       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
897       for (k=ii[ee];k<ii[ee+1];k++) {
898         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
899         if (PetscBTLookup(btv,jj[k])) {
900           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
901         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
902           PetscInt  k2;
903           PetscBool corner = PETSC_FALSE;
904           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
905             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
906             /* it's a corner if either is connected with an edge dof belonging to a different cc or
907                if the edge dof lie on the natural part of the boundary */
908             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
909               corner = PETSC_TRUE;
910               break;
911             }
912           }
913           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
914             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
915             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
916           } else {
917             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
918           }
919         }
920       }
921     }
922     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
923   }
924   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
925   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
926   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
927 
928   /* Reset marked primal dofs */
929   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
930   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
931   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
932   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
933 
934   /* Now use the initial lG */
935   ierr = MatDestroy(&lG);CHKERRQ(ierr);
936   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
937   lG   = lGinit;
938   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
939 
940   /* Compute extended cols indices */
941   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
942   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
943   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
944   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
945   i   *= maxsize;
946   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
947   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
948   eerr = PETSC_FALSE;
949   for (i=0;i<nee;i++) {
950     PetscInt size,found = 0;
951 
952     cum  = 0;
953     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
954     if (!size && nedfieldlocal) continue;
955     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
956     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
957     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
958     for (j=0;j<size;j++) {
959       PetscInt k,ee = idxs[j];
960       for (k=ii[ee];k<ii[ee+1];k++) {
961         PetscInt vv = jj[k];
962         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
963         else if (!PetscBTLookupSet(btvc,vv)) found++;
964       }
965     }
966     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
967     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
968     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
969     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
970     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
971     /* it may happen that endpoints are not defined at this point
972        if it is the case, mark this edge for a second pass */
973     if (cum != size -1 || found != 2) {
974       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
975       if (print) {
976         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
977         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
978         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
979         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
980       }
981       eerr = PETSC_TRUE;
982     }
983   }
984   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
985   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
986   if (done) {
987     PetscInt *newprimals;
988 
989     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
990     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
991     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
993     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
994     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
995     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
996     for (i=0;i<nee;i++) {
997       PetscBool has_candidates = PETSC_FALSE;
998       if (PetscBTLookup(bter,i)) {
999         PetscInt size,mark = i+1;
1000 
1001         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1002         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1003         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1004         for (j=0;j<size;j++) {
1005           PetscInt k,ee = idxs[j];
1006           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1007           for (k=ii[ee];k<ii[ee+1];k++) {
1008             /* set all candidates located on the edge as corners */
1009             if (PetscBTLookup(btvcand,jj[k])) {
1010               PetscInt k2,vv = jj[k];
1011               has_candidates = PETSC_TRUE;
1012               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1013               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1014               /* set all edge dofs connected to candidate as primals */
1015               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1016                 if (marks[jjt[k2]] == mark) {
1017                   PetscInt k3,ee2 = jjt[k2];
1018                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1019                   newprimals[cum++] = ee2;
1020                   /* finally set the new corners */
1021                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1022                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1023                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1024                   }
1025                 }
1026               }
1027             } else {
1028               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1029             }
1030           }
1031         }
1032         if (!has_candidates) { /* circular edge */
1033           PetscInt k, ee = idxs[0],*tmarks;
1034 
1035           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1036           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1037           for (k=ii[ee];k<ii[ee+1];k++) {
1038             PetscInt k2;
1039             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1040             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1041             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1042           }
1043           for (j=0;j<size;j++) {
1044             if (tmarks[idxs[j]] > 1) {
1045               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1046               newprimals[cum++] = idxs[j];
1047             }
1048           }
1049           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1050         }
1051         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1052       }
1053       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1054     }
1055     ierr = PetscFree(extcols);CHKERRQ(ierr);
1056     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1057     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1058     if (fl2g) {
1059       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1060       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1061       for (i=0;i<nee;i++) {
1062         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1063       }
1064       ierr = PetscFree(eedges);CHKERRQ(ierr);
1065     }
1066     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1067     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1068     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1069     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1070     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1071     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1072     pcbddc->mat_graph->twodim = PETSC_FALSE;
1073     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1074     if (fl2g) {
1075       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1076       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1077       for (i=0;i<nee;i++) {
1078         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1079       }
1080     } else {
1081       eedges  = alleedges;
1082       primals = allprimals;
1083     }
1084     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1085 
1086     /* Mark again */
1087     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1088     for (i=0;i<nee;i++) {
1089       PetscInt size,mark = i+1;
1090 
1091       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1094       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     }
1096     if (print) {
1097       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1098       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1099     }
1100 
1101     /* Recompute extended cols */
1102     eerr = PETSC_FALSE;
1103     for (i=0;i<nee;i++) {
1104       PetscInt size;
1105 
1106       cum  = 0;
1107       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1108       if (!size && nedfieldlocal) continue;
1109       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1110       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1111       for (j=0;j<size;j++) {
1112         PetscInt k,ee = idxs[j];
1113         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1114       }
1115       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1116       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1117       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1118       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1119       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1120       if (cum != size -1) {
1121         if (print) {
1122           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1124           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1125           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1126         }
1127         eerr = PETSC_TRUE;
1128       }
1129     }
1130   }
1131   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1132   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1133   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1134   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1135   /* an error should not occur at this point */
1136   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1137 
1138   /* Check the number of endpoints */
1139   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1140   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1141   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1142   for (i=0;i<nee;i++) {
1143     PetscInt size, found = 0, gc[2];
1144 
1145     /* init with defaults */
1146     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1147     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1148     if (!size && nedfieldlocal) continue;
1149     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1150     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1151     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1152     for (j=0;j<size;j++) {
1153       PetscInt k,ee = idxs[j];
1154       for (k=ii[ee];k<ii[ee+1];k++) {
1155         PetscInt vv = jj[k];
1156         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1157           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1158           corners[i*2+found++] = vv;
1159         }
1160       }
1161     }
1162     if (found != 2) {
1163       PetscInt e;
1164       if (fl2g) {
1165         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1166       } else {
1167         e = idxs[0];
1168       }
1169       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1170     }
1171 
1172     /* get primal dof index on this coarse edge */
1173     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1174     if (gc[0] > gc[1]) {
1175       PetscInt swap  = corners[2*i];
1176       corners[2*i]   = corners[2*i+1];
1177       corners[2*i+1] = swap;
1178     }
1179     cedges[i] = idxs[size-1];
1180     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1181     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1182   }
1183   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1184   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1185 
1186 #if defined(PETSC_USE_DEBUG)
1187   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1188      not interfere with neighbouring coarse edges */
1189   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1190   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1191   for (i=0;i<nv;i++) {
1192     PetscInt emax = 0,eemax = 0;
1193 
1194     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1195     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1196     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1197     for (j=1;j<nee+1;j++) {
1198       if (emax < emarks[j]) {
1199         emax = emarks[j];
1200         eemax = j;
1201       }
1202     }
1203     /* not relevant for edges */
1204     if (!eemax) continue;
1205 
1206     for (j=ii[i];j<ii[i+1];j++) {
1207       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1208         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1209       }
1210     }
1211   }
1212   ierr = PetscFree(emarks);CHKERRQ(ierr);
1213   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1214 #endif
1215 
1216   /* Compute extended rows indices for edge blocks of the change of basis */
1217   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1218   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1219   extmem *= maxsize;
1220   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1221   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1222   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1223   for (i=0;i<nv;i++) {
1224     PetscInt mark = 0,size,start;
1225 
1226     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1227     for (j=ii[i];j<ii[i+1];j++)
1228       if (marks[jj[j]] && !mark)
1229         mark = marks[jj[j]];
1230 
1231     /* not relevant */
1232     if (!mark) continue;
1233 
1234     /* import extended row */
1235     mark--;
1236     start = mark*extmem+extrowcum[mark];
1237     size = ii[i+1]-ii[i];
1238     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1239     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1240     extrowcum[mark] += size;
1241   }
1242   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1243   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1244   ierr = PetscFree(marks);CHKERRQ(ierr);
1245 
1246   /* Compress extrows */
1247   cum  = 0;
1248   for (i=0;i<nee;i++) {
1249     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1250     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1251     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1252     cum  = PetscMax(cum,size);
1253   }
1254   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1255   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1256   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1257 
1258   /* Workspace for lapack inner calls and VecSetValues */
1259   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1260 
1261   /* Create change of basis matrix (preallocation can be improved) */
1262   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1263   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1264                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1265   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1266   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1267   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1268   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1269   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1270   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1271   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1272 
1273   /* Defaults to identity */
1274   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1275   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1276   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1277   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1278 
1279   /* Create discrete gradient for the coarser level if needed */
1280   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1281   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1282   if (pcbddc->current_level < pcbddc->max_levels) {
1283     ISLocalToGlobalMapping cel2g,cvl2g;
1284     IS                     wis,gwis;
1285     PetscInt               cnv,cne;
1286 
1287     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1288     if (fl2g) {
1289       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1290     } else {
1291       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1292       pcbddc->nedclocal = wis;
1293     }
1294     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1295     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1296     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1297     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1298     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1299     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1300 
1301     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1302     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1303     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1304     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1305     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1306     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1307     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1308 
1309     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1310     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1311     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1312     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1313     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1314     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1315     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1316     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1317   }
1318   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1319 
1320 #if defined(PRINT_GDET)
1321   inc = 0;
1322   lev = pcbddc->current_level;
1323 #endif
1324 
1325   /* Insert values in the change of basis matrix */
1326   for (i=0;i<nee;i++) {
1327     Mat         Gins = NULL, GKins = NULL;
1328     IS          cornersis = NULL;
1329     PetscScalar cvals[2];
1330 
1331     if (pcbddc->nedcG) {
1332       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1333     }
1334     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1335     if (Gins && GKins) {
1336       PetscScalar    *data;
1337       const PetscInt *rows,*cols;
1338       PetscInt       nrh,nch,nrc,ncc;
1339 
1340       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1341       /* H1 */
1342       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1343       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1344       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1346       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1347       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1348       /* complement */
1349       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1350       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1351       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1352       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1353       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1354       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1355       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1356 
1357       /* coarse discrete gradient */
1358       if (pcbddc->nedcG) {
1359         PetscInt cols[2];
1360 
1361         cols[0] = 2*i;
1362         cols[1] = 2*i+1;
1363         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1364       }
1365       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1366     }
1367     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1368     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1369     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1370     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1371     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1372   }
1373   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1374 
1375   /* Start assembling */
1376   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   if (pcbddc->nedcG) {
1378     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1379   }
1380 
1381   /* Free */
1382   if (fl2g) {
1383     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1384     for (i=0;i<nee;i++) {
1385       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1386     }
1387     ierr = PetscFree(eedges);CHKERRQ(ierr);
1388   }
1389 
1390   /* hack mat_graph with primal dofs on the coarse edges */
1391   {
1392     PCBDDCGraph graph   = pcbddc->mat_graph;
1393     PetscInt    *oqueue = graph->queue;
1394     PetscInt    *ocptr  = graph->cptr;
1395     PetscInt    ncc,*idxs;
1396 
1397     /* find first primal edge */
1398     if (pcbddc->nedclocal) {
1399       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1400     } else {
1401       if (fl2g) {
1402         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1403       }
1404       idxs = cedges;
1405     }
1406     cum = 0;
1407     while (cum < nee && cedges[cum] < 0) cum++;
1408 
1409     /* adapt connected components */
1410     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1411     graph->cptr[0] = 0;
1412     for (i=0,ncc=0;i<graph->ncc;i++) {
1413       PetscInt lc = ocptr[i+1]-ocptr[i];
1414       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1415         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1416         graph->queue[graph->cptr[ncc]] = cedges[cum];
1417         ncc++;
1418         lc--;
1419         cum++;
1420         while (cum < nee && cedges[cum] < 0) cum++;
1421       }
1422       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1423       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1424       ncc++;
1425     }
1426     graph->ncc = ncc;
1427     if (pcbddc->nedclocal) {
1428       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1429     }
1430     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1431   }
1432   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1433   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1434   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1435   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1436 
1437   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1438   ierr = PetscFree(extrow);CHKERRQ(ierr);
1439   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1440   ierr = PetscFree(corners);CHKERRQ(ierr);
1441   ierr = PetscFree(cedges);CHKERRQ(ierr);
1442   ierr = PetscFree(extrows);CHKERRQ(ierr);
1443   ierr = PetscFree(extcols);CHKERRQ(ierr);
1444   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1445 
1446   /* Complete assembling */
1447   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448   if (pcbddc->nedcG) {
1449     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1450 #if 0
1451     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1452     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1453 #endif
1454   }
1455 
1456   /* set change of basis */
1457   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1458   ierr = MatDestroy(&T);CHKERRQ(ierr);
1459 
1460   PetscFunctionReturn(0);
1461 }
1462 
1463 /* the near-null space of BDDC carries information on quadrature weights,
1464    and these can be collinear -> so cheat with MatNullSpaceCreate
1465    and create a suitable set of basis vectors first */
1466 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1467 {
1468   PetscErrorCode ierr;
1469   PetscInt       i;
1470 
1471   PetscFunctionBegin;
1472   for (i=0;i<nvecs;i++) {
1473     PetscInt first,last;
1474 
1475     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1476     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1477     if (i>=first && i < last) {
1478       PetscScalar *data;
1479       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1480       if (!has_const) {
1481         data[i-first] = 1.;
1482       } else {
1483         data[2*i-first] = 1./PetscSqrtReal(2.);
1484         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1485       }
1486       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1487     }
1488     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1489   }
1490   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1491   for (i=0;i<nvecs;i++) { /* reset vectors */
1492     PetscInt first,last;
1493     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1494     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1495     if (i>=first && i < last) {
1496       PetscScalar *data;
1497       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1498       if (!has_const) {
1499         data[i-first] = 0.;
1500       } else {
1501         data[2*i-first] = 0.;
1502         data[2*i-first+1] = 0.;
1503       }
1504       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1505     }
1506     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1507     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1508   }
1509   PetscFunctionReturn(0);
1510 }
1511 
1512 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1513 {
1514   Mat                    loc_divudotp;
1515   Vec                    p,v,vins,quad_vec,*quad_vecs;
1516   ISLocalToGlobalMapping map;
1517   PetscScalar            *vals;
1518   const PetscScalar      *array;
1519   PetscInt               i,maxneighs,maxsize;
1520   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1521   PetscMPIInt            rank;
1522   PetscErrorCode         ierr;
1523 
1524   PetscFunctionBegin;
1525   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1526   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1527   maxsize = 0;
1528   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1529   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1530   /* create vectors to hold quadrature weights */
1531   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1532   if (!transpose) {
1533     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1534   } else {
1535     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1536   }
1537   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1538   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1539   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1540   for (i=0;i<maxneighs;i++) {
1541     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1542     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1543   }
1544 
1545   /* compute local quad vec */
1546   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1547   if (!transpose) {
1548     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1549   } else {
1550     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1551   }
1552   ierr = VecSet(p,1.);CHKERRQ(ierr);
1553   if (!transpose) {
1554     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1555   } else {
1556     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1557   }
1558   if (vl2l) {
1559     Mat        lA;
1560     VecScatter sc;
1561 
1562     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1563     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1564     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1565     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1566     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1567     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1568   } else {
1569     vins = v;
1570   }
1571   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1572   ierr = VecDestroy(&p);CHKERRQ(ierr);
1573 
1574   /* insert in global quadrature vecs */
1575   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1576   for (i=0;i<n_neigh;i++) {
1577     const PetscInt    *idxs;
1578     PetscInt          idx,nn,j;
1579 
1580     idxs = shared[i];
1581     nn   = n_shared[i];
1582     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1583     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1584     idx  = -(idx+1);
1585     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1586   }
1587   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1588   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1589   if (vl2l) {
1590     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1591   }
1592   ierr = VecDestroy(&v);CHKERRQ(ierr);
1593   ierr = PetscFree(vals);CHKERRQ(ierr);
1594 
1595   /* assemble near null space */
1596   for (i=0;i<maxneighs;i++) {
1597     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1598   }
1599   for (i=0;i<maxneighs;i++) {
1600     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1601     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1602     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1603   }
1604   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1605   PetscFunctionReturn(0);
1606 }
1607 
1608 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1609 {
1610   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1611   PetscErrorCode ierr;
1612 
1613   PetscFunctionBegin;
1614   if (primalv) {
1615     if (pcbddc->user_primal_vertices_local) {
1616       IS list[2], newp;
1617 
1618       list[0] = primalv;
1619       list[1] = pcbddc->user_primal_vertices_local;
1620       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1621       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1622       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1623       pcbddc->user_primal_vertices_local = newp;
1624     } else {
1625       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1626     }
1627   }
1628   PetscFunctionReturn(0);
1629 }
1630 
1631 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1632 {
1633   PetscErrorCode ierr;
1634   Vec            local,global;
1635   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1636   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1637   PetscBool      monolithic = PETSC_FALSE;
1638 
1639   PetscFunctionBegin;
1640   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1641   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1642   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1643   /* need to convert from global to local topology information and remove references to information in global ordering */
1644   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1645   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1646   if (monolithic) { /* just get block size to properly compute vertices */
1647     if (pcbddc->vertex_size == 1) {
1648       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1649     }
1650     goto boundary;
1651   }
1652 
1653   if (pcbddc->user_provided_isfordofs) {
1654     if (pcbddc->n_ISForDofs) {
1655       PetscInt i;
1656       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1657       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1658         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1659         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1660       }
1661       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1662       pcbddc->n_ISForDofs = 0;
1663       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1664     }
1665   } else {
1666     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1667       DM dm;
1668 
1669       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1670       if (!dm) {
1671         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1672       }
1673       if (dm) {
1674         IS      *fields;
1675         PetscInt nf,i;
1676         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1677         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1678         for (i=0;i<nf;i++) {
1679           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1680           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1681         }
1682         ierr = PetscFree(fields);CHKERRQ(ierr);
1683         pcbddc->n_ISForDofsLocal = nf;
1684       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1685         PetscContainer   c;
1686 
1687         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1688         if (c) {
1689           MatISLocalFields lf;
1690           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1691           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1692         } else { /* fallback, create the default fields if bs > 1 */
1693           PetscInt i, n = matis->A->rmap->n;
1694           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1695           if (i > 1) {
1696             pcbddc->n_ISForDofsLocal = i;
1697             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1698             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1699               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1700             }
1701           }
1702         }
1703       }
1704     } else {
1705       PetscInt i;
1706       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1707         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1708       }
1709     }
1710   }
1711 
1712 boundary:
1713   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1714     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1715   } else if (pcbddc->DirichletBoundariesLocal) {
1716     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1717   }
1718   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1719     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1720   } else if (pcbddc->NeumannBoundariesLocal) {
1721     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1722   }
1723   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1724     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1725   }
1726   ierr = VecDestroy(&global);CHKERRQ(ierr);
1727   ierr = VecDestroy(&local);CHKERRQ(ierr);
1728   /* detect local disconnected subdomains if requested (use matis->A) */
1729   if (pcbddc->detect_disconnected) {
1730     IS       primalv = NULL;
1731     PetscInt i;
1732 
1733     for (i=0;i<pcbddc->n_local_subs;i++) {
1734       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1735     }
1736     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1737     ierr = PCBDDCDetectDisconnectedComponents(pc,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1738     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1739     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1740   }
1741   /* early stage corner detection */
1742   {
1743     DM dm;
1744 
1745     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1746     if (dm) {
1747       PetscBool isda;
1748 
1749       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1750       if (isda) {
1751         ISLocalToGlobalMapping l2l;
1752         IS                     corners;
1753         Mat                    lA;
1754 
1755         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1756         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1757         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1758         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1759         if (l2l) {
1760           const PetscInt *idx;
1761           PetscInt       bs,*idxout,n;
1762 
1763           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1764           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1765           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1766           ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1767           ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1768           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1769           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1770           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1771           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1772           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1773         } else { /* not from DMDA */
1774           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1775         }
1776       }
1777     }
1778   }
1779   PetscFunctionReturn(0);
1780 }
1781 
1782 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1783 {
1784   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1785   PetscErrorCode  ierr;
1786   IS              nis;
1787   const PetscInt  *idxs;
1788   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1789   PetscBool       *ld;
1790 
1791   PetscFunctionBegin;
1792   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1793   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1794   if (mop == MPI_LAND) {
1795     /* init rootdata with true */
1796     ld   = (PetscBool*) matis->sf_rootdata;
1797     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1798   } else {
1799     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1800   }
1801   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1802   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1803   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1804   ld   = (PetscBool*) matis->sf_leafdata;
1805   for (i=0;i<nd;i++)
1806     if (-1 < idxs[i] && idxs[i] < n)
1807       ld[idxs[i]] = PETSC_TRUE;
1808   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1809   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1810   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1811   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1812   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1813   if (mop == MPI_LAND) {
1814     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1815   } else {
1816     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1817   }
1818   for (i=0,nnd=0;i<n;i++)
1819     if (ld[i])
1820       nidxs[nnd++] = i;
1821   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1822   ierr = ISDestroy(is);CHKERRQ(ierr);
1823   *is  = nis;
1824   PetscFunctionReturn(0);
1825 }
1826 
1827 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1828 {
1829   PC_IS             *pcis = (PC_IS*)(pc->data);
1830   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1831   PetscErrorCode    ierr;
1832 
1833   PetscFunctionBegin;
1834   if (!pcbddc->benign_have_null) {
1835     PetscFunctionReturn(0);
1836   }
1837   if (pcbddc->ChangeOfBasisMatrix) {
1838     Vec swap;
1839 
1840     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1841     swap = pcbddc->work_change;
1842     pcbddc->work_change = r;
1843     r = swap;
1844   }
1845   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1846   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1847   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1848   ierr = VecSet(z,0.);CHKERRQ(ierr);
1849   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1850   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1851   if (pcbddc->ChangeOfBasisMatrix) {
1852     pcbddc->work_change = r;
1853     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1854     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1855   }
1856   PetscFunctionReturn(0);
1857 }
1858 
1859 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1860 {
1861   PCBDDCBenignMatMult_ctx ctx;
1862   PetscErrorCode          ierr;
1863   PetscBool               apply_right,apply_left,reset_x;
1864 
1865   PetscFunctionBegin;
1866   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1867   if (transpose) {
1868     apply_right = ctx->apply_left;
1869     apply_left = ctx->apply_right;
1870   } else {
1871     apply_right = ctx->apply_right;
1872     apply_left = ctx->apply_left;
1873   }
1874   reset_x = PETSC_FALSE;
1875   if (apply_right) {
1876     const PetscScalar *ax;
1877     PetscInt          nl,i;
1878 
1879     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1880     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1881     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1882     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1883     for (i=0;i<ctx->benign_n;i++) {
1884       PetscScalar    sum,val;
1885       const PetscInt *idxs;
1886       PetscInt       nz,j;
1887       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1888       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1889       sum = 0.;
1890       if (ctx->apply_p0) {
1891         val = ctx->work[idxs[nz-1]];
1892         for (j=0;j<nz-1;j++) {
1893           sum += ctx->work[idxs[j]];
1894           ctx->work[idxs[j]] += val;
1895         }
1896       } else {
1897         for (j=0;j<nz-1;j++) {
1898           sum += ctx->work[idxs[j]];
1899         }
1900       }
1901       ctx->work[idxs[nz-1]] -= sum;
1902       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1903     }
1904     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1905     reset_x = PETSC_TRUE;
1906   }
1907   if (transpose) {
1908     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1909   } else {
1910     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1911   }
1912   if (reset_x) {
1913     ierr = VecResetArray(x);CHKERRQ(ierr);
1914   }
1915   if (apply_left) {
1916     PetscScalar *ay;
1917     PetscInt    i;
1918 
1919     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1920     for (i=0;i<ctx->benign_n;i++) {
1921       PetscScalar    sum,val;
1922       const PetscInt *idxs;
1923       PetscInt       nz,j;
1924       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1925       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1926       val = -ay[idxs[nz-1]];
1927       if (ctx->apply_p0) {
1928         sum = 0.;
1929         for (j=0;j<nz-1;j++) {
1930           sum += ay[idxs[j]];
1931           ay[idxs[j]] += val;
1932         }
1933         ay[idxs[nz-1]] += sum;
1934       } else {
1935         for (j=0;j<nz-1;j++) {
1936           ay[idxs[j]] += val;
1937         }
1938         ay[idxs[nz-1]] = 0.;
1939       }
1940       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1941     }
1942     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1943   }
1944   PetscFunctionReturn(0);
1945 }
1946 
1947 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1948 {
1949   PetscErrorCode ierr;
1950 
1951   PetscFunctionBegin;
1952   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1953   PetscFunctionReturn(0);
1954 }
1955 
1956 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1957 {
1958   PetscErrorCode ierr;
1959 
1960   PetscFunctionBegin;
1961   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1962   PetscFunctionReturn(0);
1963 }
1964 
1965 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1966 {
1967   PC_IS                   *pcis = (PC_IS*)pc->data;
1968   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1969   PCBDDCBenignMatMult_ctx ctx;
1970   PetscErrorCode          ierr;
1971 
1972   PetscFunctionBegin;
1973   if (!restore) {
1974     Mat                A_IB,A_BI;
1975     PetscScalar        *work;
1976     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1977 
1978     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1979     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1980     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1981     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1982     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1983     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1984     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1985     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1986     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1987     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1988     ctx->apply_left = PETSC_TRUE;
1989     ctx->apply_right = PETSC_FALSE;
1990     ctx->apply_p0 = PETSC_FALSE;
1991     ctx->benign_n = pcbddc->benign_n;
1992     if (reuse) {
1993       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1994       ctx->free = PETSC_FALSE;
1995     } else { /* TODO: could be optimized for successive solves */
1996       ISLocalToGlobalMapping N_to_D;
1997       PetscInt               i;
1998 
1999       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2000       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2001       for (i=0;i<pcbddc->benign_n;i++) {
2002         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2003       }
2004       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2005       ctx->free = PETSC_TRUE;
2006     }
2007     ctx->A = pcis->A_IB;
2008     ctx->work = work;
2009     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2010     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2011     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2012     pcis->A_IB = A_IB;
2013 
2014     /* A_BI as A_IB^T */
2015     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2016     pcbddc->benign_original_mat = pcis->A_BI;
2017     pcis->A_BI = A_BI;
2018   } else {
2019     if (!pcbddc->benign_original_mat) {
2020       PetscFunctionReturn(0);
2021     }
2022     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2023     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2024     pcis->A_IB = ctx->A;
2025     ctx->A = NULL;
2026     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2027     pcis->A_BI = pcbddc->benign_original_mat;
2028     pcbddc->benign_original_mat = NULL;
2029     if (ctx->free) {
2030       PetscInt i;
2031       for (i=0;i<ctx->benign_n;i++) {
2032         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2033       }
2034       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2035     }
2036     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2037     ierr = PetscFree(ctx);CHKERRQ(ierr);
2038   }
2039   PetscFunctionReturn(0);
2040 }
2041 
2042 /* used just in bddc debug mode */
2043 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2044 {
2045   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2046   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2047   Mat            An;
2048   PetscErrorCode ierr;
2049 
2050   PetscFunctionBegin;
2051   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2052   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2053   if (is1) {
2054     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2055     ierr = MatDestroy(&An);CHKERRQ(ierr);
2056   } else {
2057     *B = An;
2058   }
2059   PetscFunctionReturn(0);
2060 }
2061 
2062 /* TODO: add reuse flag */
2063 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2064 {
2065   Mat            Bt;
2066   PetscScalar    *a,*bdata;
2067   const PetscInt *ii,*ij;
2068   PetscInt       m,n,i,nnz,*bii,*bij;
2069   PetscBool      flg_row;
2070   PetscErrorCode ierr;
2071 
2072   PetscFunctionBegin;
2073   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2074   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2075   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2076   nnz = n;
2077   for (i=0;i<ii[n];i++) {
2078     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2079   }
2080   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2081   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2082   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2083   nnz = 0;
2084   bii[0] = 0;
2085   for (i=0;i<n;i++) {
2086     PetscInt j;
2087     for (j=ii[i];j<ii[i+1];j++) {
2088       PetscScalar entry = a[j];
2089       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2090         bij[nnz] = ij[j];
2091         bdata[nnz] = entry;
2092         nnz++;
2093       }
2094     }
2095     bii[i+1] = nnz;
2096   }
2097   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2098   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2099   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2100   {
2101     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2102     b->free_a = PETSC_TRUE;
2103     b->free_ij = PETSC_TRUE;
2104   }
2105   if (*B == A) {
2106     ierr = MatDestroy(&A);CHKERRQ(ierr);
2107   }
2108   *B = Bt;
2109   PetscFunctionReturn(0);
2110 }
2111 
2112 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2113 {
2114   Mat                    B = NULL;
2115   DM                     dm;
2116   IS                     is_dummy,*cc_n;
2117   ISLocalToGlobalMapping l2gmap_dummy;
2118   PCBDDCGraph            graph;
2119   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2120   PetscInt               i,n;
2121   PetscInt               *xadj,*adjncy;
2122   PetscBool              isplex = PETSC_FALSE;
2123   PetscErrorCode         ierr;
2124 
2125   PetscFunctionBegin;
2126   if (ncc) *ncc = 0;
2127   if (cc) *cc = NULL;
2128   if (primalv) *primalv = NULL;
2129   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2130   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2131   if (!dm) {
2132     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2133   }
2134   if (dm) {
2135     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2136   }
2137   if (isplex) { /* this code has been modified from plexpartition.c */
2138     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2139     PetscInt      *adj = NULL;
2140     IS             cellNumbering;
2141     const PetscInt *cellNum;
2142     PetscBool      useCone, useClosure;
2143     PetscSection   section;
2144     PetscSegBuffer adjBuffer;
2145     PetscSF        sfPoint;
2146     PetscErrorCode ierr;
2147 
2148     PetscFunctionBegin;
2149     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2150     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2151     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2152     /* Build adjacency graph via a section/segbuffer */
2153     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2154     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2155     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2156     /* Always use FVM adjacency to create partitioner graph */
2157     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2158     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2159     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2160     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2161     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2162     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2163     for (n = 0, p = pStart; p < pEnd; p++) {
2164       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2165       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2166       adjSize = PETSC_DETERMINE;
2167       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2168       for (a = 0; a < adjSize; ++a) {
2169         const PetscInt point = adj[a];
2170         if (pStart <= point && point < pEnd) {
2171           PetscInt *PETSC_RESTRICT pBuf;
2172           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2173           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2174           *pBuf = point;
2175         }
2176       }
2177       n++;
2178     }
2179     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2180     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2181     /* Derive CSR graph from section/segbuffer */
2182     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2183     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2184     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2185     for (idx = 0, p = pStart; p < pEnd; p++) {
2186       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2187       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2188     }
2189     xadj[n] = size;
2190     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2191     /* Clean up */
2192     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2193     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2194     ierr = PetscFree(adj);CHKERRQ(ierr);
2195     graph->xadj = xadj;
2196     graph->adjncy = adjncy;
2197   } else {
2198     Mat       A;
2199     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2200 
2201     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2202     if (!A->rmap->N || !A->cmap->N) {
2203       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2204       PetscFunctionReturn(0);
2205     }
2206     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2207     if (!isseqaij && filter) {
2208       PetscBool isseqdense;
2209 
2210       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2211       if (!isseqdense) {
2212         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2213       } else { /* TODO: rectangular case and LDA */
2214         PetscScalar *array;
2215         PetscReal   chop=1.e-6;
2216 
2217         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2218         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2219         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2220         for (i=0;i<n;i++) {
2221           PetscInt j;
2222           for (j=i+1;j<n;j++) {
2223             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2224             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2225             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2226           }
2227         }
2228         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2229         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2230       }
2231     } else {
2232       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2233       B = A;
2234     }
2235     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2236 
2237     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2238     if (filter) {
2239       PetscScalar *data;
2240       PetscInt    j,cum;
2241 
2242       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2243       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2244       cum = 0;
2245       for (i=0;i<n;i++) {
2246         PetscInt t;
2247 
2248         for (j=xadj[i];j<xadj[i+1];j++) {
2249           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2250             continue;
2251           }
2252           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2253         }
2254         t = xadj_filtered[i];
2255         xadj_filtered[i] = cum;
2256         cum += t;
2257       }
2258       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2259       graph->xadj = xadj_filtered;
2260       graph->adjncy = adjncy_filtered;
2261     } else {
2262       graph->xadj = xadj;
2263       graph->adjncy = adjncy;
2264     }
2265   }
2266   /* compute local connected components using PCBDDCGraph */
2267   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2268   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2269   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2270   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2271   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2272   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2273   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2274 
2275   /* partial clean up */
2276   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2277   if (B) {
2278     PetscBool flg_row;
2279     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2280     ierr = MatDestroy(&B);CHKERRQ(ierr);
2281   }
2282   if (isplex) {
2283     ierr = PetscFree(xadj);CHKERRQ(ierr);
2284     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2285   }
2286 
2287   /* get back data */
2288   if (isplex) {
2289     if (ncc) *ncc = graph->ncc;
2290     if (cc || primalv) {
2291       Mat          A;
2292       PetscBT      btv,btvt;
2293       PetscSection subSection;
2294       PetscInt     *ids,cum,cump,*cids,*pids;
2295 
2296       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2297       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2298       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2299       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2300       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2301 
2302       cids[0] = 0;
2303       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2304         PetscInt j;
2305 
2306         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2307         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2308           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2309 
2310           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2311           for (k = 0; k < 2*size; k += 2) {
2312             PetscInt s, p = closure[k], off, dof, cdof;
2313 
2314             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2315             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2316             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2317             for (s = 0; s < dof-cdof; s++) {
2318               if (PetscBTLookupSet(btvt,off+s)) continue;
2319               if (!PetscBTLookup(btv,off+s)) {
2320                 ids[cum++] = off+s;
2321               } else { /* cross-vertex */
2322                 pids[cump++] = off+s;
2323               }
2324             }
2325           }
2326           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2327         }
2328         cids[i+1] = cum;
2329         /* mark dofs as already assigned */
2330         for (j = cids[i]; j < cids[i+1]; j++) {
2331           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2332         }
2333       }
2334       if (cc) {
2335         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2336         for (i = 0; i < graph->ncc; i++) {
2337           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2338         }
2339         *cc = cc_n;
2340       }
2341       if (primalv) {
2342         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2343       }
2344       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2345       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2346       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2347     }
2348   } else {
2349     if (ncc) *ncc = graph->ncc;
2350     if (cc) {
2351       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2352       for (i=0;i<graph->ncc;i++) {
2353         ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2354       }
2355       *cc = cc_n;
2356     }
2357   }
2358   /* clean up graph */
2359   graph->xadj = 0;
2360   graph->adjncy = 0;
2361   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2362   PetscFunctionReturn(0);
2363 }
2364 
2365 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2366 {
2367   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2368   PC_IS*         pcis = (PC_IS*)(pc->data);
2369   IS             dirIS = NULL;
2370   PetscInt       i;
2371   PetscErrorCode ierr;
2372 
2373   PetscFunctionBegin;
2374   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2375   if (zerodiag) {
2376     Mat            A;
2377     Vec            vec3_N;
2378     PetscScalar    *vals;
2379     const PetscInt *idxs;
2380     PetscInt       nz,*count;
2381 
2382     /* p0 */
2383     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2384     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2385     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2386     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2387     for (i=0;i<nz;i++) vals[i] = 1.;
2388     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2389     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2390     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2391     /* v_I */
2392     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2393     for (i=0;i<nz;i++) vals[i] = 0.;
2394     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2395     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2396     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2397     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2398     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2399     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2400     if (dirIS) {
2401       PetscInt n;
2402 
2403       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2404       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2405       for (i=0;i<n;i++) vals[i] = 0.;
2406       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2407       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2408     }
2409     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2410     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2411     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2412     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2413     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2414     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2415     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2416     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2417     ierr = PetscFree(vals);CHKERRQ(ierr);
2418     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2419 
2420     /* there should not be any pressure dofs lying on the interface */
2421     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2422     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2423     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2424     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2425     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2426     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %d is an interface dof",idxs[i]);
2427     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2428     ierr = PetscFree(count);CHKERRQ(ierr);
2429   }
2430   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2431 
2432   /* check PCBDDCBenignGetOrSetP0 */
2433   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2434   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2435   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2436   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2437   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2438   for (i=0;i<pcbddc->benign_n;i++) {
2439     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2440     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2441   }
2442   PetscFunctionReturn(0);
2443 }
2444 
2445 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2446 {
2447   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2448   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2449   PetscInt       nz,n;
2450   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2451   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2452   PetscErrorCode ierr;
2453 
2454   PetscFunctionBegin;
2455   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2456   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2457   for (n=0;n<pcbddc->benign_n;n++) {
2458     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2459   }
2460   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2461   pcbddc->benign_n = 0;
2462 
2463   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2464      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2465      Checks if all the pressure dofs in each subdomain have a zero diagonal
2466      If not, a change of basis on pressures is not needed
2467      since the local Schur complements are already SPD
2468   */
2469   has_null_pressures = PETSC_TRUE;
2470   have_null = PETSC_TRUE;
2471   if (pcbddc->n_ISForDofsLocal) {
2472     IS       iP = NULL;
2473     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2474 
2475     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2476     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2477     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2478     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2479     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2480     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2481     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2482     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2483     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2484     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2485     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2486     if (iP) {
2487       IS newpressures;
2488 
2489       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2490       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2491       pressures = newpressures;
2492     }
2493     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2494     if (!sorted) {
2495       ierr = ISSort(pressures);CHKERRQ(ierr);
2496     }
2497   } else {
2498     pressures = NULL;
2499   }
2500   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2501   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2502   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2503   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2504   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2505   if (!sorted) {
2506     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2507   }
2508   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2509   zerodiag_save = zerodiag;
2510   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2511   if (!nz) {
2512     if (n) have_null = PETSC_FALSE;
2513     has_null_pressures = PETSC_FALSE;
2514     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2515   }
2516   recompute_zerodiag = PETSC_FALSE;
2517   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2518   zerodiag_subs    = NULL;
2519   pcbddc->benign_n = 0;
2520   n_interior_dofs  = 0;
2521   interior_dofs    = NULL;
2522   nneu             = 0;
2523   if (pcbddc->NeumannBoundariesLocal) {
2524     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2525   }
2526   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2527   if (checkb) { /* need to compute interior nodes */
2528     PetscInt n,i,j;
2529     PetscInt n_neigh,*neigh,*n_shared,**shared;
2530     PetscInt *iwork;
2531 
2532     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2533     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2534     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2535     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2536     for (i=1;i<n_neigh;i++)
2537       for (j=0;j<n_shared[i];j++)
2538           iwork[shared[i][j]] += 1;
2539     for (i=0;i<n;i++)
2540       if (!iwork[i])
2541         interior_dofs[n_interior_dofs++] = i;
2542     ierr = PetscFree(iwork);CHKERRQ(ierr);
2543     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2544   }
2545   if (has_null_pressures) {
2546     IS             *subs;
2547     PetscInt       nsubs,i,j,nl;
2548     const PetscInt *idxs;
2549     PetscScalar    *array;
2550     Vec            *work;
2551     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2552 
2553     subs  = pcbddc->local_subs;
2554     nsubs = pcbddc->n_local_subs;
2555     /* 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) */
2556     if (checkb) {
2557       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2558       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2559       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2560       /* work[0] = 1_p */
2561       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2562       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2563       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2564       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2565       /* work[0] = 1_v */
2566       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2567       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2568       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2569       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2570       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2571     }
2572     if (nsubs > 1) {
2573       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2574       for (i=0;i<nsubs;i++) {
2575         ISLocalToGlobalMapping l2g;
2576         IS                     t_zerodiag_subs;
2577         PetscInt               nl;
2578 
2579         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2580         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2581         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2582         if (nl) {
2583           PetscBool valid = PETSC_TRUE;
2584 
2585           if (checkb) {
2586             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2587             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2588             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2589             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2590             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2591             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2592             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2593             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2594             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2595             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2596             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2597             for (j=0;j<n_interior_dofs;j++) {
2598               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2599                 valid = PETSC_FALSE;
2600                 break;
2601               }
2602             }
2603             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2604           }
2605           if (valid && nneu) {
2606             const PetscInt *idxs;
2607             PetscInt       nzb;
2608 
2609             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2610             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2611             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2612             if (nzb) valid = PETSC_FALSE;
2613           }
2614           if (valid && pressures) {
2615             IS t_pressure_subs;
2616             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2617             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2618             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2619           }
2620           if (valid) {
2621             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2622             pcbddc->benign_n++;
2623           } else {
2624             recompute_zerodiag = PETSC_TRUE;
2625           }
2626         }
2627         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2628         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2629       }
2630     } else { /* there's just one subdomain (or zero if they have not been detected */
2631       PetscBool valid = PETSC_TRUE;
2632 
2633       if (nneu) valid = PETSC_FALSE;
2634       if (valid && pressures) {
2635         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2636       }
2637       if (valid && checkb) {
2638         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2639         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2640         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2641         for (j=0;j<n_interior_dofs;j++) {
2642           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2643             valid = PETSC_FALSE;
2644             break;
2645           }
2646         }
2647         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2648       }
2649       if (valid) {
2650         pcbddc->benign_n = 1;
2651         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2652         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2653         zerodiag_subs[0] = zerodiag;
2654       }
2655     }
2656     if (checkb) {
2657       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2658     }
2659   }
2660   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2661 
2662   if (!pcbddc->benign_n) {
2663     PetscInt n;
2664 
2665     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2666     recompute_zerodiag = PETSC_FALSE;
2667     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2668     if (n) {
2669       has_null_pressures = PETSC_FALSE;
2670       have_null = PETSC_FALSE;
2671     }
2672   }
2673 
2674   /* final check for null pressures */
2675   if (zerodiag && pressures) {
2676     PetscInt nz,np;
2677     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2678     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2679     if (nz != np) have_null = PETSC_FALSE;
2680   }
2681 
2682   if (recompute_zerodiag) {
2683     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2684     if (pcbddc->benign_n == 1) {
2685       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2686       zerodiag = zerodiag_subs[0];
2687     } else {
2688       PetscInt i,nzn,*new_idxs;
2689 
2690       nzn = 0;
2691       for (i=0;i<pcbddc->benign_n;i++) {
2692         PetscInt ns;
2693         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2694         nzn += ns;
2695       }
2696       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2697       nzn = 0;
2698       for (i=0;i<pcbddc->benign_n;i++) {
2699         PetscInt ns,*idxs;
2700         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2701         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2702         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2703         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2704         nzn += ns;
2705       }
2706       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2707       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2708     }
2709     have_null = PETSC_FALSE;
2710   }
2711 
2712   /* Prepare matrix to compute no-net-flux */
2713   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2714     Mat                    A,loc_divudotp;
2715     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2716     IS                     row,col,isused = NULL;
2717     PetscInt               M,N,n,st,n_isused;
2718 
2719     if (pressures) {
2720       isused = pressures;
2721     } else {
2722       isused = zerodiag_save;
2723     }
2724     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2725     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2726     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2727     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2728     n_isused = 0;
2729     if (isused) {
2730       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2731     }
2732     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2733     st = st-n_isused;
2734     if (n) {
2735       const PetscInt *gidxs;
2736 
2737       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2738       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2739       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2740       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2741       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2742       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2743     } else {
2744       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2745       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2746       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2747     }
2748     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2749     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2750     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2751     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2752     ierr = ISDestroy(&row);CHKERRQ(ierr);
2753     ierr = ISDestroy(&col);CHKERRQ(ierr);
2754     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2755     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2756     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2757     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2758     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2759     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2760     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2761     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2762     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2763     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2764   }
2765   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2766 
2767   /* change of basis and p0 dofs */
2768   if (has_null_pressures) {
2769     IS             zerodiagc;
2770     const PetscInt *idxs,*idxsc;
2771     PetscInt       i,s,*nnz;
2772 
2773     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2774     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2775     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2776     /* local change of basis for pressures */
2777     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2778     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2779     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2780     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2781     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2782     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2783     for (i=0;i<pcbddc->benign_n;i++) {
2784       PetscInt nzs,j;
2785 
2786       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2787       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2788       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2789       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2790       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2791     }
2792     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2793     ierr = PetscFree(nnz);CHKERRQ(ierr);
2794     /* set identity on velocities */
2795     for (i=0;i<n-nz;i++) {
2796       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2797     }
2798     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2799     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2800     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2801     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2802     /* set change on pressures */
2803     for (s=0;s<pcbddc->benign_n;s++) {
2804       PetscScalar *array;
2805       PetscInt    nzs;
2806 
2807       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2808       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2809       for (i=0;i<nzs-1;i++) {
2810         PetscScalar vals[2];
2811         PetscInt    cols[2];
2812 
2813         cols[0] = idxs[i];
2814         cols[1] = idxs[nzs-1];
2815         vals[0] = 1.;
2816         vals[1] = 1.;
2817         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2818       }
2819       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2820       for (i=0;i<nzs-1;i++) array[i] = -1.;
2821       array[nzs-1] = 1.;
2822       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2823       /* store local idxs for p0 */
2824       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2825       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2826       ierr = PetscFree(array);CHKERRQ(ierr);
2827     }
2828     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2829     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2830     /* project if needed */
2831     if (pcbddc->benign_change_explicit) {
2832       Mat M;
2833 
2834       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2835       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2836       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2837       ierr = MatDestroy(&M);CHKERRQ(ierr);
2838     }
2839     /* store global idxs for p0 */
2840     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2841   }
2842   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2843   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2844 
2845   /* determines if the coarse solver will be singular or not */
2846   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2847   /* determines if the problem has subdomains with 0 pressure block */
2848   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2849   *zerodiaglocal = zerodiag;
2850   PetscFunctionReturn(0);
2851 }
2852 
2853 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2854 {
2855   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2856   PetscScalar    *array;
2857   PetscErrorCode ierr;
2858 
2859   PetscFunctionBegin;
2860   if (!pcbddc->benign_sf) {
2861     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2862     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2863   }
2864   if (get) {
2865     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2866     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2867     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2868     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2869   } else {
2870     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2871     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2872     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2873     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2874   }
2875   PetscFunctionReturn(0);
2876 }
2877 
2878 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2879 {
2880   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2881   PetscErrorCode ierr;
2882 
2883   PetscFunctionBegin;
2884   /* TODO: add error checking
2885     - avoid nested pop (or push) calls.
2886     - cannot push before pop.
2887     - cannot call this if pcbddc->local_mat is NULL
2888   */
2889   if (!pcbddc->benign_n) {
2890     PetscFunctionReturn(0);
2891   }
2892   if (pop) {
2893     if (pcbddc->benign_change_explicit) {
2894       IS       is_p0;
2895       MatReuse reuse;
2896 
2897       /* extract B_0 */
2898       reuse = MAT_INITIAL_MATRIX;
2899       if (pcbddc->benign_B0) {
2900         reuse = MAT_REUSE_MATRIX;
2901       }
2902       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2903       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2904       /* remove rows and cols from local problem */
2905       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2906       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2907       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2908       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2909     } else {
2910       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2911       PetscScalar *vals;
2912       PetscInt    i,n,*idxs_ins;
2913 
2914       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2915       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2916       if (!pcbddc->benign_B0) {
2917         PetscInt *nnz;
2918         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2919         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2920         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2921         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2922         for (i=0;i<pcbddc->benign_n;i++) {
2923           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2924           nnz[i] = n - nnz[i];
2925         }
2926         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2927         ierr = PetscFree(nnz);CHKERRQ(ierr);
2928       }
2929 
2930       for (i=0;i<pcbddc->benign_n;i++) {
2931         PetscScalar *array;
2932         PetscInt    *idxs,j,nz,cum;
2933 
2934         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2935         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2936         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2937         for (j=0;j<nz;j++) vals[j] = 1.;
2938         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2939         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2940         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2941         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2942         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2943         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2944         cum = 0;
2945         for (j=0;j<n;j++) {
2946           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2947             vals[cum] = array[j];
2948             idxs_ins[cum] = j;
2949             cum++;
2950           }
2951         }
2952         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2953         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2954         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2955       }
2956       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2957       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2958       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2959     }
2960   } else { /* push */
2961     if (pcbddc->benign_change_explicit) {
2962       PetscInt i;
2963 
2964       for (i=0;i<pcbddc->benign_n;i++) {
2965         PetscScalar *B0_vals;
2966         PetscInt    *B0_cols,B0_ncol;
2967 
2968         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2969         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2970         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2971         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2972         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2973       }
2974       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2975       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2976     } else {
2977       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2978     }
2979   }
2980   PetscFunctionReturn(0);
2981 }
2982 
2983 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2984 {
2985   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2986   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2987   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2988   PetscBLASInt    *B_iwork,*B_ifail;
2989   PetscScalar     *work,lwork;
2990   PetscScalar     *St,*S,*eigv;
2991   PetscScalar     *Sarray,*Starray;
2992   PetscReal       *eigs,thresh,lthresh,uthresh;
2993   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2994   PetscBool       allocated_S_St;
2995 #if defined(PETSC_USE_COMPLEX)
2996   PetscReal       *rwork;
2997 #endif
2998   PetscErrorCode  ierr;
2999 
3000   PetscFunctionBegin;
3001   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3002   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3003   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(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);
3004 
3005   if (pcbddc->dbg_flag) {
3006     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3007     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3008     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3009     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3010   }
3011 
3012   if (pcbddc->dbg_flag) {
3013     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
3014   }
3015 
3016   /* max size of subsets */
3017   mss = 0;
3018   for (i=0;i<sub_schurs->n_subs;i++) {
3019     PetscInt subset_size;
3020 
3021     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3022     mss = PetscMax(mss,subset_size);
3023   }
3024 
3025   /* min/max and threshold */
3026   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3027   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3028   nmax = PetscMax(nmin,nmax);
3029   allocated_S_St = PETSC_FALSE;
3030   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3031     allocated_S_St = PETSC_TRUE;
3032   }
3033 
3034   /* allocate lapack workspace */
3035   cum = cum2 = 0;
3036   maxneigs = 0;
3037   for (i=0;i<sub_schurs->n_subs;i++) {
3038     PetscInt n,subset_size;
3039 
3040     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3041     n = PetscMin(subset_size,nmax);
3042     cum += subset_size;
3043     cum2 += subset_size*n;
3044     maxneigs = PetscMax(maxneigs,n);
3045   }
3046   if (mss) {
3047     if (sub_schurs->is_symmetric) {
3048       PetscBLASInt B_itype = 1;
3049       PetscBLASInt B_N = mss;
3050       PetscReal    zero = 0.0;
3051       PetscReal    eps = 0.0; /* dlamch? */
3052 
3053       B_lwork = -1;
3054       S = NULL;
3055       St = NULL;
3056       eigs = NULL;
3057       eigv = NULL;
3058       B_iwork = NULL;
3059       B_ifail = NULL;
3060 #if defined(PETSC_USE_COMPLEX)
3061       rwork = NULL;
3062 #endif
3063       thresh = 1.0;
3064       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3065 #if defined(PETSC_USE_COMPLEX)
3066       PetscStackCallBLAS("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));
3067 #else
3068       PetscStackCallBLAS("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));
3069 #endif
3070       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3071       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3072     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3073   } else {
3074     lwork = 0;
3075   }
3076 
3077   nv = 0;
3078   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) */
3079     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3080   }
3081   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3082   if (allocated_S_St) {
3083     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3084   }
3085   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3086 #if defined(PETSC_USE_COMPLEX)
3087   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3088 #endif
3089   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3090                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3091                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3092                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3093                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3094   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3095 
3096   maxneigs = 0;
3097   cum = cumarray = 0;
3098   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3099   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3100   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3101     const PetscInt *idxs;
3102 
3103     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3104     for (cum=0;cum<nv;cum++) {
3105       pcbddc->adaptive_constraints_n[cum] = 1;
3106       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3107       pcbddc->adaptive_constraints_data[cum] = 1.0;
3108       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3109       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3110     }
3111     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3112   }
3113 
3114   if (mss) { /* multilevel */
3115     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3116     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3117   }
3118 
3119   lthresh = pcbddc->adaptive_threshold[0];
3120   uthresh = pcbddc->adaptive_threshold[1];
3121   for (i=0;i<sub_schurs->n_subs;i++) {
3122     const PetscInt *idxs;
3123     PetscReal      upper,lower;
3124     PetscInt       j,subset_size,eigs_start = 0;
3125     PetscBLASInt   B_N;
3126     PetscBool      same_data = PETSC_FALSE;
3127     PetscBool      scal = PETSC_FALSE;
3128 
3129     if (pcbddc->use_deluxe_scaling) {
3130       upper = PETSC_MAX_REAL;
3131       lower = uthresh;
3132     } else {
3133       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3134       upper = 1./uthresh;
3135       lower = 0.;
3136     }
3137     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3138     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3139     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3140     /* this is experimental: we assume the dofs have been properly grouped to have
3141        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3142     if (!sub_schurs->is_posdef) {
3143       Mat T;
3144 
3145       for (j=0;j<subset_size;j++) {
3146         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3147           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3148           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3149           ierr = MatDestroy(&T);CHKERRQ(ierr);
3150           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3151           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3152           ierr = MatDestroy(&T);CHKERRQ(ierr);
3153           if (sub_schurs->change_primal_sub) {
3154             PetscInt       nz,k;
3155             const PetscInt *idxs;
3156 
3157             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3158             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3159             for (k=0;k<nz;k++) {
3160               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3161               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3162             }
3163             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3164           }
3165           scal = PETSC_TRUE;
3166           break;
3167         }
3168       }
3169     }
3170 
3171     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3172       if (sub_schurs->is_symmetric) {
3173         PetscInt j,k;
3174         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3175           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3176           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3177         }
3178         for (j=0;j<subset_size;j++) {
3179           for (k=j;k<subset_size;k++) {
3180             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3181             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3182           }
3183         }
3184       } else {
3185         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3186         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3187       }
3188     } else {
3189       S = Sarray + cumarray;
3190       St = Starray + cumarray;
3191     }
3192     /* see if we can save some work */
3193     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3194       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3195     }
3196 
3197     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3198       B_neigs = 0;
3199     } else {
3200       if (sub_schurs->is_symmetric) {
3201         PetscBLASInt B_itype = 1;
3202         PetscBLASInt B_IL, B_IU;
3203         PetscReal    eps = -1.0; /* dlamch? */
3204         PetscInt     nmin_s;
3205         PetscBool    compute_range;
3206 
3207         compute_range = (PetscBool)!same_data;
3208         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3209 
3210         if (pcbddc->dbg_flag) {
3211           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d (range %d).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range);CHKERRQ(ierr);
3212         }
3213 
3214         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3215         if (compute_range) {
3216 
3217           /* ask for eigenvalues larger than thresh */
3218           if (sub_schurs->is_posdef) {
3219 #if defined(PETSC_USE_COMPLEX)
3220             PetscStackCallBLAS("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));
3221 #else
3222             PetscStackCallBLAS("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));
3223 #endif
3224           } else { /* no theory so far, but it works nicely */
3225             PetscInt  recipe = 0;
3226             PetscReal bb[2];
3227 
3228             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3229             switch (recipe) {
3230             case 0:
3231               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3232               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3233 #if defined(PETSC_USE_COMPLEX)
3234               PetscStackCallBLAS("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));
3235 #else
3236               PetscStackCallBLAS("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));
3237 #endif
3238               break;
3239             case 1:
3240               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3241 #if defined(PETSC_USE_COMPLEX)
3242               PetscStackCallBLAS("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));
3243 #else
3244               PetscStackCallBLAS("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));
3245 #endif
3246               if (!scal) {
3247                 PetscBLASInt B_neigs2;
3248 
3249                 bb[0] = uthresh; bb[1] = PETSC_MAX_REAL;
3250                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3251                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3252 #if defined(PETSC_USE_COMPLEX)
3253                 PetscStackCallBLAS("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));
3254 #else
3255                 PetscStackCallBLAS("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));
3256 #endif
3257                 B_neigs += B_neigs2;
3258               }
3259               break;
3260             default:
3261               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3262               break;
3263             }
3264           }
3265         } else if (!same_data) { /* this is just to see all the eigenvalues */
3266           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3267           B_IL = 1;
3268 #if defined(PETSC_USE_COMPLEX)
3269           PetscStackCallBLAS("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));
3270 #else
3271           PetscStackCallBLAS("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));
3272 #endif
3273         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3274           PetscInt k;
3275           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3276           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3277           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3278           nmin = nmax;
3279           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3280           for (k=0;k<nmax;k++) {
3281             eigs[k] = 1./PETSC_SMALL;
3282             eigv[k*(subset_size+1)] = 1.0;
3283           }
3284         }
3285         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3286         if (B_ierr) {
3287           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3288           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3289           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3290         }
3291 
3292         if (B_neigs > nmax) {
3293           if (pcbddc->dbg_flag) {
3294             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);CHKERRQ(ierr);
3295           }
3296           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3297           B_neigs = nmax;
3298         }
3299 
3300         nmin_s = PetscMin(nmin,B_N);
3301         if (B_neigs < nmin_s) {
3302           PetscBLASInt B_neigs2;
3303 
3304           if (pcbddc->use_deluxe_scaling) {
3305             if (scal) {
3306               B_IU = nmin_s;
3307               B_IL = B_neigs + 1;
3308             } else {
3309               B_IL = B_N - nmin_s + 1;
3310               B_IU = B_N - B_neigs;
3311             }
3312           } else {
3313             B_IL = B_neigs + 1;
3314             B_IU = nmin_s;
3315           }
3316           if (pcbddc->dbg_flag) {
3317             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %d. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);
3318           }
3319           if (sub_schurs->is_symmetric) {
3320             PetscInt j,k;
3321             for (j=0;j<subset_size;j++) {
3322               for (k=j;k<subset_size;k++) {
3323                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3324                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3325               }
3326             }
3327           } else {
3328             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3329             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3330           }
3331           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3332 #if defined(PETSC_USE_COMPLEX)
3333           PetscStackCallBLAS("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));
3334 #else
3335           PetscStackCallBLAS("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));
3336 #endif
3337           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3338           B_neigs += B_neigs2;
3339         }
3340         if (B_ierr) {
3341           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3342           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3343           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3344         }
3345         if (pcbddc->dbg_flag) {
3346           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3347           for (j=0;j<B_neigs;j++) {
3348             if (eigs[j] == 0.0) {
3349               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3350             } else {
3351               if (pcbddc->use_deluxe_scaling) {
3352                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3353               } else {
3354                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3355               }
3356             }
3357           }
3358         }
3359       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3360     }
3361     /* change the basis back to the original one */
3362     if (sub_schurs->change) {
3363       Mat change,phi,phit;
3364 
3365       if (pcbddc->dbg_flag > 2) {
3366         PetscInt ii;
3367         for (ii=0;ii<B_neigs;ii++) {
3368           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3369           for (j=0;j<B_N;j++) {
3370 #if defined(PETSC_USE_COMPLEX)
3371             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3372             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3373             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3374 #else
3375             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3376 #endif
3377           }
3378         }
3379       }
3380       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3381       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3382       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3383       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3384       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3385       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3386     }
3387     maxneigs = PetscMax(B_neigs,maxneigs);
3388     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3389     if (B_neigs) {
3390       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3391 
3392       if (pcbddc->dbg_flag > 1) {
3393         PetscInt ii;
3394         for (ii=0;ii<B_neigs;ii++) {
3395           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3396           for (j=0;j<B_N;j++) {
3397 #if defined(PETSC_USE_COMPLEX)
3398             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3399             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3400             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3401 #else
3402             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3403 #endif
3404           }
3405         }
3406       }
3407       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3408       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3409       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3410       cum++;
3411     }
3412     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3413     /* shift for next computation */
3414     cumarray += subset_size*subset_size;
3415   }
3416   if (pcbddc->dbg_flag) {
3417     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3418   }
3419 
3420   if (mss) {
3421     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3422     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3423     /* destroy matrices (junk) */
3424     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3425     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3426   }
3427   if (allocated_S_St) {
3428     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3429   }
3430   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3431 #if defined(PETSC_USE_COMPLEX)
3432   ierr = PetscFree(rwork);CHKERRQ(ierr);
3433 #endif
3434   if (pcbddc->dbg_flag) {
3435     PetscInt maxneigs_r;
3436     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3437     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3438   }
3439   PetscFunctionReturn(0);
3440 }
3441 
3442 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3443 {
3444   PetscScalar    *coarse_submat_vals;
3445   PetscErrorCode ierr;
3446 
3447   PetscFunctionBegin;
3448   /* Setup local scatters R_to_B and (optionally) R_to_D */
3449   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3450   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3451 
3452   /* Setup local neumann solver ksp_R */
3453   /* PCBDDCSetUpLocalScatters should be called first! */
3454   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3455 
3456   /*
3457      Setup local correction and local part of coarse basis.
3458      Gives back the dense local part of the coarse matrix in column major ordering
3459   */
3460   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3461 
3462   /* Compute total number of coarse nodes and setup coarse solver */
3463   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3464 
3465   /* free */
3466   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3467   PetscFunctionReturn(0);
3468 }
3469 
3470 PetscErrorCode PCBDDCResetCustomization(PC pc)
3471 {
3472   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3473   PetscErrorCode ierr;
3474 
3475   PetscFunctionBegin;
3476   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3477   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3478   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3479   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3480   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3481   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3482   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3483   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3484   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3485   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3486   PetscFunctionReturn(0);
3487 }
3488 
3489 PetscErrorCode PCBDDCResetTopography(PC pc)
3490 {
3491   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3492   PetscInt       i;
3493   PetscErrorCode ierr;
3494 
3495   PetscFunctionBegin;
3496   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3497   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3498   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3499   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3500   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3501   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3502   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3503   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3504   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3505   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3506   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3507   for (i=0;i<pcbddc->n_local_subs;i++) {
3508     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3509   }
3510   pcbddc->n_local_subs = 0;
3511   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3512   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3513   pcbddc->graphanalyzed        = PETSC_FALSE;
3514   pcbddc->recompute_topography = PETSC_TRUE;
3515   PetscFunctionReturn(0);
3516 }
3517 
3518 PetscErrorCode PCBDDCResetSolvers(PC pc)
3519 {
3520   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3521   PetscErrorCode ierr;
3522 
3523   PetscFunctionBegin;
3524   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3525   if (pcbddc->coarse_phi_B) {
3526     PetscScalar *array;
3527     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3528     ierr = PetscFree(array);CHKERRQ(ierr);
3529   }
3530   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3531   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3532   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3533   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3534   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3535   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3536   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3537   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3538   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3539   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3540   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3541   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3542   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3543   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3544   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3545   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3546   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3547   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3548   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3549   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3550   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3551   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3552   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3553   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3554   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3555   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3556   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3557   if (pcbddc->benign_zerodiag_subs) {
3558     PetscInt i;
3559     for (i=0;i<pcbddc->benign_n;i++) {
3560       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3561     }
3562     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3563   }
3564   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3565   PetscFunctionReturn(0);
3566 }
3567 
3568 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3569 {
3570   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3571   PC_IS          *pcis = (PC_IS*)pc->data;
3572   VecType        impVecType;
3573   PetscInt       n_constraints,n_R,old_size;
3574   PetscErrorCode ierr;
3575 
3576   PetscFunctionBegin;
3577   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3578   n_R = pcis->n - pcbddc->n_vertices;
3579   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3580   /* local work vectors (try to avoid unneeded work)*/
3581   /* R nodes */
3582   old_size = -1;
3583   if (pcbddc->vec1_R) {
3584     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3585   }
3586   if (n_R != old_size) {
3587     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3588     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3589     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3590     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3591     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3592     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3593   }
3594   /* local primal dofs */
3595   old_size = -1;
3596   if (pcbddc->vec1_P) {
3597     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3598   }
3599   if (pcbddc->local_primal_size != old_size) {
3600     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3601     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3602     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3603     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3604   }
3605   /* local explicit constraints */
3606   old_size = -1;
3607   if (pcbddc->vec1_C) {
3608     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3609   }
3610   if (n_constraints && n_constraints != old_size) {
3611     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3612     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3613     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3614     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3615   }
3616   PetscFunctionReturn(0);
3617 }
3618 
3619 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3620 {
3621   PetscErrorCode  ierr;
3622   /* pointers to pcis and pcbddc */
3623   PC_IS*          pcis = (PC_IS*)pc->data;
3624   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3625   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3626   /* submatrices of local problem */
3627   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3628   /* submatrices of local coarse problem */
3629   Mat             S_VV,S_CV,S_VC,S_CC;
3630   /* working matrices */
3631   Mat             C_CR;
3632   /* additional working stuff */
3633   PC              pc_R;
3634   Mat             F,Brhs = NULL;
3635   Vec             dummy_vec;
3636   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3637   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3638   PetscScalar     *work;
3639   PetscInt        *idx_V_B;
3640   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3641   PetscInt        i,n_R,n_D,n_B;
3642 
3643   /* some shortcuts to scalars */
3644   PetscScalar     one=1.0,m_one=-1.0;
3645 
3646   PetscFunctionBegin;
3647   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3648 
3649   /* Set Non-overlapping dimensions */
3650   n_vertices = pcbddc->n_vertices;
3651   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3652   n_B = pcis->n_B;
3653   n_D = pcis->n - n_B;
3654   n_R = pcis->n - n_vertices;
3655 
3656   /* vertices in boundary numbering */
3657   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3658   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3659   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3660 
3661   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3662   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3663   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3664   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3665   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3666   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3667   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3668   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3669   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3670   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3671 
3672   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3673   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3674   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3675   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3676   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3677   lda_rhs = n_R;
3678   need_benign_correction = PETSC_FALSE;
3679   if (isLU || isILU || isCHOL) {
3680     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3681   } else if (sub_schurs && sub_schurs->reuse_solver) {
3682     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3683     MatFactorType      type;
3684 
3685     F = reuse_solver->F;
3686     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3687     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3688     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3689     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3690   } else {
3691     F = NULL;
3692   }
3693 
3694   /* determine if we can use a sparse right-hand side */
3695   sparserhs = PETSC_FALSE;
3696   if (F) {
3697     MatSolverType solver;
3698 
3699     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3700     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3701   }
3702 
3703   /* allocate workspace */
3704   n = 0;
3705   if (n_constraints) {
3706     n += lda_rhs*n_constraints;
3707   }
3708   if (n_vertices) {
3709     n = PetscMax(2*lda_rhs*n_vertices,n);
3710     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3711   }
3712   if (!pcbddc->symmetric_primal) {
3713     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3714   }
3715   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3716 
3717   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3718   dummy_vec = NULL;
3719   if (need_benign_correction && lda_rhs != n_R && F) {
3720     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3721   }
3722 
3723   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3724   if (n_constraints) {
3725     Mat         M3,C_B;
3726     IS          is_aux;
3727     PetscScalar *array,*array2;
3728 
3729     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3730     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3731 
3732     /* Extract constraints on R nodes: C_{CR}  */
3733     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3734     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3735     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3736 
3737     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3738     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3739     if (!sparserhs) {
3740       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3741       for (i=0;i<n_constraints;i++) {
3742         const PetscScalar *row_cmat_values;
3743         const PetscInt    *row_cmat_indices;
3744         PetscInt          size_of_constraint,j;
3745 
3746         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3747         for (j=0;j<size_of_constraint;j++) {
3748           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3749         }
3750         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3751       }
3752       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3753     } else {
3754       Mat tC_CR;
3755 
3756       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3757       if (lda_rhs != n_R) {
3758         PetscScalar *aa;
3759         PetscInt    r,*ii,*jj;
3760         PetscBool   done;
3761 
3762         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3763         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3764         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3765         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3766         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3767         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3768       } else {
3769         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3770         tC_CR = C_CR;
3771       }
3772       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3773       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3774     }
3775     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3776     if (F) {
3777       if (need_benign_correction) {
3778         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3779 
3780         /* rhs is already zero on interior dofs, no need to change the rhs */
3781         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3782       }
3783       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3784       if (need_benign_correction) {
3785         PetscScalar        *marr;
3786         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3787 
3788         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3789         if (lda_rhs != n_R) {
3790           for (i=0;i<n_constraints;i++) {
3791             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3792             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3793             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3794           }
3795         } else {
3796           for (i=0;i<n_constraints;i++) {
3797             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3798             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3799             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3800           }
3801         }
3802         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3803       }
3804     } else {
3805       PetscScalar *marr;
3806 
3807       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3808       for (i=0;i<n_constraints;i++) {
3809         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3810         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3811         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3812         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3813         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3814       }
3815       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3816     }
3817     if (sparserhs) {
3818       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3819     }
3820     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3821     if (!pcbddc->switch_static) {
3822       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3823       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3824       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3825       for (i=0;i<n_constraints;i++) {
3826         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3827         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3828         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3829         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3830         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3831         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3832       }
3833       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3834       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3835       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3836     } else {
3837       if (lda_rhs != n_R) {
3838         IS dummy;
3839 
3840         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3841         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3842         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3843       } else {
3844         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3845         pcbddc->local_auxmat2 = local_auxmat2_R;
3846       }
3847       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3848     }
3849     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3850     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3851     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3852     if (isCHOL) {
3853       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3854     } else {
3855       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3856     }
3857     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
3858     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3859     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3860     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3861     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3862     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3863   }
3864 
3865   /* Get submatrices from subdomain matrix */
3866   if (n_vertices) {
3867     IS        is_aux;
3868     PetscBool isseqaij;
3869 
3870     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3871       IS tis;
3872 
3873       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3874       ierr = ISSort(tis);CHKERRQ(ierr);
3875       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3876       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3877     } else {
3878       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3879     }
3880     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3881     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3882     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3883     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
3884       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3885     }
3886     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3887     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3888   }
3889 
3890   /* Matrix of coarse basis functions (local) */
3891   if (pcbddc->coarse_phi_B) {
3892     PetscInt on_B,on_primal,on_D=n_D;
3893     if (pcbddc->coarse_phi_D) {
3894       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3895     }
3896     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3897     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3898       PetscScalar *marray;
3899 
3900       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3901       ierr = PetscFree(marray);CHKERRQ(ierr);
3902       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3903       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3904       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3905       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3906     }
3907   }
3908 
3909   if (!pcbddc->coarse_phi_B) {
3910     PetscScalar *marr;
3911 
3912     /* memory size */
3913     n = n_B*pcbddc->local_primal_size;
3914     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3915     if (!pcbddc->symmetric_primal) n *= 2;
3916     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3917     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3918     marr += n_B*pcbddc->local_primal_size;
3919     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3920       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3921       marr += n_D*pcbddc->local_primal_size;
3922     }
3923     if (!pcbddc->symmetric_primal) {
3924       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3925       marr += n_B*pcbddc->local_primal_size;
3926       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3927         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3928       }
3929     } else {
3930       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3931       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3932       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3933         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3934         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3935       }
3936     }
3937   }
3938 
3939   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3940   p0_lidx_I = NULL;
3941   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3942     const PetscInt *idxs;
3943 
3944     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3945     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3946     for (i=0;i<pcbddc->benign_n;i++) {
3947       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3948     }
3949     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3950   }
3951 
3952   /* vertices */
3953   if (n_vertices) {
3954     PetscBool restoreavr = PETSC_FALSE;
3955 
3956     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3957 
3958     if (n_R) {
3959       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3960       PetscBLASInt B_N,B_one = 1;
3961       PetscScalar  *x,*y;
3962 
3963       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3964       if (need_benign_correction) {
3965         ISLocalToGlobalMapping RtoN;
3966         IS                     is_p0;
3967         PetscInt               *idxs_p0,n;
3968 
3969         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3970         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3971         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3972         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3973         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3974         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3975         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3976         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3977       }
3978 
3979       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3980       if (!sparserhs || need_benign_correction) {
3981         if (lda_rhs == n_R) {
3982           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3983         } else {
3984           PetscScalar    *av,*array;
3985           const PetscInt *xadj,*adjncy;
3986           PetscInt       n;
3987           PetscBool      flg_row;
3988 
3989           array = work+lda_rhs*n_vertices;
3990           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3991           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3992           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3993           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3994           for (i=0;i<n;i++) {
3995             PetscInt j;
3996             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3997           }
3998           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3999           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4000           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4001         }
4002         if (need_benign_correction) {
4003           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4004           PetscScalar        *marr;
4005 
4006           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4007           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4008 
4009                  | 0 0  0 | (V)
4010              L = | 0 0 -1 | (P-p0)
4011                  | 0 0 -1 | (p0)
4012 
4013           */
4014           for (i=0;i<reuse_solver->benign_n;i++) {
4015             const PetscScalar *vals;
4016             const PetscInt    *idxs,*idxs_zero;
4017             PetscInt          n,j,nz;
4018 
4019             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4020             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4021             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4022             for (j=0;j<n;j++) {
4023               PetscScalar val = vals[j];
4024               PetscInt    k,col = idxs[j];
4025               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4026             }
4027             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4028             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4029           }
4030           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4031         }
4032         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4033         Brhs = A_RV;
4034       } else {
4035         Mat tA_RVT,A_RVT;
4036 
4037         if (!pcbddc->symmetric_primal) {
4038           /* A_RV already scaled by -1 */
4039           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4040         } else {
4041           restoreavr = PETSC_TRUE;
4042           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4043           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4044           A_RVT = A_VR;
4045         }
4046         if (lda_rhs != n_R) {
4047           PetscScalar *aa;
4048           PetscInt    r,*ii,*jj;
4049           PetscBool   done;
4050 
4051           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4052           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4053           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4054           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4055           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4056           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4057         } else {
4058           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4059           tA_RVT = A_RVT;
4060         }
4061         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4062         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4063         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4064       }
4065       if (F) {
4066         /* need to correct the rhs */
4067         if (need_benign_correction) {
4068           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4069           PetscScalar        *marr;
4070 
4071           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4072           if (lda_rhs != n_R) {
4073             for (i=0;i<n_vertices;i++) {
4074               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4075               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4076               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4077             }
4078           } else {
4079             for (i=0;i<n_vertices;i++) {
4080               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4081               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4082               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4083             }
4084           }
4085           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4086         }
4087         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4088         if (restoreavr) {
4089           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4090         }
4091         /* need to correct the solution */
4092         if (need_benign_correction) {
4093           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4094           PetscScalar        *marr;
4095 
4096           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4097           if (lda_rhs != n_R) {
4098             for (i=0;i<n_vertices;i++) {
4099               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4100               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4101               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4102             }
4103           } else {
4104             for (i=0;i<n_vertices;i++) {
4105               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4106               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4107               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4108             }
4109           }
4110           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4111         }
4112       } else {
4113         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4114         for (i=0;i<n_vertices;i++) {
4115           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4116           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4117           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4118           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4119           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4120         }
4121         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4122       }
4123       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4124       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4125       /* S_VV and S_CV */
4126       if (n_constraints) {
4127         Mat B;
4128 
4129         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4130         for (i=0;i<n_vertices;i++) {
4131           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4132           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4133           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4134           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4135           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4136           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4137         }
4138         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4139         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4140         ierr = MatDestroy(&B);CHKERRQ(ierr);
4141         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4142         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4143         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4144         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4145         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4146         ierr = MatDestroy(&B);CHKERRQ(ierr);
4147       }
4148       if (lda_rhs != n_R) {
4149         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4150         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4151         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4152       }
4153       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4154       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4155       if (need_benign_correction) {
4156         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4157         PetscScalar      *marr,*sums;
4158 
4159         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4160         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4161         for (i=0;i<reuse_solver->benign_n;i++) {
4162           const PetscScalar *vals;
4163           const PetscInt    *idxs,*idxs_zero;
4164           PetscInt          n,j,nz;
4165 
4166           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4167           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4168           for (j=0;j<n_vertices;j++) {
4169             PetscInt k;
4170             sums[j] = 0.;
4171             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4172           }
4173           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4174           for (j=0;j<n;j++) {
4175             PetscScalar val = vals[j];
4176             PetscInt k;
4177             for (k=0;k<n_vertices;k++) {
4178               marr[idxs[j]+k*n_vertices] += val*sums[k];
4179             }
4180           }
4181           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4182           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4183         }
4184         ierr = PetscFree(sums);CHKERRQ(ierr);
4185         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4186         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4187       }
4188       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4189       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4190       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4191       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4192       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4193       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4194       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4195       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4196       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4197     } else {
4198       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4199     }
4200     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4201 
4202     /* coarse basis functions */
4203     for (i=0;i<n_vertices;i++) {
4204       PetscScalar *y;
4205 
4206       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4207       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4208       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4209       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4210       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4211       y[n_B*i+idx_V_B[i]] = 1.0;
4212       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4213       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4214 
4215       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4216         PetscInt j;
4217 
4218         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4219         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4220         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4221         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4222         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4223         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4224         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4225       }
4226       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4227     }
4228     /* if n_R == 0 the object is not destroyed */
4229     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4230   }
4231   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4232 
4233   if (n_constraints) {
4234     Mat B;
4235 
4236     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4237     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4238     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4239     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4240     if (n_vertices) {
4241       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4242         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4243       } else {
4244         Mat S_VCt;
4245 
4246         if (lda_rhs != n_R) {
4247           ierr = MatDestroy(&B);CHKERRQ(ierr);
4248           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4249           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4250         }
4251         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4252         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4253         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4254       }
4255     }
4256     ierr = MatDestroy(&B);CHKERRQ(ierr);
4257     /* coarse basis functions */
4258     for (i=0;i<n_constraints;i++) {
4259       PetscScalar *y;
4260 
4261       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4262       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4263       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4264       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4265       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4266       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4267       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4268       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4269         PetscInt j;
4270 
4271         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4272         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4273         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4274         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4275         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4276         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4277         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4278       }
4279       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4280     }
4281   }
4282   if (n_constraints) {
4283     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4284   }
4285   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4286 
4287   /* coarse matrix entries relative to B_0 */
4288   if (pcbddc->benign_n) {
4289     Mat         B0_B,B0_BPHI;
4290     IS          is_dummy;
4291     PetscScalar *data;
4292     PetscInt    j;
4293 
4294     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4295     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4296     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4297     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4298     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4299     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4300     for (j=0;j<pcbddc->benign_n;j++) {
4301       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4302       for (i=0;i<pcbddc->local_primal_size;i++) {
4303         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4304         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4305       }
4306     }
4307     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4308     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4309     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4310   }
4311 
4312   /* compute other basis functions for non-symmetric problems */
4313   if (!pcbddc->symmetric_primal) {
4314     Mat         B_V=NULL,B_C=NULL;
4315     PetscScalar *marray;
4316 
4317     if (n_constraints) {
4318       Mat S_CCT,C_CRT;
4319 
4320       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4321       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4322       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4323       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4324       if (n_vertices) {
4325         Mat S_VCT;
4326 
4327         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4328         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4329         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4330       }
4331       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4332     } else {
4333       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4334     }
4335     if (n_vertices && n_R) {
4336       PetscScalar    *av,*marray;
4337       const PetscInt *xadj,*adjncy;
4338       PetscInt       n;
4339       PetscBool      flg_row;
4340 
4341       /* B_V = B_V - A_VR^T */
4342       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4343       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4344       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4345       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4346       for (i=0;i<n;i++) {
4347         PetscInt j;
4348         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4349       }
4350       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4351       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4352       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4353     }
4354 
4355     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4356     if (n_vertices) {
4357       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4358       for (i=0;i<n_vertices;i++) {
4359         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4360         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4361         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4362         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4363         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4364       }
4365       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4366     }
4367     if (B_C) {
4368       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4369       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4370         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4371         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4372         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4373         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4374         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4375       }
4376       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4377     }
4378     /* coarse basis functions */
4379     for (i=0;i<pcbddc->local_primal_size;i++) {
4380       PetscScalar *y;
4381 
4382       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4383       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4384       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4385       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4386       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4387       if (i<n_vertices) {
4388         y[n_B*i+idx_V_B[i]] = 1.0;
4389       }
4390       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4391       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4392 
4393       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4394         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4395         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4396         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4397         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4398         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4399         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4400       }
4401       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4402     }
4403     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4404     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4405   }
4406 
4407   /* free memory */
4408   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4409   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4410   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4411   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4412   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4413   ierr = PetscFree(work);CHKERRQ(ierr);
4414   if (n_vertices) {
4415     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4416   }
4417   if (n_constraints) {
4418     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4419   }
4420   /* Checking coarse_sub_mat and coarse basis functios */
4421   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4422   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4423   if (pcbddc->dbg_flag) {
4424     Mat         coarse_sub_mat;
4425     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4426     Mat         coarse_phi_D,coarse_phi_B;
4427     Mat         coarse_psi_D,coarse_psi_B;
4428     Mat         A_II,A_BB,A_IB,A_BI;
4429     Mat         C_B,CPHI;
4430     IS          is_dummy;
4431     Vec         mones;
4432     MatType     checkmattype=MATSEQAIJ;
4433     PetscReal   real_value;
4434 
4435     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4436       Mat A;
4437       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4438       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4439       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4440       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4441       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4442       ierr = MatDestroy(&A);CHKERRQ(ierr);
4443     } else {
4444       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4445       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4446       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4447       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4448     }
4449     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4450     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4451     if (!pcbddc->symmetric_primal) {
4452       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4453       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4454     }
4455     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4456 
4457     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4458     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4459     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4460     if (!pcbddc->symmetric_primal) {
4461       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4462       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4463       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4464       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4465       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4466       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4467       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4468       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4469       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4470       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4471       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4472       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4473     } else {
4474       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4475       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4476       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4477       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4478       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4479       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4480       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4481       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4482     }
4483     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4484     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4485     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4486     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4487     if (pcbddc->benign_n) {
4488       Mat         B0_B,B0_BPHI;
4489       PetscScalar *data,*data2;
4490       PetscInt    j;
4491 
4492       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4493       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4494       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4495       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4496       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4497       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4498       for (j=0;j<pcbddc->benign_n;j++) {
4499         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4500         for (i=0;i<pcbddc->local_primal_size;i++) {
4501           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4502           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4503         }
4504       }
4505       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4506       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4507       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4508       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4509       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4510     }
4511 #if 0
4512   {
4513     PetscViewer viewer;
4514     char filename[256];
4515     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4516     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4517     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4518     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4519     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4520     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4521     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4522     if (pcbddc->coarse_phi_B) {
4523       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4524       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4525     }
4526     if (pcbddc->coarse_phi_D) {
4527       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4528       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4529     }
4530     if (pcbddc->coarse_psi_B) {
4531       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4532       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4533     }
4534     if (pcbddc->coarse_psi_D) {
4535       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4536       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4537     }
4538     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4539     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4540     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4541     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4542     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4543     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4544     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4545     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4546     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4547     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4548     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4549   }
4550 #endif
4551     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4552     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4553     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4554     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4555 
4556     /* check constraints */
4557     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4558     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4559     if (!pcbddc->benign_n) { /* TODO: add benign case */
4560       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4561     } else {
4562       PetscScalar *data;
4563       Mat         tmat;
4564       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4565       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4566       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4567       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4568       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4569     }
4570     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4571     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4572     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4573     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4574     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4575     if (!pcbddc->symmetric_primal) {
4576       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4577       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4578       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4579       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4580       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4581     }
4582     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4583     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4584     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4585     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4586     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4587     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4588     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4589     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4590     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4591     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4592     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4593     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4594     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4595     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4596     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4597     if (!pcbddc->symmetric_primal) {
4598       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4599       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4600     }
4601     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4602   }
4603   /* get back data */
4604   *coarse_submat_vals_n = coarse_submat_vals;
4605   PetscFunctionReturn(0);
4606 }
4607 
4608 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4609 {
4610   Mat            *work_mat;
4611   IS             isrow_s,iscol_s;
4612   PetscBool      rsorted,csorted;
4613   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4614   PetscErrorCode ierr;
4615 
4616   PetscFunctionBegin;
4617   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4618   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4619   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4620   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4621 
4622   if (!rsorted) {
4623     const PetscInt *idxs;
4624     PetscInt *idxs_sorted,i;
4625 
4626     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4627     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4628     for (i=0;i<rsize;i++) {
4629       idxs_perm_r[i] = i;
4630     }
4631     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4632     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4633     for (i=0;i<rsize;i++) {
4634       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4635     }
4636     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4637     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4638   } else {
4639     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4640     isrow_s = isrow;
4641   }
4642 
4643   if (!csorted) {
4644     if (isrow == iscol) {
4645       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4646       iscol_s = isrow_s;
4647     } else {
4648       const PetscInt *idxs;
4649       PetscInt       *idxs_sorted,i;
4650 
4651       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4652       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4653       for (i=0;i<csize;i++) {
4654         idxs_perm_c[i] = i;
4655       }
4656       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4657       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4658       for (i=0;i<csize;i++) {
4659         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4660       }
4661       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4662       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4663     }
4664   } else {
4665     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4666     iscol_s = iscol;
4667   }
4668 
4669   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4670 
4671   if (!rsorted || !csorted) {
4672     Mat      new_mat;
4673     IS       is_perm_r,is_perm_c;
4674 
4675     if (!rsorted) {
4676       PetscInt *idxs_r,i;
4677       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4678       for (i=0;i<rsize;i++) {
4679         idxs_r[idxs_perm_r[i]] = i;
4680       }
4681       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4682       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4683     } else {
4684       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4685     }
4686     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4687 
4688     if (!csorted) {
4689       if (isrow_s == iscol_s) {
4690         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4691         is_perm_c = is_perm_r;
4692       } else {
4693         PetscInt *idxs_c,i;
4694         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4695         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4696         for (i=0;i<csize;i++) {
4697           idxs_c[idxs_perm_c[i]] = i;
4698         }
4699         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4700         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4701       }
4702     } else {
4703       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4704     }
4705     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4706 
4707     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4708     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4709     work_mat[0] = new_mat;
4710     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4711     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4712   }
4713 
4714   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4715   *B = work_mat[0];
4716   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4717   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4718   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4719   PetscFunctionReturn(0);
4720 }
4721 
4722 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4723 {
4724   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4725   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4726   Mat            new_mat,lA;
4727   IS             is_local,is_global;
4728   PetscInt       local_size;
4729   PetscBool      isseqaij;
4730   PetscErrorCode ierr;
4731 
4732   PetscFunctionBegin;
4733   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4734   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4735   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4736   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4737   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4738   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4739   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4740 
4741   /* check */
4742   if (pcbddc->dbg_flag) {
4743     Vec       x,x_change;
4744     PetscReal error;
4745 
4746     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4747     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4748     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4749     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4750     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4751     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4752     if (!pcbddc->change_interior) {
4753       const PetscScalar *x,*y,*v;
4754       PetscReal         lerror = 0.;
4755       PetscInt          i;
4756 
4757       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4758       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4759       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4760       for (i=0;i<local_size;i++)
4761         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4762           lerror = PetscAbsScalar(x[i]-y[i]);
4763       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4764       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4765       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4766       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4767       if (error > PETSC_SMALL) {
4768         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4769           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4770         } else {
4771           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4772         }
4773       }
4774     }
4775     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4776     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4777     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4778     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4779     if (error > PETSC_SMALL) {
4780       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4781         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4782       } else {
4783         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4784       }
4785     }
4786     ierr = VecDestroy(&x);CHKERRQ(ierr);
4787     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4788   }
4789 
4790   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4791   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4792 
4793   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4794   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4795   if (isseqaij) {
4796     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4797     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4798     if (lA) {
4799       Mat work;
4800       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4801       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4802       ierr = MatDestroy(&work);CHKERRQ(ierr);
4803     }
4804   } else {
4805     Mat work_mat;
4806 
4807     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4808     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4809     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4810     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4811     if (lA) {
4812       Mat work;
4813       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4814       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4815       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4816       ierr = MatDestroy(&work);CHKERRQ(ierr);
4817     }
4818   }
4819   if (matis->A->symmetric_set) {
4820     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4821 #if !defined(PETSC_USE_COMPLEX)
4822     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4823 #endif
4824   }
4825   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4826   PetscFunctionReturn(0);
4827 }
4828 
4829 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4830 {
4831   PC_IS*          pcis = (PC_IS*)(pc->data);
4832   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4833   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4834   PetscInt        *idx_R_local=NULL;
4835   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4836   PetscInt        vbs,bs;
4837   PetscBT         bitmask=NULL;
4838   PetscErrorCode  ierr;
4839 
4840   PetscFunctionBegin;
4841   /*
4842     No need to setup local scatters if
4843       - primal space is unchanged
4844         AND
4845       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4846         AND
4847       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4848   */
4849   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4850     PetscFunctionReturn(0);
4851   }
4852   /* destroy old objects */
4853   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4854   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4855   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4856   /* Set Non-overlapping dimensions */
4857   n_B = pcis->n_B;
4858   n_D = pcis->n - n_B;
4859   n_vertices = pcbddc->n_vertices;
4860 
4861   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4862 
4863   /* create auxiliary bitmask and allocate workspace */
4864   if (!sub_schurs || !sub_schurs->reuse_solver) {
4865     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4866     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4867     for (i=0;i<n_vertices;i++) {
4868       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4869     }
4870 
4871     for (i=0, n_R=0; i<pcis->n; i++) {
4872       if (!PetscBTLookup(bitmask,i)) {
4873         idx_R_local[n_R++] = i;
4874       }
4875     }
4876   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4877     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4878 
4879     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4880     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4881   }
4882 
4883   /* Block code */
4884   vbs = 1;
4885   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4886   if (bs>1 && !(n_vertices%bs)) {
4887     PetscBool is_blocked = PETSC_TRUE;
4888     PetscInt  *vary;
4889     if (!sub_schurs || !sub_schurs->reuse_solver) {
4890       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4891       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4892       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4893       /* 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 */
4894       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4895       for (i=0; i<pcis->n/bs; i++) {
4896         if (vary[i]!=0 && vary[i]!=bs) {
4897           is_blocked = PETSC_FALSE;
4898           break;
4899         }
4900       }
4901       ierr = PetscFree(vary);CHKERRQ(ierr);
4902     } else {
4903       /* Verify directly the R set */
4904       for (i=0; i<n_R/bs; i++) {
4905         PetscInt j,node=idx_R_local[bs*i];
4906         for (j=1; j<bs; j++) {
4907           if (node != idx_R_local[bs*i+j]-j) {
4908             is_blocked = PETSC_FALSE;
4909             break;
4910           }
4911         }
4912       }
4913     }
4914     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4915       vbs = bs;
4916       for (i=0;i<n_R/vbs;i++) {
4917         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4918       }
4919     }
4920   }
4921   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4922   if (sub_schurs && sub_schurs->reuse_solver) {
4923     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4924 
4925     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4926     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4927     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4928     reuse_solver->is_R = pcbddc->is_R_local;
4929   } else {
4930     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4931   }
4932 
4933   /* print some info if requested */
4934   if (pcbddc->dbg_flag) {
4935     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4936     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4937     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4938     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4939     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4940     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"r_size = %d, v_size = %d, constraints = %d, local_primal_size = %d\n",n_R,n_vertices,pcbddc->local_primal_size-n_vertices-pcbddc->benign_n,pcbddc->local_primal_size);CHKERRQ(ierr);
4941     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4942   }
4943 
4944   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4945   if (!sub_schurs || !sub_schurs->reuse_solver) {
4946     IS       is_aux1,is_aux2;
4947     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4948 
4949     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4950     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4951     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4952     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4953     for (i=0; i<n_D; i++) {
4954       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4955     }
4956     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4957     for (i=0, j=0; i<n_R; i++) {
4958       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4959         aux_array1[j++] = i;
4960       }
4961     }
4962     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4963     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4964     for (i=0, j=0; i<n_B; i++) {
4965       if (!PetscBTLookup(bitmask,is_indices[i])) {
4966         aux_array2[j++] = i;
4967       }
4968     }
4969     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4970     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4971     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4972     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4973     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4974 
4975     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4976       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4977       for (i=0, j=0; i<n_R; i++) {
4978         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4979           aux_array1[j++] = i;
4980         }
4981       }
4982       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4983       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4984       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4985     }
4986     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4987     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4988   } else {
4989     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4990     IS                 tis;
4991     PetscInt           schur_size;
4992 
4993     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4994     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4995     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4996     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4997     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4998       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4999       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5000       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5001     }
5002   }
5003   PetscFunctionReturn(0);
5004 }
5005 
5006 
5007 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5008 {
5009   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5010   PC_IS          *pcis = (PC_IS*)pc->data;
5011   PC             pc_temp;
5012   Mat            A_RR;
5013   MatReuse       reuse;
5014   PetscScalar    m_one = -1.0;
5015   PetscReal      value;
5016   PetscInt       n_D,n_R;
5017   PetscBool      check_corr,issbaij;
5018   PetscErrorCode ierr;
5019   /* prefixes stuff */
5020   char           dir_prefix[256],neu_prefix[256],str_level[16];
5021   size_t         len;
5022 
5023   PetscFunctionBegin;
5024 
5025   /* compute prefixes */
5026   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5027   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5028   if (!pcbddc->current_level) {
5029     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
5030     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
5031     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
5032     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
5033   } else {
5034     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5035     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5036     len -= 15; /* remove "pc_bddc_coarse_" */
5037     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5038     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5039     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5040     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5041     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
5042     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
5043     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
5044     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
5045   }
5046 
5047   /* DIRICHLET PROBLEM */
5048   if (dirichlet) {
5049     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5050     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5051       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
5052       if (pcbddc->dbg_flag) {
5053         Mat    A_IIn;
5054 
5055         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5056         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5057         pcis->A_II = A_IIn;
5058       }
5059     }
5060     if (pcbddc->local_mat->symmetric_set) {
5061       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5062     }
5063     /* Matrix for Dirichlet problem is pcis->A_II */
5064     n_D = pcis->n - pcis->n_B;
5065     if (!pcbddc->ksp_D) { /* create object if not yet build */
5066       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5067       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5068       /* default */
5069       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5070       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5071       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5072       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5073       if (issbaij) {
5074         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5075       } else {
5076         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5077       }
5078       /* Allow user's customization */
5079       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5080     }
5081     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5082     if (sub_schurs && sub_schurs->reuse_solver) {
5083       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5084 
5085       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5086     }
5087     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5088     if (!n_D) {
5089       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5090       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5091     }
5092     /* Set Up KSP for Dirichlet problem of BDDC */
5093     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5094     /* set ksp_D into pcis data */
5095     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5096     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5097     pcis->ksp_D = pcbddc->ksp_D;
5098   }
5099 
5100   /* NEUMANN PROBLEM */
5101   A_RR = 0;
5102   if (neumann) {
5103     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5104     PetscInt        ibs,mbs;
5105     PetscBool       issbaij, reuse_neumann_solver;
5106     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5107 
5108     reuse_neumann_solver = PETSC_FALSE;
5109     if (sub_schurs && sub_schurs->reuse_solver) {
5110       IS iP;
5111 
5112       reuse_neumann_solver = PETSC_TRUE;
5113       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5114       if (iP) reuse_neumann_solver = PETSC_FALSE;
5115     }
5116     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5117     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5118     if (pcbddc->ksp_R) { /* already created ksp */
5119       PetscInt nn_R;
5120       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5121       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5122       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5123       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5124         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5125         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5126         reuse = MAT_INITIAL_MATRIX;
5127       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5128         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5129           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5130           reuse = MAT_INITIAL_MATRIX;
5131         } else { /* safe to reuse the matrix */
5132           reuse = MAT_REUSE_MATRIX;
5133         }
5134       }
5135       /* last check */
5136       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5137         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5138         reuse = MAT_INITIAL_MATRIX;
5139       }
5140     } else { /* first time, so we need to create the matrix */
5141       reuse = MAT_INITIAL_MATRIX;
5142     }
5143     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5144     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5145     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5146     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5147     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5148       if (matis->A == pcbddc->local_mat) {
5149         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5150         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5151       } else {
5152         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5153       }
5154     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5155       if (matis->A == pcbddc->local_mat) {
5156         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5157         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5158       } else {
5159         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5160       }
5161     }
5162     /* extract A_RR */
5163     if (reuse_neumann_solver) {
5164       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5165 
5166       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5167         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5168         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5169           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5170         } else {
5171           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5172         }
5173       } else {
5174         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5175         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5176         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5177       }
5178     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5179       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5180     }
5181     if (pcbddc->local_mat->symmetric_set) {
5182       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5183     }
5184     if (!pcbddc->ksp_R) { /* create object if not present */
5185       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5186       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5187       /* default */
5188       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5189       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5190       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5191       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5192       if (issbaij) {
5193         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5194       } else {
5195         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5196       }
5197       /* Allow user's customization */
5198       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5199     }
5200     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5201     if (!n_R) {
5202       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5203       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5204     }
5205     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5206     /* Reuse solver if it is present */
5207     if (reuse_neumann_solver) {
5208       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5209 
5210       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5211     }
5212     /* Set Up KSP for Neumann problem of BDDC */
5213     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5214   }
5215 
5216   if (pcbddc->dbg_flag) {
5217     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5218     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5219     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5220   }
5221 
5222   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5223   check_corr = PETSC_FALSE;
5224   if (pcbddc->NullSpace_corr[0]) {
5225     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5226   }
5227   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5228     check_corr = PETSC_TRUE;
5229     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5230   }
5231   if (neumann && pcbddc->NullSpace_corr[2]) {
5232     check_corr = PETSC_TRUE;
5233     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5234   }
5235   /* check Dirichlet and Neumann solvers */
5236   if (pcbddc->dbg_flag) {
5237     if (dirichlet) { /* Dirichlet */
5238       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5239       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5240       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5241       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5242       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5243       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Dirichlet solve (%s) = % 1.14e \n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_D))->prefix,value);CHKERRQ(ierr);
5244       if (check_corr) {
5245         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5246       }
5247       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5248     }
5249     if (neumann) { /* Neumann */
5250       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5251       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5252       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5253       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5254       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5255       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d infinity error for Neumann solve (%s) = % 1.14e\n",PetscGlobalRank,((PetscObject)(pcbddc->ksp_R))->prefix,value);CHKERRQ(ierr);
5256       if (check_corr) {
5257         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5258       }
5259       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5260     }
5261   }
5262   /* free Neumann problem's matrix */
5263   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5264   PetscFunctionReturn(0);
5265 }
5266 
5267 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5268 {
5269   PetscErrorCode  ierr;
5270   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5271   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5272   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5273 
5274   PetscFunctionBegin;
5275   if (!reuse_solver) {
5276     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5277   }
5278   if (!pcbddc->switch_static) {
5279     if (applytranspose && pcbddc->local_auxmat1) {
5280       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5281       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5282     }
5283     if (!reuse_solver) {
5284       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5285       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5286     } else {
5287       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5288 
5289       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5290       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5291     }
5292   } else {
5293     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5294     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5295     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5296     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5297     if (applytranspose && pcbddc->local_auxmat1) {
5298       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5299       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5300       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5301       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5302     }
5303   }
5304   if (!reuse_solver || pcbddc->switch_static) {
5305     if (applytranspose) {
5306       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5307     } else {
5308       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5309     }
5310   } else {
5311     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5312 
5313     if (applytranspose) {
5314       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5315     } else {
5316       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5317     }
5318   }
5319   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5320   if (!pcbddc->switch_static) {
5321     if (!reuse_solver) {
5322       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5323       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5324     } else {
5325       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5326 
5327       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5328       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5329     }
5330     if (!applytranspose && pcbddc->local_auxmat1) {
5331       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5332       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5333     }
5334   } else {
5335     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5336     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5337     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5338     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5339     if (!applytranspose && pcbddc->local_auxmat1) {
5340       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5341       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5342     }
5343     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5344     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5345     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5346     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5347   }
5348   PetscFunctionReturn(0);
5349 }
5350 
5351 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5352 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5353 {
5354   PetscErrorCode ierr;
5355   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5356   PC_IS*            pcis = (PC_IS*)  (pc->data);
5357   const PetscScalar zero = 0.0;
5358 
5359   PetscFunctionBegin;
5360   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5361   if (!pcbddc->benign_apply_coarse_only) {
5362     if (applytranspose) {
5363       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5364       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5365     } else {
5366       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5367       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5368     }
5369   } else {
5370     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5371   }
5372 
5373   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5374   if (pcbddc->benign_n) {
5375     PetscScalar *array;
5376     PetscInt    j;
5377 
5378     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5379     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5380     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5381   }
5382 
5383   /* start communications from local primal nodes to rhs of coarse solver */
5384   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5385   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5386   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5387 
5388   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5389   if (pcbddc->coarse_ksp) {
5390     Mat          coarse_mat;
5391     Vec          rhs,sol;
5392     MatNullSpace nullsp;
5393     PetscBool    isbddc = PETSC_FALSE;
5394 
5395     if (pcbddc->benign_have_null) {
5396       PC        coarse_pc;
5397 
5398       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5399       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5400       /* we need to propagate to coarser levels the need for a possible benign correction */
5401       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5402         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5403         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5404         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5405       }
5406     }
5407     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5408     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5409     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5410     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5411     if (nullsp) {
5412       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5413     }
5414     if (applytranspose) {
5415       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5416       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5417     } else {
5418       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5419         PC        coarse_pc;
5420 
5421         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5422         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5423         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5424         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5425       } else {
5426         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5427       }
5428     }
5429     /* we don't need the benign correction at coarser levels anymore */
5430     if (pcbddc->benign_have_null && isbddc) {
5431       PC        coarse_pc;
5432       PC_BDDC*  coarsepcbddc;
5433 
5434       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5435       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5436       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5437       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5438     }
5439     if (nullsp) {
5440       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5441     }
5442   }
5443 
5444   /* Local solution on R nodes */
5445   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5446     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5447   }
5448   /* communications from coarse sol to local primal nodes */
5449   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5450   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5451 
5452   /* Sum contributions from the two levels */
5453   if (!pcbddc->benign_apply_coarse_only) {
5454     if (applytranspose) {
5455       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5456       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5457     } else {
5458       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5459       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5460     }
5461     /* store p0 */
5462     if (pcbddc->benign_n) {
5463       PetscScalar *array;
5464       PetscInt    j;
5465 
5466       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5467       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5468       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5469     }
5470   } else { /* expand the coarse solution */
5471     if (applytranspose) {
5472       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5473     } else {
5474       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5475     }
5476   }
5477   PetscFunctionReturn(0);
5478 }
5479 
5480 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5481 {
5482   PetscErrorCode ierr;
5483   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5484   PetscScalar    *array;
5485   Vec            from,to;
5486 
5487   PetscFunctionBegin;
5488   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5489     from = pcbddc->coarse_vec;
5490     to = pcbddc->vec1_P;
5491     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5492       Vec tvec;
5493 
5494       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5495       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5496       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5497       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5498       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5499       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5500     }
5501   } else { /* from local to global -> put data in coarse right hand side */
5502     from = pcbddc->vec1_P;
5503     to = pcbddc->coarse_vec;
5504   }
5505   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5506   PetscFunctionReturn(0);
5507 }
5508 
5509 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5510 {
5511   PetscErrorCode ierr;
5512   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5513   PetscScalar    *array;
5514   Vec            from,to;
5515 
5516   PetscFunctionBegin;
5517   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5518     from = pcbddc->coarse_vec;
5519     to = pcbddc->vec1_P;
5520   } else { /* from local to global -> put data in coarse right hand side */
5521     from = pcbddc->vec1_P;
5522     to = pcbddc->coarse_vec;
5523   }
5524   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5525   if (smode == SCATTER_FORWARD) {
5526     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5527       Vec tvec;
5528 
5529       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5530       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5531       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5532       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5533     }
5534   } else {
5535     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5536      ierr = VecResetArray(from);CHKERRQ(ierr);
5537     }
5538   }
5539   PetscFunctionReturn(0);
5540 }
5541 
5542 /* uncomment for testing purposes */
5543 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5544 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5545 {
5546   PetscErrorCode    ierr;
5547   PC_IS*            pcis = (PC_IS*)(pc->data);
5548   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5549   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5550   /* one and zero */
5551   PetscScalar       one=1.0,zero=0.0;
5552   /* space to store constraints and their local indices */
5553   PetscScalar       *constraints_data;
5554   PetscInt          *constraints_idxs,*constraints_idxs_B;
5555   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5556   PetscInt          *constraints_n;
5557   /* iterators */
5558   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5559   /* BLAS integers */
5560   PetscBLASInt      lwork,lierr;
5561   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5562   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5563   /* reuse */
5564   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5565   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5566   /* change of basis */
5567   PetscBool         qr_needed;
5568   PetscBT           change_basis,qr_needed_idx;
5569   /* auxiliary stuff */
5570   PetscInt          *nnz,*is_indices;
5571   PetscInt          ncc;
5572   /* some quantities */
5573   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5574   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5575   PetscReal         tol; /* tolerance for retaining eigenmodes */
5576 
5577   PetscFunctionBegin;
5578   tol  = PetscSqrtReal(PETSC_SMALL);
5579   /* Destroy Mat objects computed previously */
5580   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5581   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5582   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5583   /* save info on constraints from previous setup (if any) */
5584   olocal_primal_size = pcbddc->local_primal_size;
5585   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5586   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5587   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5588   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5589   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5590   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5591 
5592   if (!pcbddc->adaptive_selection) {
5593     IS           ISForVertices,*ISForFaces,*ISForEdges;
5594     MatNullSpace nearnullsp;
5595     const Vec    *nearnullvecs;
5596     Vec          *localnearnullsp;
5597     PetscScalar  *array;
5598     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5599     PetscBool    nnsp_has_cnst;
5600     /* LAPACK working arrays for SVD or POD */
5601     PetscBool    skip_lapack,boolforchange;
5602     PetscScalar  *work;
5603     PetscReal    *singular_vals;
5604 #if defined(PETSC_USE_COMPLEX)
5605     PetscReal    *rwork;
5606 #endif
5607 #if defined(PETSC_MISSING_LAPACK_GESVD)
5608     PetscScalar  *temp_basis,*correlation_mat;
5609 #else
5610     PetscBLASInt dummy_int=1;
5611     PetscScalar  dummy_scalar=1.;
5612 #endif
5613 
5614     /* Get index sets for faces, edges and vertices from graph */
5615     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5616     /* print some info */
5617     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5618       PetscInt nv;
5619 
5620       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5621       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5622       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5623       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5624       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5625       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5626       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5627       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5628       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5629     }
5630 
5631     /* free unneeded index sets */
5632     if (!pcbddc->use_vertices) {
5633       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5634     }
5635     if (!pcbddc->use_edges) {
5636       for (i=0;i<n_ISForEdges;i++) {
5637         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5638       }
5639       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5640       n_ISForEdges = 0;
5641     }
5642     if (!pcbddc->use_faces) {
5643       for (i=0;i<n_ISForFaces;i++) {
5644         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5645       }
5646       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5647       n_ISForFaces = 0;
5648     }
5649 
5650     /* check if near null space is attached to global mat */
5651     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5652     if (nearnullsp) {
5653       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5654       /* remove any stored info */
5655       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5656       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5657       /* store information for BDDC solver reuse */
5658       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5659       pcbddc->onearnullspace = nearnullsp;
5660       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5661       for (i=0;i<nnsp_size;i++) {
5662         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5663       }
5664     } else { /* if near null space is not provided BDDC uses constants by default */
5665       nnsp_size = 0;
5666       nnsp_has_cnst = PETSC_TRUE;
5667     }
5668     /* get max number of constraints on a single cc */
5669     max_constraints = nnsp_size;
5670     if (nnsp_has_cnst) max_constraints++;
5671 
5672     /*
5673          Evaluate maximum storage size needed by the procedure
5674          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5675          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5676          There can be multiple constraints per connected component
5677                                                                                                                                                            */
5678     n_vertices = 0;
5679     if (ISForVertices) {
5680       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5681     }
5682     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5683     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5684 
5685     total_counts = n_ISForFaces+n_ISForEdges;
5686     total_counts *= max_constraints;
5687     total_counts += n_vertices;
5688     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5689 
5690     total_counts = 0;
5691     max_size_of_constraint = 0;
5692     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5693       IS used_is;
5694       if (i<n_ISForEdges) {
5695         used_is = ISForEdges[i];
5696       } else {
5697         used_is = ISForFaces[i-n_ISForEdges];
5698       }
5699       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5700       total_counts += j;
5701       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5702     }
5703     ierr = PetscMalloc3(total_counts*max_constraints+n_vertices,&constraints_data,total_counts+n_vertices,&constraints_idxs,total_counts+n_vertices,&constraints_idxs_B);CHKERRQ(ierr);
5704 
5705     /* get local part of global near null space vectors */
5706     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5707     for (k=0;k<nnsp_size;k++) {
5708       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5709       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5710       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5711     }
5712 
5713     /* whether or not to skip lapack calls */
5714     skip_lapack = PETSC_TRUE;
5715     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5716 
5717     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5718     if (!skip_lapack) {
5719       PetscScalar temp_work;
5720 
5721 #if defined(PETSC_MISSING_LAPACK_GESVD)
5722       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5723       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5724       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5725       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5726 #if defined(PETSC_USE_COMPLEX)
5727       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5728 #endif
5729       /* now we evaluate the optimal workspace using query with lwork=-1 */
5730       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5731       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5732       lwork = -1;
5733       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5734 #if !defined(PETSC_USE_COMPLEX)
5735       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5736 #else
5737       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5738 #endif
5739       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5740       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5741 #else /* on missing GESVD */
5742       /* SVD */
5743       PetscInt max_n,min_n;
5744       max_n = max_size_of_constraint;
5745       min_n = max_constraints;
5746       if (max_size_of_constraint < max_constraints) {
5747         min_n = max_size_of_constraint;
5748         max_n = max_constraints;
5749       }
5750       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5751 #if defined(PETSC_USE_COMPLEX)
5752       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5753 #endif
5754       /* now we evaluate the optimal workspace using query with lwork=-1 */
5755       lwork = -1;
5756       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5757       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5758       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5759       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5760 #if !defined(PETSC_USE_COMPLEX)
5761       PetscStackCallBLAS("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));
5762 #else
5763       PetscStackCallBLAS("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));
5764 #endif
5765       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5766       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5767 #endif /* on missing GESVD */
5768       /* Allocate optimal workspace */
5769       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5770       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5771     }
5772     /* Now we can loop on constraining sets */
5773     total_counts = 0;
5774     constraints_idxs_ptr[0] = 0;
5775     constraints_data_ptr[0] = 0;
5776     /* vertices */
5777     if (n_vertices) {
5778       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5779       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5780       for (i=0;i<n_vertices;i++) {
5781         constraints_n[total_counts] = 1;
5782         constraints_data[total_counts] = 1.0;
5783         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5784         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5785         total_counts++;
5786       }
5787       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5788       n_vertices = total_counts;
5789     }
5790 
5791     /* edges and faces */
5792     total_counts_cc = total_counts;
5793     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5794       IS        used_is;
5795       PetscBool idxs_copied = PETSC_FALSE;
5796 
5797       if (ncc<n_ISForEdges) {
5798         used_is = ISForEdges[ncc];
5799         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5800       } else {
5801         used_is = ISForFaces[ncc-n_ISForEdges];
5802         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5803       }
5804       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5805 
5806       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5807       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5808       /* change of basis should not be performed on local periodic nodes */
5809       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5810       if (nnsp_has_cnst) {
5811         PetscScalar quad_value;
5812 
5813         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5814         idxs_copied = PETSC_TRUE;
5815 
5816         if (!pcbddc->use_nnsp_true) {
5817           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5818         } else {
5819           quad_value = 1.0;
5820         }
5821         for (j=0;j<size_of_constraint;j++) {
5822           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5823         }
5824         temp_constraints++;
5825         total_counts++;
5826       }
5827       for (k=0;k<nnsp_size;k++) {
5828         PetscReal real_value;
5829         PetscScalar *ptr_to_data;
5830 
5831         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5832         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5833         for (j=0;j<size_of_constraint;j++) {
5834           ptr_to_data[j] = array[is_indices[j]];
5835         }
5836         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5837         /* check if array is null on the connected component */
5838         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5839         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5840         if (real_value > tol*size_of_constraint) { /* keep indices and values */
5841           temp_constraints++;
5842           total_counts++;
5843           if (!idxs_copied) {
5844             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5845             idxs_copied = PETSC_TRUE;
5846           }
5847         }
5848       }
5849       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5850       valid_constraints = temp_constraints;
5851       if (!pcbddc->use_nnsp_true && temp_constraints) {
5852         if (temp_constraints == 1) { /* just normalize the constraint */
5853           PetscScalar norm,*ptr_to_data;
5854 
5855           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5856           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5857           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5858           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5859           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5860         } else { /* perform SVD */
5861           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5862 
5863 #if defined(PETSC_MISSING_LAPACK_GESVD)
5864           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5865              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5866              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5867                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5868                 from that computed using LAPACKgesvd
5869              -> This is due to a different computation of eigenvectors in LAPACKheev
5870              -> The quality of the POD-computed basis will be the same */
5871           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5872           /* Store upper triangular part of correlation matrix */
5873           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5874           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5875           for (j=0;j<temp_constraints;j++) {
5876             for (k=0;k<j+1;k++) {
5877               PetscStackCallBLAS("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));
5878             }
5879           }
5880           /* compute eigenvalues and eigenvectors of correlation matrix */
5881           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5882           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5883 #if !defined(PETSC_USE_COMPLEX)
5884           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5885 #else
5886           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5887 #endif
5888           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5889           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5890           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5891           j = 0;
5892           while (j < temp_constraints && singular_vals[j] < tol) j++;
5893           total_counts = total_counts-j;
5894           valid_constraints = temp_constraints-j;
5895           /* scale and copy POD basis into used quadrature memory */
5896           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5897           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5898           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5899           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5900           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5901           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5902           if (j<temp_constraints) {
5903             PetscInt ii;
5904             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5905             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5906             PetscStackCallBLAS("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));
5907             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5908             for (k=0;k<temp_constraints-j;k++) {
5909               for (ii=0;ii<size_of_constraint;ii++) {
5910                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5911               }
5912             }
5913           }
5914 #else  /* on missing GESVD */
5915           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5916           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5917           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5918           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5919 #if !defined(PETSC_USE_COMPLEX)
5920           PetscStackCallBLAS("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));
5921 #else
5922           PetscStackCallBLAS("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));
5923 #endif
5924           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5925           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5926           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5927           k = temp_constraints;
5928           if (k > size_of_constraint) k = size_of_constraint;
5929           j = 0;
5930           while (j < k && singular_vals[k-j-1] < tol) j++;
5931           valid_constraints = k-j;
5932           total_counts = total_counts-temp_constraints+valid_constraints;
5933 #endif /* on missing GESVD */
5934         }
5935       }
5936       /* update pointers information */
5937       if (valid_constraints) {
5938         constraints_n[total_counts_cc] = valid_constraints;
5939         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5940         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5941         /* set change_of_basis flag */
5942         if (boolforchange) {
5943           PetscBTSet(change_basis,total_counts_cc);
5944         }
5945         total_counts_cc++;
5946       }
5947     }
5948     /* free workspace */
5949     if (!skip_lapack) {
5950       ierr = PetscFree(work);CHKERRQ(ierr);
5951 #if defined(PETSC_USE_COMPLEX)
5952       ierr = PetscFree(rwork);CHKERRQ(ierr);
5953 #endif
5954       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5955 #if defined(PETSC_MISSING_LAPACK_GESVD)
5956       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5957       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5958 #endif
5959     }
5960     for (k=0;k<nnsp_size;k++) {
5961       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5962     }
5963     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5964     /* free index sets of faces, edges and vertices */
5965     for (i=0;i<n_ISForFaces;i++) {
5966       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5967     }
5968     if (n_ISForFaces) {
5969       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5970     }
5971     for (i=0;i<n_ISForEdges;i++) {
5972       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5973     }
5974     if (n_ISForEdges) {
5975       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5976     }
5977     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5978   } else {
5979     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5980 
5981     total_counts = 0;
5982     n_vertices = 0;
5983     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5984       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5985     }
5986     max_constraints = 0;
5987     total_counts_cc = 0;
5988     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5989       total_counts += pcbddc->adaptive_constraints_n[i];
5990       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5991       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5992     }
5993     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5994     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5995     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5996     constraints_data = pcbddc->adaptive_constraints_data;
5997     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5998     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5999     total_counts_cc = 0;
6000     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6001       if (pcbddc->adaptive_constraints_n[i]) {
6002         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6003       }
6004     }
6005 #if 0
6006     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
6007     for (i=0;i<total_counts_cc;i++) {
6008       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
6009       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
6010       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
6011         printf(" %d",constraints_idxs[j]);
6012       }
6013       printf("\n");
6014       printf("number of cc: %d\n",constraints_n[i]);
6015     }
6016     for (i=0;i<n_vertices;i++) {
6017       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
6018     }
6019     for (i=0;i<sub_schurs->n_subs;i++) {
6020       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
6021     }
6022 #endif
6023 
6024     max_size_of_constraint = 0;
6025     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]);
6026     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6027     /* Change of basis */
6028     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6029     if (pcbddc->use_change_of_basis) {
6030       for (i=0;i<sub_schurs->n_subs;i++) {
6031         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6032           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6033         }
6034       }
6035     }
6036   }
6037   pcbddc->local_primal_size = total_counts;
6038   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6039 
6040   /* map constraints_idxs in boundary numbering */
6041   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6042   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
6043 
6044   /* Create constraint matrix */
6045   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6046   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6047   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6048 
6049   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6050   /* determine if a QR strategy is needed for change of basis */
6051   qr_needed = PETSC_FALSE;
6052   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6053   total_primal_vertices=0;
6054   pcbddc->local_primal_size_cc = 0;
6055   for (i=0;i<total_counts_cc;i++) {
6056     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6057     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6058       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6059       pcbddc->local_primal_size_cc += 1;
6060     } else if (PetscBTLookup(change_basis,i)) {
6061       for (k=0;k<constraints_n[i];k++) {
6062         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6063       }
6064       pcbddc->local_primal_size_cc += constraints_n[i];
6065       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6066         PetscBTSet(qr_needed_idx,i);
6067         qr_needed = PETSC_TRUE;
6068       }
6069     } else {
6070       pcbddc->local_primal_size_cc += 1;
6071     }
6072   }
6073   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6074   pcbddc->n_vertices = total_primal_vertices;
6075   /* permute indices in order to have a sorted set of vertices */
6076   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6077   ierr = 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);CHKERRQ(ierr);
6078   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6079   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6080 
6081   /* nonzero structure of constraint matrix */
6082   /* and get reference dof for local constraints */
6083   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6084   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6085 
6086   j = total_primal_vertices;
6087   total_counts = total_primal_vertices;
6088   cum = total_primal_vertices;
6089   for (i=n_vertices;i<total_counts_cc;i++) {
6090     if (!PetscBTLookup(change_basis,i)) {
6091       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6092       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6093       cum++;
6094       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6095       for (k=0;k<constraints_n[i];k++) {
6096         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6097         nnz[j+k] = size_of_constraint;
6098       }
6099       j += constraints_n[i];
6100     }
6101   }
6102   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6103   ierr = PetscFree(nnz);CHKERRQ(ierr);
6104 
6105   /* set values in constraint matrix */
6106   for (i=0;i<total_primal_vertices;i++) {
6107     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6108   }
6109   total_counts = total_primal_vertices;
6110   for (i=n_vertices;i<total_counts_cc;i++) {
6111     if (!PetscBTLookup(change_basis,i)) {
6112       PetscInt *cols;
6113 
6114       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6115       cols = constraints_idxs+constraints_idxs_ptr[i];
6116       for (k=0;k<constraints_n[i];k++) {
6117         PetscInt    row = total_counts+k;
6118         PetscScalar *vals;
6119 
6120         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6121         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6122       }
6123       total_counts += constraints_n[i];
6124     }
6125   }
6126   /* assembling */
6127   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6128   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6129   ierr = MatChop(pcbddc->ConstraintMatrix,PETSC_SMALL);CHKERRQ(ierr);
6130   ierr = MatSeqAIJCompress(pcbddc->ConstraintMatrix,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6131   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6132 
6133   /*
6134   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6135   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6136   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6137   */
6138   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6139   if (pcbddc->use_change_of_basis) {
6140     /* dual and primal dofs on a single cc */
6141     PetscInt     dual_dofs,primal_dofs;
6142     /* working stuff for GEQRF */
6143     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6144     PetscBLASInt lqr_work;
6145     /* working stuff for UNGQR */
6146     PetscScalar  *gqr_work,lgqr_work_t;
6147     PetscBLASInt lgqr_work;
6148     /* working stuff for TRTRS */
6149     PetscScalar  *trs_rhs;
6150     PetscBLASInt Blas_NRHS;
6151     /* pointers for values insertion into change of basis matrix */
6152     PetscInt     *start_rows,*start_cols;
6153     PetscScalar  *start_vals;
6154     /* working stuff for values insertion */
6155     PetscBT      is_primal;
6156     PetscInt     *aux_primal_numbering_B;
6157     /* matrix sizes */
6158     PetscInt     global_size,local_size;
6159     /* temporary change of basis */
6160     Mat          localChangeOfBasisMatrix;
6161     /* extra space for debugging */
6162     PetscScalar  *dbg_work;
6163 
6164     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6165     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6166     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6167     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6168     /* nonzeros for local mat */
6169     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6170     if (!pcbddc->benign_change || pcbddc->fake_change) {
6171       for (i=0;i<pcis->n;i++) nnz[i]=1;
6172     } else {
6173       const PetscInt *ii;
6174       PetscInt       n;
6175       PetscBool      flg_row;
6176       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6177       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6178       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6179     }
6180     for (i=n_vertices;i<total_counts_cc;i++) {
6181       if (PetscBTLookup(change_basis,i)) {
6182         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6183         if (PetscBTLookup(qr_needed_idx,i)) {
6184           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6185         } else {
6186           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6187           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6188         }
6189       }
6190     }
6191     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6192     ierr = PetscFree(nnz);CHKERRQ(ierr);
6193     /* Set interior change in the matrix */
6194     if (!pcbddc->benign_change || pcbddc->fake_change) {
6195       for (i=0;i<pcis->n;i++) {
6196         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6197       }
6198     } else {
6199       const PetscInt *ii,*jj;
6200       PetscScalar    *aa;
6201       PetscInt       n;
6202       PetscBool      flg_row;
6203       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6204       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6205       for (i=0;i<n;i++) {
6206         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6207       }
6208       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6209       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6210     }
6211 
6212     if (pcbddc->dbg_flag) {
6213       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6214       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6215     }
6216 
6217 
6218     /* Now we loop on the constraints which need a change of basis */
6219     /*
6220        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6221        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6222 
6223        Basic blocks of change of basis matrix T computed by
6224 
6225           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6226 
6227             | 1        0   ...        0         s_1/S |
6228             | 0        1   ...        0         s_2/S |
6229             |              ...                        |
6230             | 0        ...            1     s_{n-1}/S |
6231             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6232 
6233             with S = \sum_{i=1}^n s_i^2
6234             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6235                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6236 
6237           - QR decomposition of constraints otherwise
6238     */
6239     if (qr_needed) {
6240       /* space to store Q */
6241       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6242       /* array to store scaling factors for reflectors */
6243       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6244       /* first we issue queries for optimal work */
6245       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6246       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6247       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6248       lqr_work = -1;
6249       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6250       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6251       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6252       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6253       lgqr_work = -1;
6254       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6255       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6256       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6257       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6258       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6259       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6260       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6261       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6262       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6263       /* array to store rhs and solution of triangular solver */
6264       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6265       /* allocating workspace for check */
6266       if (pcbddc->dbg_flag) {
6267         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6268       }
6269     }
6270     /* array to store whether a node is primal or not */
6271     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6272     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6273     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6274     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
6275     for (i=0;i<total_primal_vertices;i++) {
6276       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6277     }
6278     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6279 
6280     /* loop on constraints and see whether or not they need a change of basis and compute it */
6281     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6282       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6283       if (PetscBTLookup(change_basis,total_counts)) {
6284         /* get constraint info */
6285         primal_dofs = constraints_n[total_counts];
6286         dual_dofs = size_of_constraint-primal_dofs;
6287 
6288         if (pcbddc->dbg_flag) {
6289           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraints %d: %d need a change of basis (size %d)\n",total_counts,primal_dofs,size_of_constraint);CHKERRQ(ierr);
6290         }
6291 
6292         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6293 
6294           /* copy quadrature constraints for change of basis check */
6295           if (pcbddc->dbg_flag) {
6296             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6297           }
6298           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6299           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6300 
6301           /* compute QR decomposition of constraints */
6302           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6303           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6304           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6305           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6306           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6307           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6308           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6309 
6310           /* explictly compute R^-T */
6311           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6312           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6313           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6314           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6315           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6316           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6317           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6318           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6319           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6320           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6321 
6322           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6323           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6324           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6325           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6326           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6327           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6328           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6329           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6330           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6331 
6332           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6333              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6334              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6335           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6336           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6337           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6338           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6339           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6340           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6341           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6342           PetscStackCallBLAS("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));
6343           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6344           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6345 
6346           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6347           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6348           /* insert cols for primal dofs */
6349           for (j=0;j<primal_dofs;j++) {
6350             start_vals = &qr_basis[j*size_of_constraint];
6351             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6352             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6353           }
6354           /* insert cols for dual dofs */
6355           for (j=0,k=0;j<dual_dofs;k++) {
6356             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6357               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6358               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6359               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6360               j++;
6361             }
6362           }
6363 
6364           /* check change of basis */
6365           if (pcbddc->dbg_flag) {
6366             PetscInt   ii,jj;
6367             PetscBool valid_qr=PETSC_TRUE;
6368             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6369             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6370             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6371             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6372             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6373             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6374             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6375             PetscStackCallBLAS("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));
6376             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6377             for (jj=0;jj<size_of_constraint;jj++) {
6378               for (ii=0;ii<primal_dofs;ii++) {
6379                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6380                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6381               }
6382             }
6383             if (!valid_qr) {
6384               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6385               for (jj=0;jj<size_of_constraint;jj++) {
6386                 for (ii=0;ii<primal_dofs;ii++) {
6387                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6388                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not orthogonal to constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
6389                   }
6390                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6391                     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\tQr basis function %d is not unitary w.r.t constraint %d (%1.14e)!\n",jj,ii,PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]));
6392                   }
6393                 }
6394               }
6395             } else {
6396               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6397             }
6398           }
6399         } else { /* simple transformation block */
6400           PetscInt    row,col;
6401           PetscScalar val,norm;
6402 
6403           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6404           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6405           for (j=0;j<size_of_constraint;j++) {
6406             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6407             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6408             if (!PetscBTLookup(is_primal,row_B)) {
6409               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6410               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6411               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6412             } else {
6413               for (k=0;k<size_of_constraint;k++) {
6414                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6415                 if (row != col) {
6416                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6417                 } else {
6418                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6419                 }
6420                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6421               }
6422             }
6423           }
6424           if (pcbddc->dbg_flag) {
6425             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6426           }
6427         }
6428       } else {
6429         if (pcbddc->dbg_flag) {
6430           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6431         }
6432       }
6433     }
6434 
6435     /* free workspace */
6436     if (qr_needed) {
6437       if (pcbddc->dbg_flag) {
6438         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6439       }
6440       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6441       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6442       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6443       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6444       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6445     }
6446     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6447     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6448     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6449 
6450     /* assembling of global change of variable */
6451     if (!pcbddc->fake_change) {
6452       Mat      tmat;
6453       PetscInt bs;
6454 
6455       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6456       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6457       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6458       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6459       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6460       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6461       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6462       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6463       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6464       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6465       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6466       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6467       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6468       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6469       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6470       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6471       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6472       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6473 
6474       /* check */
6475       if (pcbddc->dbg_flag) {
6476         PetscReal error;
6477         Vec       x,x_change;
6478 
6479         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6480         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6481         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6482         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6483         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6484         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6485         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6486         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6487         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6488         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6489         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6490         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6491         if (error > PETSC_SMALL) {
6492           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6493         }
6494         ierr = VecDestroy(&x);CHKERRQ(ierr);
6495         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6496       }
6497       /* adapt sub_schurs computed (if any) */
6498       if (pcbddc->use_deluxe_scaling) {
6499         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6500 
6501         if (pcbddc->use_change_of_basis && pcbddc->adaptive_userdefined) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Cannot mix automatic change of basis, adaptive selection and user-defined constraints");
6502         if (sub_schurs && sub_schurs->S_Ej_all) {
6503           Mat                    S_new,tmat;
6504           IS                     is_all_N,is_V_Sall = NULL;
6505 
6506           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6507           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6508           if (pcbddc->deluxe_zerorows) {
6509             ISLocalToGlobalMapping NtoSall;
6510             IS                     is_V;
6511             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6512             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6513             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6514             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6515             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6516           }
6517           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6518           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6519           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6520           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6521           if (pcbddc->deluxe_zerorows) {
6522             const PetscScalar *array;
6523             const PetscInt    *idxs_V,*idxs_all;
6524             PetscInt          i,n_V;
6525 
6526             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6527             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6528             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6529             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6530             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6531             for (i=0;i<n_V;i++) {
6532               PetscScalar val;
6533               PetscInt    idx;
6534 
6535               idx = idxs_V[i];
6536               val = array[idxs_all[idxs_V[i]]];
6537               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6538             }
6539             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6540             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6541             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6542             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6543             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6544           }
6545           sub_schurs->S_Ej_all = S_new;
6546           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6547           if (sub_schurs->sum_S_Ej_all) {
6548             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6549             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6550             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6551             if (pcbddc->deluxe_zerorows) {
6552               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6553             }
6554             sub_schurs->sum_S_Ej_all = S_new;
6555             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6556           }
6557           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6558           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6559         }
6560         /* destroy any change of basis context in sub_schurs */
6561         if (sub_schurs && sub_schurs->change) {
6562           PetscInt i;
6563 
6564           for (i=0;i<sub_schurs->n_subs;i++) {
6565             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6566           }
6567           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6568         }
6569       }
6570       if (pcbddc->switch_static) { /* need to save the local change */
6571         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6572       } else {
6573         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6574       }
6575       /* determine if any process has changed the pressures locally */
6576       pcbddc->change_interior = pcbddc->benign_have_null;
6577     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6578       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6579       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6580       pcbddc->use_qr_single = qr_needed;
6581     }
6582   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6583     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6584       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6585       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6586     } else {
6587       Mat benign_global = NULL;
6588       if (pcbddc->benign_have_null) {
6589         Mat tmat;
6590 
6591         pcbddc->change_interior = PETSC_TRUE;
6592         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6593         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6594         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6595         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6596         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6597         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6598         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6599         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6600         if (pcbddc->benign_change) {
6601           Mat M;
6602 
6603           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6604           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6605           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6606           ierr = MatDestroy(&M);CHKERRQ(ierr);
6607         } else {
6608           Mat         eye;
6609           PetscScalar *array;
6610 
6611           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6612           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6613           for (i=0;i<pcis->n;i++) {
6614             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6615           }
6616           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6617           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6618           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6619           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6620           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6621         }
6622         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6623         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6624       }
6625       if (pcbddc->user_ChangeOfBasisMatrix) {
6626         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6627         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6628       } else if (pcbddc->benign_have_null) {
6629         pcbddc->ChangeOfBasisMatrix = benign_global;
6630       }
6631     }
6632     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6633       IS             is_global;
6634       const PetscInt *gidxs;
6635 
6636       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6637       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6638       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6639       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6640       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6641     }
6642   }
6643   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6644     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6645   }
6646 
6647   if (!pcbddc->fake_change) {
6648     /* add pressure dofs to set of primal nodes for numbering purposes */
6649     for (i=0;i<pcbddc->benign_n;i++) {
6650       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6651       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6652       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6653       pcbddc->local_primal_size_cc++;
6654       pcbddc->local_primal_size++;
6655     }
6656 
6657     /* check if a new primal space has been introduced (also take into account benign trick) */
6658     pcbddc->new_primal_space_local = PETSC_TRUE;
6659     if (olocal_primal_size == pcbddc->local_primal_size) {
6660       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6661       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6662       if (!pcbddc->new_primal_space_local) {
6663         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6664         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6665       }
6666     }
6667     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6668     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6669   }
6670   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6671 
6672   /* flush dbg viewer */
6673   if (pcbddc->dbg_flag) {
6674     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6675   }
6676 
6677   /* free workspace */
6678   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6679   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6680   if (!pcbddc->adaptive_selection) {
6681     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6682     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6683   } else {
6684     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6685                       pcbddc->adaptive_constraints_idxs_ptr,
6686                       pcbddc->adaptive_constraints_data_ptr,
6687                       pcbddc->adaptive_constraints_idxs,
6688                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6689     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6690     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6691   }
6692   PetscFunctionReturn(0);
6693 }
6694 /* #undef PETSC_MISSING_LAPACK_GESVD */
6695 
6696 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6697 {
6698   ISLocalToGlobalMapping map;
6699   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6700   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6701   PetscInt               i,N;
6702   PetscBool              rcsr = PETSC_FALSE;
6703   PetscErrorCode         ierr;
6704 
6705   PetscFunctionBegin;
6706   if (pcbddc->recompute_topography) {
6707     pcbddc->graphanalyzed = PETSC_FALSE;
6708     /* Reset previously computed graph */
6709     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6710     /* Init local Graph struct */
6711     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6712     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6713     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6714 
6715     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6716       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6717     }
6718     /* Check validity of the csr graph passed in by the user */
6719     if (pcbddc->mat_graph->nvtxs_csr && pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %d, expected %d\n",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
6720 
6721     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6722     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6723       PetscInt  *xadj,*adjncy;
6724       PetscInt  nvtxs;
6725       PetscBool flg_row=PETSC_FALSE;
6726 
6727       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6728       if (flg_row) {
6729         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6730         pcbddc->computed_rowadj = PETSC_TRUE;
6731       }
6732       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6733       rcsr = PETSC_TRUE;
6734     }
6735     if (pcbddc->dbg_flag) {
6736       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6737     }
6738 
6739     /* Setup of Graph */
6740     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6741     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6742 
6743     /* attach info on disconnected subdomains if present */
6744     if (pcbddc->n_local_subs) {
6745       PetscInt *local_subs;
6746 
6747       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6748       for (i=0;i<pcbddc->n_local_subs;i++) {
6749         const PetscInt *idxs;
6750         PetscInt       nl,j;
6751 
6752         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6753         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6754         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6755         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6756       }
6757       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6758       pcbddc->mat_graph->local_subs = local_subs;
6759     }
6760   }
6761 
6762   if (!pcbddc->graphanalyzed) {
6763     /* Graph's connected components analysis */
6764     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6765     pcbddc->graphanalyzed = PETSC_TRUE;
6766   }
6767   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6768   PetscFunctionReturn(0);
6769 }
6770 
6771 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6772 {
6773   PetscInt       i,j;
6774   PetscScalar    *alphas;
6775   PetscErrorCode ierr;
6776 
6777   PetscFunctionBegin;
6778   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6779   for (i=0;i<n;i++) {
6780     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6781     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6782     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6783     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6784   }
6785   ierr = PetscFree(alphas);CHKERRQ(ierr);
6786   PetscFunctionReturn(0);
6787 }
6788 
6789 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6790 {
6791   Mat            A;
6792   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6793   PetscMPIInt    size,rank,color;
6794   PetscInt       *xadj,*adjncy;
6795   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6796   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6797   PetscInt       void_procs,*procs_candidates = NULL;
6798   PetscInt       xadj_count,*count;
6799   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6800   PetscSubcomm   psubcomm;
6801   MPI_Comm       subcomm;
6802   PetscErrorCode ierr;
6803 
6804   PetscFunctionBegin;
6805   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6806   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6807   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
6808   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6809   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6810   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6811 
6812   if (have_void) *have_void = PETSC_FALSE;
6813   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6814   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6815   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6816   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6817   im_active = !!n;
6818   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6819   void_procs = size - active_procs;
6820   /* get ranks of of non-active processes in mat communicator */
6821   if (void_procs) {
6822     PetscInt ncand;
6823 
6824     if (have_void) *have_void = PETSC_TRUE;
6825     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6826     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6827     for (i=0,ncand=0;i<size;i++) {
6828       if (!procs_candidates[i]) {
6829         procs_candidates[ncand++] = i;
6830       }
6831     }
6832     /* force n_subdomains to be not greater that the number of non-active processes */
6833     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6834   }
6835 
6836   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6837      number of subdomains requested 1 -> send to master or first candidate in voids  */
6838   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6839   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6840     PetscInt issize,isidx,dest;
6841     if (*n_subdomains == 1) dest = 0;
6842     else dest = rank;
6843     if (im_active) {
6844       issize = 1;
6845       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6846         isidx = procs_candidates[dest];
6847       } else {
6848         isidx = dest;
6849       }
6850     } else {
6851       issize = 0;
6852       isidx = -1;
6853     }
6854     if (*n_subdomains != 1) *n_subdomains = active_procs;
6855     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6856     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6857     PetscFunctionReturn(0);
6858   }
6859   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6860   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6861   threshold = PetscMax(threshold,2);
6862 
6863   /* Get info on mapping */
6864   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6865 
6866   /* build local CSR graph of subdomains' connectivity */
6867   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6868   xadj[0] = 0;
6869   xadj[1] = PetscMax(n_neighs-1,0);
6870   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6871   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6872   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6873   for (i=1;i<n_neighs;i++)
6874     for (j=0;j<n_shared[i];j++)
6875       count[shared[i][j]] += 1;
6876 
6877   xadj_count = 0;
6878   for (i=1;i<n_neighs;i++) {
6879     for (j=0;j<n_shared[i];j++) {
6880       if (count[shared[i][j]] < threshold) {
6881         adjncy[xadj_count] = neighs[i];
6882         adjncy_wgt[xadj_count] = n_shared[i];
6883         xadj_count++;
6884         break;
6885       }
6886     }
6887   }
6888   xadj[1] = xadj_count;
6889   ierr = PetscFree(count);CHKERRQ(ierr);
6890   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6891   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6892 
6893   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6894 
6895   /* Restrict work on active processes only */
6896   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6897   if (void_procs) {
6898     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6899     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6900     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6901     subcomm = PetscSubcommChild(psubcomm);
6902   } else {
6903     psubcomm = NULL;
6904     subcomm = PetscObjectComm((PetscObject)mat);
6905   }
6906 
6907   v_wgt = NULL;
6908   if (!color) {
6909     ierr = PetscFree(xadj);CHKERRQ(ierr);
6910     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6911     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6912   } else {
6913     Mat             subdomain_adj;
6914     IS              new_ranks,new_ranks_contig;
6915     MatPartitioning partitioner;
6916     PetscInt        rstart=0,rend=0;
6917     PetscInt        *is_indices,*oldranks;
6918     PetscMPIInt     size;
6919     PetscBool       aggregate;
6920 
6921     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6922     if (void_procs) {
6923       PetscInt prank = rank;
6924       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6925       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6926       for (i=0;i<xadj[1];i++) {
6927         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6928       }
6929       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6930     } else {
6931       oldranks = NULL;
6932     }
6933     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6934     if (aggregate) { /* TODO: all this part could be made more efficient */
6935       PetscInt    lrows,row,ncols,*cols;
6936       PetscMPIInt nrank;
6937       PetscScalar *vals;
6938 
6939       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6940       lrows = 0;
6941       if (nrank<redprocs) {
6942         lrows = size/redprocs;
6943         if (nrank<size%redprocs) lrows++;
6944       }
6945       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6946       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6947       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6948       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6949       row = nrank;
6950       ncols = xadj[1]-xadj[0];
6951       cols = adjncy;
6952       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6953       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6954       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6955       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6956       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6957       ierr = PetscFree(xadj);CHKERRQ(ierr);
6958       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6959       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6960       ierr = PetscFree(vals);CHKERRQ(ierr);
6961       if (use_vwgt) {
6962         Vec               v;
6963         const PetscScalar *array;
6964         PetscInt          nl;
6965 
6966         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6967         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6968         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6969         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6970         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6971         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6972         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6973         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6974         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6975         ierr = VecDestroy(&v);CHKERRQ(ierr);
6976       }
6977     } else {
6978       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6979       if (use_vwgt) {
6980         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6981         v_wgt[0] = n;
6982       }
6983     }
6984     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6985 
6986     /* Partition */
6987     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6988     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6989     if (v_wgt) {
6990       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6991     }
6992     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6993     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6994     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6995     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6996     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6997 
6998     /* renumber new_ranks to avoid "holes" in new set of processors */
6999     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7000     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7001     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7002     if (!aggregate) {
7003       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7004 #if defined(PETSC_USE_DEBUG)
7005         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7006 #endif
7007         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7008       } else if (oldranks) {
7009         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7010       } else {
7011         ranks_send_to_idx[0] = is_indices[0];
7012       }
7013     } else {
7014       PetscInt    idx = 0;
7015       PetscMPIInt tag;
7016       MPI_Request *reqs;
7017 
7018       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7019       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7020       for (i=rstart;i<rend;i++) {
7021         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7022       }
7023       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7024       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7025       ierr = PetscFree(reqs);CHKERRQ(ierr);
7026       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7027 #if defined(PETSC_USE_DEBUG)
7028         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7029 #endif
7030         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7031       } else if (oldranks) {
7032         ranks_send_to_idx[0] = oldranks[idx];
7033       } else {
7034         ranks_send_to_idx[0] = idx;
7035       }
7036     }
7037     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7038     /* clean up */
7039     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7040     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7041     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7042     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7043   }
7044   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7045   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7046 
7047   /* assemble parallel IS for sends */
7048   i = 1;
7049   if (!color) i=0;
7050   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7051   PetscFunctionReturn(0);
7052 }
7053 
7054 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7055 
7056 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[])
7057 {
7058   Mat                    local_mat;
7059   IS                     is_sends_internal;
7060   PetscInt               rows,cols,new_local_rows;
7061   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7062   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7063   ISLocalToGlobalMapping l2gmap;
7064   PetscInt*              l2gmap_indices;
7065   const PetscInt*        is_indices;
7066   MatType                new_local_type;
7067   /* buffers */
7068   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7069   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7070   PetscInt               *recv_buffer_idxs_local;
7071   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7072   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7073   /* MPI */
7074   MPI_Comm               comm,comm_n;
7075   PetscSubcomm           subcomm;
7076   PetscMPIInt            n_sends,n_recvs,commsize;
7077   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7078   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7079   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7080   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7081   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7082   PetscErrorCode         ierr;
7083 
7084   PetscFunctionBegin;
7085   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7086   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7087   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
7088   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7089   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7090   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7091   PetscValidLogicalCollectiveBool(mat,reuse,6);
7092   PetscValidLogicalCollectiveInt(mat,nis,8);
7093   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7094   if (nvecs) {
7095     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7096     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7097   }
7098   /* further checks */
7099   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7100   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7101   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7102   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7103   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7104   if (reuse && *mat_n) {
7105     PetscInt mrows,mcols,mnrows,mncols;
7106     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7107     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7108     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7109     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7110     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7111     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7112     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7113   }
7114   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7115   PetscValidLogicalCollectiveInt(mat,bs,0);
7116 
7117   /* prepare IS for sending if not provided */
7118   if (!is_sends) {
7119     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7120     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7121   } else {
7122     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7123     is_sends_internal = is_sends;
7124   }
7125 
7126   /* get comm */
7127   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7128 
7129   /* compute number of sends */
7130   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7131   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7132 
7133   /* compute number of receives */
7134   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7135   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7136   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7137   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7138   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7139   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7140   ierr = PetscFree(iflags);CHKERRQ(ierr);
7141 
7142   /* restrict comm if requested */
7143   subcomm = 0;
7144   destroy_mat = PETSC_FALSE;
7145   if (restrict_comm) {
7146     PetscMPIInt color,subcommsize;
7147 
7148     color = 0;
7149     if (restrict_full) {
7150       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7151     } else {
7152       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7153     }
7154     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7155     subcommsize = commsize - subcommsize;
7156     /* check if reuse has been requested */
7157     if (reuse) {
7158       if (*mat_n) {
7159         PetscMPIInt subcommsize2;
7160         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7161         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7162         comm_n = PetscObjectComm((PetscObject)*mat_n);
7163       } else {
7164         comm_n = PETSC_COMM_SELF;
7165       }
7166     } else { /* MAT_INITIAL_MATRIX */
7167       PetscMPIInt rank;
7168 
7169       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7170       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7171       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7172       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7173       comm_n = PetscSubcommChild(subcomm);
7174     }
7175     /* flag to destroy *mat_n if not significative */
7176     if (color) destroy_mat = PETSC_TRUE;
7177   } else {
7178     comm_n = comm;
7179   }
7180 
7181   /* prepare send/receive buffers */
7182   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7183   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7184   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7185   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7186   if (nis) {
7187     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7188   }
7189 
7190   /* Get data from local matrices */
7191   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7192     /* TODO: See below some guidelines on how to prepare the local buffers */
7193     /*
7194        send_buffer_vals should contain the raw values of the local matrix
7195        send_buffer_idxs should contain:
7196        - MatType_PRIVATE type
7197        - PetscInt        size_of_l2gmap
7198        - PetscInt        global_row_indices[size_of_l2gmap]
7199        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7200     */
7201   else {
7202     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7203     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7204     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7205     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7206     send_buffer_idxs[1] = i;
7207     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7208     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7209     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7210     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7211     for (i=0;i<n_sends;i++) {
7212       ilengths_vals[is_indices[i]] = len*len;
7213       ilengths_idxs[is_indices[i]] = len+2;
7214     }
7215   }
7216   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7217   /* additional is (if any) */
7218   if (nis) {
7219     PetscMPIInt psum;
7220     PetscInt j;
7221     for (j=0,psum=0;j<nis;j++) {
7222       PetscInt plen;
7223       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7224       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7225       psum += len+1; /* indices + lenght */
7226     }
7227     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7228     for (j=0,psum=0;j<nis;j++) {
7229       PetscInt plen;
7230       const PetscInt *is_array_idxs;
7231       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7232       send_buffer_idxs_is[psum] = plen;
7233       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7234       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7235       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7236       psum += plen+1; /* indices + lenght */
7237     }
7238     for (i=0;i<n_sends;i++) {
7239       ilengths_idxs_is[is_indices[i]] = psum;
7240     }
7241     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7242   }
7243   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7244 
7245   buf_size_idxs = 0;
7246   buf_size_vals = 0;
7247   buf_size_idxs_is = 0;
7248   buf_size_vecs = 0;
7249   for (i=0;i<n_recvs;i++) {
7250     buf_size_idxs += (PetscInt)olengths_idxs[i];
7251     buf_size_vals += (PetscInt)olengths_vals[i];
7252     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7253     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7254   }
7255   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7256   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7257   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7258   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7259 
7260   /* get new tags for clean communications */
7261   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7262   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7263   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7264   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7265 
7266   /* allocate for requests */
7267   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7268   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7269   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7270   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7271   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7272   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7273   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7274   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7275 
7276   /* communications */
7277   ptr_idxs = recv_buffer_idxs;
7278   ptr_vals = recv_buffer_vals;
7279   ptr_idxs_is = recv_buffer_idxs_is;
7280   ptr_vecs = recv_buffer_vecs;
7281   for (i=0;i<n_recvs;i++) {
7282     source_dest = onodes[i];
7283     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7284     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7285     ptr_idxs += olengths_idxs[i];
7286     ptr_vals += olengths_vals[i];
7287     if (nis) {
7288       source_dest = onodes_is[i];
7289       ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRQ(ierr);
7290       ptr_idxs_is += olengths_idxs_is[i];
7291     }
7292     if (nvecs) {
7293       source_dest = onodes[i];
7294       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7295       ptr_vecs += olengths_idxs[i]-2;
7296     }
7297   }
7298   for (i=0;i<n_sends;i++) {
7299     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7300     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7301     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7302     if (nis) {
7303       ierr = MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]);CHKERRQ(ierr);
7304     }
7305     if (nvecs) {
7306       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7307       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7308     }
7309   }
7310   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7311   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7312 
7313   /* assemble new l2g map */
7314   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7315   ptr_idxs = recv_buffer_idxs;
7316   new_local_rows = 0;
7317   for (i=0;i<n_recvs;i++) {
7318     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7319     ptr_idxs += olengths_idxs[i];
7320   }
7321   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7322   ptr_idxs = recv_buffer_idxs;
7323   new_local_rows = 0;
7324   for (i=0;i<n_recvs;i++) {
7325     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7326     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7327     ptr_idxs += olengths_idxs[i];
7328   }
7329   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7330   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7331   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7332 
7333   /* infer new local matrix type from received local matrices type */
7334   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7335   /* 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) */
7336   if (n_recvs) {
7337     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7338     ptr_idxs = recv_buffer_idxs;
7339     for (i=0;i<n_recvs;i++) {
7340       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7341         new_local_type_private = MATAIJ_PRIVATE;
7342         break;
7343       }
7344       ptr_idxs += olengths_idxs[i];
7345     }
7346     switch (new_local_type_private) {
7347       case MATDENSE_PRIVATE:
7348         new_local_type = MATSEQAIJ;
7349         bs = 1;
7350         break;
7351       case MATAIJ_PRIVATE:
7352         new_local_type = MATSEQAIJ;
7353         bs = 1;
7354         break;
7355       case MATBAIJ_PRIVATE:
7356         new_local_type = MATSEQBAIJ;
7357         break;
7358       case MATSBAIJ_PRIVATE:
7359         new_local_type = MATSEQSBAIJ;
7360         break;
7361       default:
7362         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7363         break;
7364     }
7365   } else { /* by default, new_local_type is seqaij */
7366     new_local_type = MATSEQAIJ;
7367     bs = 1;
7368   }
7369 
7370   /* create MATIS object if needed */
7371   if (!reuse) {
7372     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7373     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7374   } else {
7375     /* it also destroys the local matrices */
7376     if (*mat_n) {
7377       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7378     } else { /* this is a fake object */
7379       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7380     }
7381   }
7382   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7383   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7384 
7385   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7386 
7387   /* Global to local map of received indices */
7388   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7389   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7390   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7391 
7392   /* restore attributes -> type of incoming data and its size */
7393   buf_size_idxs = 0;
7394   for (i=0;i<n_recvs;i++) {
7395     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7396     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7397     buf_size_idxs += (PetscInt)olengths_idxs[i];
7398   }
7399   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7400 
7401   /* set preallocation */
7402   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7403   if (!newisdense) {
7404     PetscInt *new_local_nnz=0;
7405 
7406     ptr_idxs = recv_buffer_idxs_local;
7407     if (n_recvs) {
7408       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7409     }
7410     for (i=0;i<n_recvs;i++) {
7411       PetscInt j;
7412       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7413         for (j=0;j<*(ptr_idxs+1);j++) {
7414           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7415         }
7416       } else {
7417         /* TODO */
7418       }
7419       ptr_idxs += olengths_idxs[i];
7420     }
7421     if (new_local_nnz) {
7422       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7423       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7424       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7425       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7426       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7427       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7428     } else {
7429       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7430     }
7431     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7432   } else {
7433     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7434   }
7435 
7436   /* set values */
7437   ptr_vals = recv_buffer_vals;
7438   ptr_idxs = recv_buffer_idxs_local;
7439   for (i=0;i<n_recvs;i++) {
7440     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7441       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7442       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7443       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7444       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7445       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7446     } else {
7447       /* TODO */
7448     }
7449     ptr_idxs += olengths_idxs[i];
7450     ptr_vals += olengths_vals[i];
7451   }
7452   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7453   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7454   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7455   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7456   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7457   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7458 
7459 #if 0
7460   if (!restrict_comm) { /* check */
7461     Vec       lvec,rvec;
7462     PetscReal infty_error;
7463 
7464     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7465     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7466     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7467     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7468     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7469     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7470     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7471     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7472     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7473   }
7474 #endif
7475 
7476   /* assemble new additional is (if any) */
7477   if (nis) {
7478     PetscInt **temp_idxs,*count_is,j,psum;
7479 
7480     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7481     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7482     ptr_idxs = recv_buffer_idxs_is;
7483     psum = 0;
7484     for (i=0;i<n_recvs;i++) {
7485       for (j=0;j<nis;j++) {
7486         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7487         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7488         psum += plen;
7489         ptr_idxs += plen+1; /* shift pointer to received data */
7490       }
7491     }
7492     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7493     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7494     for (i=1;i<nis;i++) {
7495       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7496     }
7497     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7498     ptr_idxs = recv_buffer_idxs_is;
7499     for (i=0;i<n_recvs;i++) {
7500       for (j=0;j<nis;j++) {
7501         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7502         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7503         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7504         ptr_idxs += plen+1; /* shift pointer to received data */
7505       }
7506     }
7507     for (i=0;i<nis;i++) {
7508       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7509       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7510       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7511     }
7512     ierr = PetscFree(count_is);CHKERRQ(ierr);
7513     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7514     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7515   }
7516   /* free workspace */
7517   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7518   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7519   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7520   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7521   if (isdense) {
7522     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7523     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7524     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7525   } else {
7526     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7527   }
7528   if (nis) {
7529     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7530     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7531   }
7532 
7533   if (nvecs) {
7534     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7535     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7536     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7537     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7538     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7539     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7540     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7541     /* set values */
7542     ptr_vals = recv_buffer_vecs;
7543     ptr_idxs = recv_buffer_idxs_local;
7544     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7545     for (i=0;i<n_recvs;i++) {
7546       PetscInt j;
7547       for (j=0;j<*(ptr_idxs+1);j++) {
7548         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7549       }
7550       ptr_idxs += olengths_idxs[i];
7551       ptr_vals += olengths_idxs[i]-2;
7552     }
7553     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7554     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7555     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7556   }
7557 
7558   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7559   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7560   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7561   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7562   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7563   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7564   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7565   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7566   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7567   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7568   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7569   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7570   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7571   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7572   ierr = PetscFree(onodes);CHKERRQ(ierr);
7573   if (nis) {
7574     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7575     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7576     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7577   }
7578   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7579   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7580     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7581     for (i=0;i<nis;i++) {
7582       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7583     }
7584     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7585       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7586     }
7587     *mat_n = NULL;
7588   }
7589   PetscFunctionReturn(0);
7590 }
7591 
7592 /* temporary hack into ksp private data structure */
7593 #include <petsc/private/kspimpl.h>
7594 
7595 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7596 {
7597   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7598   PC_IS                  *pcis = (PC_IS*)pc->data;
7599   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7600   Mat                    coarsedivudotp = NULL;
7601   Mat                    coarseG,t_coarse_mat_is;
7602   MatNullSpace           CoarseNullSpace = NULL;
7603   ISLocalToGlobalMapping coarse_islg;
7604   IS                     coarse_is,*isarray;
7605   PetscInt               i,im_active=-1,active_procs=-1;
7606   PetscInt               nis,nisdofs,nisneu,nisvert;
7607   PC                     pc_temp;
7608   PCType                 coarse_pc_type;
7609   KSPType                coarse_ksp_type;
7610   PetscBool              multilevel_requested,multilevel_allowed;
7611   PetscBool              coarse_reuse;
7612   PetscInt               ncoarse,nedcfield;
7613   PetscBool              compute_vecs = PETSC_FALSE;
7614   PetscScalar            *array;
7615   MatReuse               coarse_mat_reuse;
7616   PetscBool              restr, full_restr, have_void;
7617   PetscMPIInt            commsize;
7618   PetscErrorCode         ierr;
7619 
7620   PetscFunctionBegin;
7621   /* Assign global numbering to coarse dofs */
7622   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 */
7623     PetscInt ocoarse_size;
7624     compute_vecs = PETSC_TRUE;
7625 
7626     pcbddc->new_primal_space = PETSC_TRUE;
7627     ocoarse_size = pcbddc->coarse_size;
7628     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7629     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7630     /* see if we can avoid some work */
7631     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7632       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7633       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7634         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7635         coarse_reuse = PETSC_FALSE;
7636       } else { /* we can safely reuse already computed coarse matrix */
7637         coarse_reuse = PETSC_TRUE;
7638       }
7639     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7640       coarse_reuse = PETSC_FALSE;
7641     }
7642     /* reset any subassembling information */
7643     if (!coarse_reuse || pcbddc->recompute_topography) {
7644       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7645     }
7646   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7647     coarse_reuse = PETSC_TRUE;
7648   }
7649   /* assemble coarse matrix */
7650   if (coarse_reuse && pcbddc->coarse_ksp) {
7651     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7652     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7653     coarse_mat_reuse = MAT_REUSE_MATRIX;
7654   } else {
7655     coarse_mat = NULL;
7656     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7657   }
7658 
7659   /* creates temporary l2gmap and IS for coarse indexes */
7660   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7661   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7662 
7663   /* creates temporary MATIS object for coarse matrix */
7664   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7665   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7666   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7667   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7668   ierr = MatCreateIS(PetscObjectComm((PetscObject)pc),1,PETSC_DECIDE,PETSC_DECIDE,pcbddc->coarse_size,pcbddc->coarse_size,coarse_islg,NULL,&t_coarse_mat_is);CHKERRQ(ierr);
7669   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7670   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7671   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7672   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7673 
7674   /* count "active" (i.e. with positive local size) and "void" processes */
7675   im_active = !!(pcis->n);
7676   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7677 
7678   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7679   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7680   /* full_restr : just use the receivers from the subassembling pattern */
7681   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7682   coarse_mat_is = NULL;
7683   multilevel_allowed = PETSC_FALSE;
7684   multilevel_requested = PETSC_FALSE;
7685   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7686   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7687   if (multilevel_requested) {
7688     ncoarse = active_procs/pcbddc->coarsening_ratio;
7689     restr = PETSC_FALSE;
7690     full_restr = PETSC_FALSE;
7691   } else {
7692     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7693     restr = PETSC_TRUE;
7694     full_restr = PETSC_TRUE;
7695   }
7696   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7697   ncoarse = PetscMax(1,ncoarse);
7698   if (!pcbddc->coarse_subassembling) {
7699     if (pcbddc->coarsening_ratio > 1) {
7700       if (multilevel_requested) {
7701         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7702       } else {
7703         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7704       }
7705     } else {
7706       PetscMPIInt rank;
7707       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7708       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7709       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7710     }
7711   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7712     PetscInt    psum;
7713     if (pcbddc->coarse_ksp) psum = 1;
7714     else psum = 0;
7715     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7716     if (ncoarse < commsize) have_void = PETSC_TRUE;
7717   }
7718   /* determine if we can go multilevel */
7719   if (multilevel_requested) {
7720     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7721     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7722   }
7723   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7724 
7725   /* dump subassembling pattern */
7726   if (pcbddc->dbg_flag && multilevel_allowed) {
7727     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7728   }
7729 
7730   /* compute dofs splitting and neumann boundaries for coarse dofs */
7731   nedcfield = -1;
7732   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7733     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7734     const PetscInt         *idxs;
7735     ISLocalToGlobalMapping tmap;
7736 
7737     /* create map between primal indices (in local representative ordering) and local primal numbering */
7738     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7739     /* allocate space for temporary storage */
7740     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7741     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7742     /* allocate for IS array */
7743     nisdofs = pcbddc->n_ISForDofsLocal;
7744     if (pcbddc->nedclocal) {
7745       if (pcbddc->nedfield > -1) {
7746         nedcfield = pcbddc->nedfield;
7747       } else {
7748         nedcfield = 0;
7749         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7750         nisdofs = 1;
7751       }
7752     }
7753     nisneu = !!pcbddc->NeumannBoundariesLocal;
7754     nisvert = 0; /* nisvert is not used */
7755     nis = nisdofs + nisneu + nisvert;
7756     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7757     /* dofs splitting */
7758     for (i=0;i<nisdofs;i++) {
7759       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7760       if (nedcfield != i) {
7761         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7762         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7763         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7764         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7765       } else {
7766         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7767         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7768         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7769         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7770         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7771       }
7772       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7773       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7774       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7775     }
7776     /* neumann boundaries */
7777     if (pcbddc->NeumannBoundariesLocal) {
7778       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7779       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7780       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7781       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7782       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7783       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7784       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7785       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7786     }
7787     /* free memory */
7788     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7789     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7790     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7791   } else {
7792     nis = 0;
7793     nisdofs = 0;
7794     nisneu = 0;
7795     nisvert = 0;
7796     isarray = NULL;
7797   }
7798   /* destroy no longer needed map */
7799   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7800 
7801   /* subassemble */
7802   if (multilevel_allowed) {
7803     Vec       vp[1];
7804     PetscInt  nvecs = 0;
7805     PetscBool reuse,reuser;
7806 
7807     if (coarse_mat) reuse = PETSC_TRUE;
7808     else reuse = PETSC_FALSE;
7809     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7810     vp[0] = NULL;
7811     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7812       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7813       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7814       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7815       nvecs = 1;
7816 
7817       if (pcbddc->divudotp) {
7818         Mat      B,loc_divudotp;
7819         Vec      v,p;
7820         IS       dummy;
7821         PetscInt np;
7822 
7823         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7824         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7825         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7826         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7827         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7828         ierr = VecSet(p,1.);CHKERRQ(ierr);
7829         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7830         ierr = VecDestroy(&p);CHKERRQ(ierr);
7831         ierr = MatDestroy(&B);CHKERRQ(ierr);
7832         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7833         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7834         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7835         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7836         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7837         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7838         ierr = VecDestroy(&v);CHKERRQ(ierr);
7839       }
7840     }
7841     if (reuser) {
7842       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7843     } else {
7844       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7845     }
7846     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7847       PetscScalar *arraym,*arrayv;
7848       PetscInt    nl;
7849       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7850       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7851       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7852       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7853       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7854       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7855       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7856       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7857     } else {
7858       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7859     }
7860   } else {
7861     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7862   }
7863   if (coarse_mat_is || coarse_mat) {
7864     PetscMPIInt size;
7865     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7866     if (!multilevel_allowed) {
7867       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7868     } else {
7869       Mat A;
7870 
7871       /* if this matrix is present, it means we are not reusing the coarse matrix */
7872       if (coarse_mat_is) {
7873         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7874         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7875         coarse_mat = coarse_mat_is;
7876       }
7877       /* be sure we don't have MatSeqDENSE as local mat */
7878       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7879       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7880     }
7881   }
7882   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7883   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7884 
7885   /* create local to global scatters for coarse problem */
7886   if (compute_vecs) {
7887     PetscInt lrows;
7888     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7889     if (coarse_mat) {
7890       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7891     } else {
7892       lrows = 0;
7893     }
7894     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7895     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7896     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7897     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7898     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7899   }
7900   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7901 
7902   /* set defaults for coarse KSP and PC */
7903   if (multilevel_allowed) {
7904     coarse_ksp_type = KSPRICHARDSON;
7905     coarse_pc_type = PCBDDC;
7906   } else {
7907     coarse_ksp_type = KSPPREONLY;
7908     coarse_pc_type = PCREDUNDANT;
7909   }
7910 
7911   /* print some info if requested */
7912   if (pcbddc->dbg_flag) {
7913     if (!multilevel_allowed) {
7914       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7915       if (multilevel_requested) {
7916         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Not enough active processes on level %d (active processes %d, coarsening ratio %d)\n",pcbddc->current_level,active_procs,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7917       } else if (pcbddc->max_levels) {
7918         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7919       }
7920       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7921     }
7922   }
7923 
7924   /* communicate coarse discrete gradient */
7925   coarseG = NULL;
7926   if (pcbddc->nedcG && multilevel_allowed) {
7927     MPI_Comm ccomm;
7928     if (coarse_mat) {
7929       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7930     } else {
7931       ccomm = MPI_COMM_NULL;
7932     }
7933     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7934   }
7935 
7936   /* create the coarse KSP object only once with defaults */
7937   if (coarse_mat) {
7938     PetscBool   isredundant,isnn,isbddc;
7939     PetscViewer dbg_viewer = NULL;
7940 
7941     if (pcbddc->dbg_flag) {
7942       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7943       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7944     }
7945     if (!pcbddc->coarse_ksp) {
7946       char prefix[256],str_level[16];
7947       size_t len;
7948 
7949       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7950       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7951       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7952       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7953       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7954       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7955       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7956       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7957       /* TODO is this logic correct? should check for coarse_mat type */
7958       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7959       /* prefix */
7960       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7961       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7962       if (!pcbddc->current_level) {
7963         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7964         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7965       } else {
7966         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7967         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7968         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7969         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7970         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
7971         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7972       }
7973       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7974       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7975       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7976       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7977       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7978       /* allow user customization */
7979       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7980     }
7981     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7982     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7983     if (nisdofs) {
7984       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7985       for (i=0;i<nisdofs;i++) {
7986         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7987       }
7988     }
7989     if (nisneu) {
7990       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7991       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7992     }
7993     if (nisvert) {
7994       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7995       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7996     }
7997     if (coarseG) {
7998       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7999     }
8000 
8001     /* get some info after set from options */
8002     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8003     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8004     if (isbddc && !multilevel_allowed) {
8005       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8006       isbddc = PETSC_FALSE;
8007     }
8008     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8009     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8010     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8011       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8012       isbddc = PETSC_TRUE;
8013     }
8014     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8015     if (isredundant) {
8016       KSP inner_ksp;
8017       PC  inner_pc;
8018 
8019       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8020       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8021     }
8022 
8023     /* parameters which miss an API */
8024     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8025     if (isbddc) {
8026       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8027 
8028       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8029       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8030       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8031       if (pcbddc_coarse->benign_saddle_point) {
8032         Mat                    coarsedivudotp_is;
8033         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8034         IS                     row,col;
8035         const PetscInt         *gidxs;
8036         PetscInt               n,st,M,N;
8037 
8038         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8039         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8040         st   = st-n;
8041         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8042         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8043         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8044         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8045         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8046         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8047         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8048         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8049         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8050         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8051         ierr = ISDestroy(&row);CHKERRQ(ierr);
8052         ierr = ISDestroy(&col);CHKERRQ(ierr);
8053         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8054         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8055         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8056         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8057         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8058         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8059         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8060         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8061         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8062         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8063         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8064         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8065       }
8066     }
8067 
8068     /* propagate symmetry info of coarse matrix */
8069     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8070     if (pc->pmat->symmetric_set) {
8071       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8072     }
8073     if (pc->pmat->hermitian_set) {
8074       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8075     }
8076     if (pc->pmat->spd_set) {
8077       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8078     }
8079     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8080       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8081     }
8082     /* set operators */
8083     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8084     if (pcbddc->dbg_flag) {
8085       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8086     }
8087   }
8088   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8089   ierr = PetscFree(isarray);CHKERRQ(ierr);
8090 #if 0
8091   {
8092     PetscViewer viewer;
8093     char filename[256];
8094     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8095     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8096     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8097     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8098     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8099     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8100   }
8101 #endif
8102 
8103   if (pcbddc->coarse_ksp) {
8104     Vec crhs,csol;
8105 
8106     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8107     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8108     if (!csol) {
8109       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8110     }
8111     if (!crhs) {
8112       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8113     }
8114   }
8115   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8116 
8117   /* compute null space for coarse solver if the benign trick has been requested */
8118   if (pcbddc->benign_null) {
8119 
8120     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8121     for (i=0;i<pcbddc->benign_n;i++) {
8122       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8123     }
8124     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8125     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8126     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8127     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8128     if (coarse_mat) {
8129       Vec         nullv;
8130       PetscScalar *array,*array2;
8131       PetscInt    nl;
8132 
8133       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8134       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8135       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8136       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8137       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8138       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8139       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8140       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8141       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8142       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8143     }
8144   }
8145 
8146   if (pcbddc->coarse_ksp) {
8147     PetscBool ispreonly;
8148 
8149     if (CoarseNullSpace) {
8150       PetscBool isnull;
8151       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8152       if (isnull) {
8153         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8154       }
8155       /* TODO: add local nullspaces (if any) */
8156     }
8157     /* setup coarse ksp */
8158     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8159     /* Check coarse problem if in debug mode or if solving with an iterative method */
8160     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8161     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8162       KSP       check_ksp;
8163       KSPType   check_ksp_type;
8164       PC        check_pc;
8165       Vec       check_vec,coarse_vec;
8166       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8167       PetscInt  its;
8168       PetscBool compute_eigs;
8169       PetscReal *eigs_r,*eigs_c;
8170       PetscInt  neigs;
8171       const char *prefix;
8172 
8173       /* Create ksp object suitable for estimation of extreme eigenvalues */
8174       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8175       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8176       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8177       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8178       /* prevent from setup unneeded object */
8179       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8180       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8181       if (ispreonly) {
8182         check_ksp_type = KSPPREONLY;
8183         compute_eigs = PETSC_FALSE;
8184       } else {
8185         check_ksp_type = KSPGMRES;
8186         compute_eigs = PETSC_TRUE;
8187       }
8188       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8189       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8190       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8191       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8192       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8193       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8194       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8195       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8196       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8197       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8198       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8199       /* create random vec */
8200       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8201       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8202       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8203       /* solve coarse problem */
8204       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8205       /* set eigenvalue estimation if preonly has not been requested */
8206       if (compute_eigs) {
8207         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8208         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8209         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8210         if (neigs) {
8211           lambda_max = eigs_r[neigs-1];
8212           lambda_min = eigs_r[0];
8213           if (pcbddc->use_coarse_estimates) {
8214             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8215               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8216               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8217             }
8218           }
8219         }
8220       }
8221 
8222       /* check coarse problem residual error */
8223       if (pcbddc->dbg_flag) {
8224         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8225         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8226         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8227         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8228         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8229         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8230         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8231         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8232         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8233         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8234         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8235         if (CoarseNullSpace) {
8236           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8237         }
8238         if (compute_eigs) {
8239           PetscReal          lambda_max_s,lambda_min_s;
8240           KSPConvergedReason reason;
8241           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8242           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8243           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8244           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8245           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem eigenvalues (estimated with %d iterations of %s, conv reason %d): %1.6e %1.6e (%1.6e %1.6e)\n",its,check_ksp_type,reason,lambda_min,lambda_max,lambda_min_s,lambda_max_s);CHKERRQ(ierr);
8246           for (i=0;i<neigs;i++) {
8247             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8248           }
8249         }
8250         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8251         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8252       }
8253       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8254       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8255       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8256       if (compute_eigs) {
8257         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8258         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8259       }
8260     }
8261   }
8262   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8263   /* print additional info */
8264   if (pcbddc->dbg_flag) {
8265     /* waits until all processes reaches this point */
8266     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8267     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8268     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8269   }
8270 
8271   /* free memory */
8272   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8273   PetscFunctionReturn(0);
8274 }
8275 
8276 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8277 {
8278   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8279   PC_IS*         pcis = (PC_IS*)pc->data;
8280   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8281   IS             subset,subset_mult,subset_n;
8282   PetscInt       local_size,coarse_size=0;
8283   PetscInt       *local_primal_indices=NULL;
8284   const PetscInt *t_local_primal_indices;
8285   PetscErrorCode ierr;
8286 
8287   PetscFunctionBegin;
8288   /* Compute global number of coarse dofs */
8289   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8290   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8291   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8292   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8293   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8294   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8295   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8296   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8297   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8298   if (local_size != pcbddc->local_primal_size) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Invalid number of local primal indices computed %D != %D",local_size,pcbddc->local_primal_size);
8299   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8300   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8301   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8302   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8303   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8304 
8305   /* check numbering */
8306   if (pcbddc->dbg_flag) {
8307     PetscScalar coarsesum,*array,*array2;
8308     PetscInt    i;
8309     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8310 
8311     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8312     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8313     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8314     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8315     /* counter */
8316     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8317     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8318     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8319     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8320     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8321     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8322     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8323     for (i=0;i<pcbddc->local_primal_size;i++) {
8324       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8325     }
8326     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8327     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8328     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8329     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8330     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8331     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8332     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8333     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8334     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8335     for (i=0;i<pcis->n;i++) {
8336       if (array[i] != 0.0 && array[i] != array2[i]) {
8337         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8338         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8339         set_error = PETSC_TRUE;
8340         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8341         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d: local index %d (gid %d) owned by %d processes instead of %d!\n",PetscGlobalRank,i,gi,owned,neigh);CHKERRQ(ierr);
8342       }
8343     }
8344     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8345     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8346     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8347     for (i=0;i<pcis->n;i++) {
8348       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8349     }
8350     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8351     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8352     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8353     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8354     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8355     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8356     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8357       PetscInt *gidxs;
8358 
8359       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8360       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8361       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8362       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8363       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8364       for (i=0;i<pcbddc->local_primal_size;i++) {
8365         ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_primal_indices[%d]=%d (%d,%d)\n",i,local_primal_indices[i],pcbddc->primal_indices_local_idxs[i],gidxs[i]);CHKERRQ(ierr);
8366       }
8367       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8368       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8369     }
8370     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8371     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8372     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8373   }
8374   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8375   /* get back data */
8376   *coarse_size_n = coarse_size;
8377   *local_primal_indices_n = local_primal_indices;
8378   PetscFunctionReturn(0);
8379 }
8380 
8381 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8382 {
8383   IS             localis_t;
8384   PetscInt       i,lsize,*idxs,n;
8385   PetscScalar    *vals;
8386   PetscErrorCode ierr;
8387 
8388   PetscFunctionBegin;
8389   /* get indices in local ordering exploiting local to global map */
8390   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8391   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8392   for (i=0;i<lsize;i++) vals[i] = 1.0;
8393   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8394   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8395   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8396   if (idxs) { /* multilevel guard */
8397     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8398     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8399   }
8400   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8401   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8402   ierr = PetscFree(vals);CHKERRQ(ierr);
8403   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8404   /* now compute set in local ordering */
8405   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8406   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8407   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8408   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8409   for (i=0,lsize=0;i<n;i++) {
8410     if (PetscRealPart(vals[i]) > 0.5) {
8411       lsize++;
8412     }
8413   }
8414   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8415   for (i=0,lsize=0;i<n;i++) {
8416     if (PetscRealPart(vals[i]) > 0.5) {
8417       idxs[lsize++] = i;
8418     }
8419   }
8420   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8421   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8422   *localis = localis_t;
8423   PetscFunctionReturn(0);
8424 }
8425 
8426 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8427 {
8428   PC_IS               *pcis=(PC_IS*)pc->data;
8429   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8430   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8431   Mat                 S_j;
8432   PetscInt            *used_xadj,*used_adjncy;
8433   PetscBool           free_used_adj;
8434   PetscErrorCode      ierr;
8435 
8436   PetscFunctionBegin;
8437   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8438   free_used_adj = PETSC_FALSE;
8439   if (pcbddc->sub_schurs_layers == -1) {
8440     used_xadj = NULL;
8441     used_adjncy = NULL;
8442   } else {
8443     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8444       used_xadj = pcbddc->mat_graph->xadj;
8445       used_adjncy = pcbddc->mat_graph->adjncy;
8446     } else if (pcbddc->computed_rowadj) {
8447       used_xadj = pcbddc->mat_graph->xadj;
8448       used_adjncy = pcbddc->mat_graph->adjncy;
8449     } else {
8450       PetscBool      flg_row=PETSC_FALSE;
8451       const PetscInt *xadj,*adjncy;
8452       PetscInt       nvtxs;
8453 
8454       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8455       if (flg_row) {
8456         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8457         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8458         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8459         free_used_adj = PETSC_TRUE;
8460       } else {
8461         pcbddc->sub_schurs_layers = -1;
8462         used_xadj = NULL;
8463         used_adjncy = NULL;
8464       }
8465       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8466     }
8467   }
8468 
8469   /* setup sub_schurs data */
8470   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8471   if (!sub_schurs->schur_explicit) {
8472     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8473     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8474     ierr = 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);CHKERRQ(ierr);
8475   } else {
8476     Mat       change = NULL;
8477     Vec       scaling = NULL;
8478     IS        change_primal = NULL, iP;
8479     PetscInt  benign_n;
8480     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8481     PetscBool isseqaij,need_change = PETSC_FALSE;
8482     PetscBool discrete_harmonic = PETSC_FALSE;
8483 
8484     if (!pcbddc->use_vertices && reuse_solvers) {
8485       PetscInt n_vertices;
8486 
8487       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8488       reuse_solvers = (PetscBool)!n_vertices;
8489     }
8490     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8491     if (!isseqaij) {
8492       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8493       if (matis->A == pcbddc->local_mat) {
8494         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8495         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8496       } else {
8497         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8498       }
8499     }
8500     if (!pcbddc->benign_change_explicit) {
8501       benign_n = pcbddc->benign_n;
8502     } else {
8503       benign_n = 0;
8504     }
8505     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8506        We need a global reduction to avoid possible deadlocks.
8507        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8508     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8509       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8510       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8511       need_change = (PetscBool)(!need_change);
8512     }
8513     /* If the user defines additional constraints, we import them here.
8514        We need to compute the change of basis according to the quadrature weights attached to pmat via MatSetNearNullSpace, and this could not be done (at the moment) without some hacking */
8515     if (need_change) {
8516       PC_IS   *pcisf;
8517       PC_BDDC *pcbddcf;
8518       PC      pcf;
8519 
8520       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8521       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8522       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8523       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8524 
8525       /* hacks */
8526       pcisf                        = (PC_IS*)pcf->data;
8527       pcisf->is_B_local            = pcis->is_B_local;
8528       pcisf->vec1_N                = pcis->vec1_N;
8529       pcisf->BtoNmap               = pcis->BtoNmap;
8530       pcisf->n                     = pcis->n;
8531       pcisf->n_B                   = pcis->n_B;
8532       pcbddcf                      = (PC_BDDC*)pcf->data;
8533       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8534       pcbddcf->mat_graph           = pcbddc->mat_graph;
8535       pcbddcf->use_faces           = PETSC_TRUE;
8536       pcbddcf->use_change_of_basis = PETSC_TRUE;
8537       pcbddcf->use_change_on_faces = PETSC_TRUE;
8538       pcbddcf->use_qr_single       = PETSC_TRUE;
8539       pcbddcf->fake_change         = PETSC_TRUE;
8540 
8541       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8542       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8543       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8544       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8545       change = pcbddcf->ConstraintMatrix;
8546       pcbddcf->ConstraintMatrix = NULL;
8547 
8548       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8549       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8550       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8551       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8552       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8553       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8554       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8555       pcf->ops->destroy = NULL;
8556       pcf->ops->reset   = NULL;
8557       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8558     }
8559     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8560 
8561     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8562     if (iP) {
8563       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8564       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8565       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8566     }
8567     if (discrete_harmonic) {
8568       Mat A;
8569       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8570       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8571       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8572       ierr = 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);CHKERRQ(ierr);
8573       ierr = MatDestroy(&A);CHKERRQ(ierr);
8574     } else {
8575       ierr = 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);CHKERRQ(ierr);
8576     }
8577     ierr = MatDestroy(&change);CHKERRQ(ierr);
8578     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8579   }
8580   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8581 
8582   /* free adjacency */
8583   if (free_used_adj) {
8584     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8585   }
8586   PetscFunctionReturn(0);
8587 }
8588 
8589 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8590 {
8591   PC_IS               *pcis=(PC_IS*)pc->data;
8592   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8593   PCBDDCGraph         graph;
8594   PetscErrorCode      ierr;
8595 
8596   PetscFunctionBegin;
8597   /* attach interface graph for determining subsets */
8598   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8599     IS       verticesIS,verticescomm;
8600     PetscInt vsize,*idxs;
8601 
8602     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8603     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8604     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8605     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8606     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8607     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8608     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8609     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8610     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8611     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8612     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8613   } else {
8614     graph = pcbddc->mat_graph;
8615   }
8616   /* print some info */
8617   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8618     IS       vertices;
8619     PetscInt nv,nedges,nfaces;
8620     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8621     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8622     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8623     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8624     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8625     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8626     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8627     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8628     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8629     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8630     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8631   }
8632 
8633   /* sub_schurs init */
8634   if (!pcbddc->sub_schurs) {
8635     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8636   }
8637   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8638 
8639   /* free graph struct */
8640   if (pcbddc->sub_schurs_rebuild) {
8641     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8642   }
8643   PetscFunctionReturn(0);
8644 }
8645 
8646 PetscErrorCode PCBDDCCheckOperator(PC pc)
8647 {
8648   PC_IS               *pcis=(PC_IS*)pc->data;
8649   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8650   PetscErrorCode      ierr;
8651 
8652   PetscFunctionBegin;
8653   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8654     IS             zerodiag = NULL;
8655     Mat            S_j,B0_B=NULL;
8656     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8657     PetscScalar    *p0_check,*array,*array2;
8658     PetscReal      norm;
8659     PetscInt       i;
8660 
8661     /* B0 and B0_B */
8662     if (zerodiag) {
8663       IS       dummy;
8664 
8665       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8666       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8667       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8668       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8669     }
8670     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8671     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8672     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8673     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8674     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8675     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8676     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8677     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8678     /* S_j */
8679     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8680     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8681 
8682     /* mimic vector in \widetilde{W}_\Gamma */
8683     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8684     /* continuous in primal space */
8685     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8686     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8687     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8688     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8689     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8690     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8691     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8692     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8693     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8694     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8695     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8696     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8697     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8698     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8699 
8700     /* assemble rhs for coarse problem */
8701     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8702     /* local with Schur */
8703     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8704     if (zerodiag) {
8705       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8706       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8707       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8708       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8709     }
8710     /* sum on primal nodes the local contributions */
8711     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8712     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8713     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8714     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8715     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8716     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8717     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8718     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8719     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8720     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8721     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8722     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8723     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8724     /* scale primal nodes (BDDC sums contibutions) */
8725     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8726     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8727     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8728     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8729     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8730     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8731     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8732     /* global: \widetilde{B0}_B w_\Gamma */
8733     if (zerodiag) {
8734       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8735       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8736       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8737       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8738     }
8739     /* BDDC */
8740     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8741     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8742 
8743     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8744     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8745     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8746     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8747     for (i=0;i<pcbddc->benign_n;i++) {
8748       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8749     }
8750     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8751     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8752     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8753     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8754     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8755     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8756   }
8757   PetscFunctionReturn(0);
8758 }
8759 
8760 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8761 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8762 {
8763   Mat            At;
8764   IS             rows;
8765   PetscInt       rst,ren;
8766   PetscErrorCode ierr;
8767   PetscLayout    rmap;
8768 
8769   PetscFunctionBegin;
8770   rst = ren = 0;
8771   if (ccomm != MPI_COMM_NULL) {
8772     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8773     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8774     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8775     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8776     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8777   }
8778   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8779   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8780   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8781 
8782   if (ccomm != MPI_COMM_NULL) {
8783     Mat_MPIAIJ *a,*b;
8784     IS         from,to;
8785     Vec        gvec;
8786     PetscInt   lsize;
8787 
8788     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8789     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8790     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8791     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8792     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8793     a    = (Mat_MPIAIJ*)At->data;
8794     b    = (Mat_MPIAIJ*)(*B)->data;
8795     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8796     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8797     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8798     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8799     b->A = a->A;
8800     b->B = a->B;
8801 
8802     b->donotstash      = a->donotstash;
8803     b->roworiented     = a->roworiented;
8804     b->rowindices      = 0;
8805     b->rowvalues       = 0;
8806     b->getrowactive    = PETSC_FALSE;
8807 
8808     (*B)->rmap         = rmap;
8809     (*B)->factortype   = A->factortype;
8810     (*B)->assembled    = PETSC_TRUE;
8811     (*B)->insertmode   = NOT_SET_VALUES;
8812     (*B)->preallocated = PETSC_TRUE;
8813 
8814     if (a->colmap) {
8815 #if defined(PETSC_USE_CTABLE)
8816       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8817 #else
8818       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8819       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8820       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8821 #endif
8822     } else b->colmap = 0;
8823     if (a->garray) {
8824       PetscInt len;
8825       len  = a->B->cmap->n;
8826       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8827       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8828       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8829     } else b->garray = 0;
8830 
8831     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8832     b->lvec = a->lvec;
8833     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8834 
8835     /* cannot use VecScatterCopy */
8836     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8837     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8838     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8839     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8840     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8841     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8842     ierr = ISDestroy(&from);CHKERRQ(ierr);
8843     ierr = ISDestroy(&to);CHKERRQ(ierr);
8844     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8845   }
8846   ierr = MatDestroy(&At);CHKERRQ(ierr);
8847   PetscFunctionReturn(0);
8848 }
8849