xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision d57bb9db46f99bff4aaa690e4e9a7e55805ae415)
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   PetscScalar    *uwork,*data,*U, ds = 0.;
18   PetscReal      *sing;
19   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
20   PetscInt       ulw,i,nr,nc,n;
21   PetscErrorCode ierr;
22 #if defined(PETSC_USE_COMPLEX)
23   PetscReal      *rwork2;
24 #endif
25 
26   PetscFunctionBegin;
27   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
28   if (!nr || !nc) PetscFunctionReturn(0);
29 
30   /* workspace */
31   if (!work) {
32     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
33     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
34   } else {
35     ulw   = lw;
36     uwork = work;
37   }
38   n = PetscMin(nr,nc);
39   if (!rwork) {
40     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
41   } else {
42     sing = rwork;
43   }
44 
45   /* SVD */
46   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
50   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
51   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
52 #if !defined(PETSC_USE_COMPLEX)
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54 #else
55   ierr = PetscMalloc1(5*n,&rwork2);CHKERRQ(ierr);
56   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,rwork2,&lierr));
57   ierr = PetscFree(rwork2);CHKERRQ(ierr);
58 #endif
59   ierr = PetscFPTrapPop();CHKERRQ(ierr);
60   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
61   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
62   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
63   if (!rwork) {
64     ierr = PetscFree(sing);CHKERRQ(ierr);
65   }
66   if (!work) {
67     ierr = PetscFree(uwork);CHKERRQ(ierr);
68   }
69   /* create B */
70   if (!range) {
71     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
72     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
73     ierr = PetscArraycpy(data,U+nr*i,(nr-i)*nr);CHKERRQ(ierr);
74   } else {
75     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
76     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
77     ierr = PetscArraycpy(data,U,i*nr);CHKERRQ(ierr);
78   }
79   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
80   ierr = PetscFree(U);CHKERRQ(ierr);
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     const PetscScalar *vals;
122     PetscScalar       v;
123 
124     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
125     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
126     ierr = MatDenseGetArrayRead(GEd,&vals);CHKERRQ(ierr);
127     /* v    = PetscAbsScalar(vals[0]) */;
128     v    = 1.;
129     cvals[0] = vals[0]/v;
130     cvals[1] = vals[1]/v;
131     ierr = MatDenseRestoreArrayRead(GEd,&vals);CHKERRQ(ierr);
132     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
133 #if defined(PRINT_GDET)
134     {
135       PetscViewer viewer;
136       char filename[256];
137       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
138       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
139       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
140       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
141       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
142       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
143       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
144       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
145       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
146       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
147     }
148 #endif
149     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
150     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
151   }
152 
153   PetscFunctionReturn(0);
154 }
155 
156 PetscErrorCode PCBDDCNedelecSupport(PC pc)
157 {
158   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
159   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
160   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
161   Vec                    tvec;
162   PetscSF                sfv;
163   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
164   MPI_Comm               comm;
165   IS                     lned,primals,allprimals,nedfieldlocal;
166   IS                     *eedges,*extrows,*extcols,*alleedges;
167   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
168   PetscScalar            *vals,*work;
169   PetscReal              *rwork;
170   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
171   PetscInt               ne,nv,Lv,order,n,field;
172   PetscInt               n_neigh,*neigh,*n_shared,**shared;
173   PetscInt               i,j,extmem,cum,maxsize,nee;
174   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
175   PetscInt               *sfvleaves,*sfvroots;
176   PetscInt               *corners,*cedges;
177   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
178   PetscInt               *emarks;
179   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
180   PetscErrorCode         ierr;
181 
182   PetscFunctionBegin;
183   /* If the discrete gradient is defined for a subset of dofs and global is true,
184      it assumes G is given in global ordering for all the dofs.
185      Otherwise, the ordering is global for the Nedelec field */
186   order      = pcbddc->nedorder;
187   conforming = pcbddc->conforming;
188   field      = pcbddc->nedfield;
189   global     = pcbddc->nedglobal;
190   setprimal  = PETSC_FALSE;
191   print      = PETSC_FALSE;
192   singular   = PETSC_FALSE;
193 
194   /* Command line customization */
195   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
196   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
199   /* print debug info TODO: to be removed */
200   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
201   ierr = PetscOptionsEnd();CHKERRQ(ierr);
202 
203   /* Return if there are no edges in the decomposition and the problem is not singular */
204   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
205   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
206   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
207   if (!singular) {
208     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
209     lrc[0] = PETSC_FALSE;
210     for (i=0;i<n;i++) {
211       if (PetscRealPart(vals[i]) > 2.) {
212         lrc[0] = PETSC_TRUE;
213         break;
214       }
215     }
216     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
217     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRMPI(ierr);
218     if (!lrc[1]) PetscFunctionReturn(0);
219   }
220 
221   /* Get Nedelec field */
222   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);
223   if (pcbddc->n_ISForDofsLocal && field >= 0) {
224     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
225     nedfieldlocal = pcbddc->ISForDofsLocal[field];
226     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
227   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
228     ne            = n;
229     nedfieldlocal = NULL;
230     global        = PETSC_TRUE;
231   } else if (field == PETSC_DECIDE) {
232     PetscInt rst,ren,*idx;
233 
234     ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
235     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
236     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
237     for (i=rst;i<ren;i++) {
238       PetscInt nc;
239 
240       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
241       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
242       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243     }
244     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE);CHKERRQ(ierr);
245     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE);CHKERRQ(ierr);
246     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
247     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
248     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
249   } else {
250     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
251   }
252 
253   /* Sanity checks */
254   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
255   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
256   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);
257 
258   /* Just set primal dofs and return */
259   if (setprimal) {
260     IS       enedfieldlocal;
261     PetscInt *eidxs;
262 
263     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
264     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
265     if (nedfieldlocal) {
266       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
267       for (i=0,cum=0;i<ne;i++) {
268         if (PetscRealPart(vals[idxs[i]]) > 2.) {
269           eidxs[cum++] = idxs[i];
270         }
271       }
272       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
273     } else {
274       for (i=0,cum=0;i<ne;i++) {
275         if (PetscRealPart(vals[i]) > 2.) {
276           eidxs[cum++] = i;
277         }
278       }
279     }
280     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
281     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
282     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
283     ierr = PetscFree(eidxs);CHKERRQ(ierr);
284     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
285     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
286     PetscFunctionReturn(0);
287   }
288 
289   /* Compute some l2g maps */
290   if (nedfieldlocal) {
291     IS is;
292 
293     /* need to map from the local Nedelec field to local numbering */
294     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
295     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
296     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
297     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
298     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
299     if (global) {
300       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
301       el2g = al2g;
302     } else {
303       IS gis;
304 
305       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
306       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
307       ierr = ISDestroy(&gis);CHKERRQ(ierr);
308     }
309     ierr = ISDestroy(&is);CHKERRQ(ierr);
310   } else {
311     /* restore default */
312     pcbddc->nedfield = -1;
313     /* one ref for the destruction of al2g, one for el2g */
314     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
315     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
316     el2g = al2g;
317     fl2g = NULL;
318   }
319 
320   /* Start communication to drop connections for interior edges (for cc analysis only) */
321   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
322   ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
323   if (nedfieldlocal) {
324     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
325     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
326     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327   } else {
328     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
329   }
330   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
331   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
332 
333   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
334     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
335     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
336     if (global) {
337       PetscInt rst;
338 
339       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
340       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
341         if (matis->sf_rootdata[i] < 2) {
342           matis->sf_rootdata[cum++] = i + rst;
343         }
344       }
345       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
346       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
347     } else {
348       PetscInt *tbz;
349 
350       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
351       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE);CHKERRQ(ierr);
352       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE);CHKERRQ(ierr);
353       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
354       for (i=0,cum=0;i<ne;i++)
355         if (matis->sf_leafdata[idxs[i]] == 1)
356           tbz[cum++] = i;
357       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
359       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
360       ierr = PetscFree(tbz);CHKERRQ(ierr);
361     }
362   } else { /* we need the entire G to infer the nullspace */
363     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
364     G    = pcbddc->discretegradient;
365   }
366 
367   /* Extract subdomain relevant rows of G */
368   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
369   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
370   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
371   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
372   ierr = ISDestroy(&lned);CHKERRQ(ierr);
373   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
374   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
375   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
376 
377   /* SF for nodal dofs communications */
378   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
379   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
380   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
381   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
382   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
384   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
386   i    = singular ? 2 : 1;
387   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
388 
389   /* Destroy temporary G created in MATIS format and modified G */
390   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
391   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
392   ierr = MatDestroy(&G);CHKERRQ(ierr);
393 
394   if (print) {
395     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
396     ierr = MatView(lG,NULL);CHKERRQ(ierr);
397   }
398 
399   /* Save lG for values insertion in change of basis */
400   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
401 
402   /* Analyze the edge-nodes connections (duplicate lG) */
403   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
404   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
405   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
406   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
407   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
410   /* need to import the boundary specification to ensure the
411      proper detection of coarse edges' endpoints */
412   if (pcbddc->DirichletBoundariesLocal) {
413     IS is;
414 
415     if (fl2g) {
416       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
417     } else {
418       is = pcbddc->DirichletBoundariesLocal;
419     }
420     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
421     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
422     for (i=0;i<cum;i++) {
423       if (idxs[i] >= 0) {
424         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
425         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
426       }
427     }
428     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
429     if (fl2g) {
430       ierr = ISDestroy(&is);CHKERRQ(ierr);
431     }
432   }
433   if (pcbddc->NeumannBoundariesLocal) {
434     IS is;
435 
436     if (fl2g) {
437       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
438     } else {
439       is = pcbddc->NeumannBoundariesLocal;
440     }
441     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
442     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
443     for (i=0;i<cum;i++) {
444       if (idxs[i] >= 0) {
445         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
446       }
447     }
448     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
449     if (fl2g) {
450       ierr = ISDestroy(&is);CHKERRQ(ierr);
451     }
452   }
453 
454   /* Count neighs per dof */
455   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
456   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
457 
458   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
459      for proper detection of coarse edges' endpoints */
460   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
461   for (i=0;i<ne;i++) {
462     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
463       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
464     }
465   }
466   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
467   if (!conforming) {
468     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
469     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
470   }
471   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
472   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
473   cum  = 0;
474   for (i=0;i<ne;i++) {
475     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
476     if (!PetscBTLookup(btee,i)) {
477       marks[cum++] = i;
478       continue;
479     }
480     /* set badly connected edge dofs as primal */
481     if (!conforming) {
482       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
483         marks[cum++] = i;
484         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
485         for (j=ii[i];j<ii[i+1];j++) {
486           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
487         }
488       } else {
489         /* every edge dofs should be connected trough a certain number of nodal dofs
490            to other edge dofs belonging to coarse edges
491            - at most 2 endpoints
492            - order-1 interior nodal dofs
493            - no undefined nodal dofs (nconn < order)
494         */
495         PetscInt ends = 0,ints = 0, undef = 0;
496         for (j=ii[i];j<ii[i+1];j++) {
497           PetscInt v = jj[j],k;
498           PetscInt nconn = iit[v+1]-iit[v];
499           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
500           if (nconn > order) ends++;
501           else if (nconn == order) ints++;
502           else undef++;
503         }
504         if (undef || ends > 2 || ints != order -1) {
505           marks[cum++] = i;
506           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
507           for (j=ii[i];j<ii[i+1];j++) {
508             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
509           }
510         }
511       }
512     }
513     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
514     if (!order && ii[i+1] != ii[i]) {
515       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
516       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
517     }
518   }
519   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
520   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
521   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
522   if (!conforming) {
523     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
524     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
525   }
526   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
527 
528   /* identify splitpoints and corner candidates */
529   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
530   if (print) {
531     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
532     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
533     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
534     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
535   }
536   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
537   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
538   for (i=0;i<nv;i++) {
539     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
540     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
541     if (!order) { /* variable order */
542       PetscReal vorder = 0.;
543 
544       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
545       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
546       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%D)",vorder,test);
547       ord  = 1;
548     }
549     if (PetscUnlikelyDebug(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);
550     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
551       if (PetscBTLookup(btbd,jj[j])) {
552         bdir = PETSC_TRUE;
553         break;
554       }
555       if (vc != ecount[jj[j]]) {
556         sneighs = PETSC_FALSE;
557       } else {
558         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
559         for (k=0;k<vc;k++) {
560           if (vn[k] != en[k]) {
561             sneighs = PETSC_FALSE;
562             break;
563           }
564         }
565       }
566     }
567     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
568       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %D (%D %D %D)\n",i,!sneighs,test >= 3*ord,bdir);
569       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
570     } else if (test == ord) {
571       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
572         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %D\n",i);
573         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574       } else {
575         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %D\n",i);
576         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
577       }
578     }
579   }
580   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
581   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
582   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
583 
584   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
585   if (order != 1) {
586     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
587     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
588     for (i=0;i<nv;i++) {
589       if (PetscBTLookup(btvcand,i)) {
590         PetscBool found = PETSC_FALSE;
591         for (j=ii[i];j<ii[i+1] && !found;j++) {
592           PetscInt k,e = jj[j];
593           if (PetscBTLookup(bte,e)) continue;
594           for (k=iit[e];k<iit[e+1];k++) {
595             PetscInt v = jjt[k];
596             if (v != i && PetscBTLookup(btvcand,v)) {
597               found = PETSC_TRUE;
598               break;
599             }
600           }
601         }
602         if (!found) {
603           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D CLEARED\n",i);
604           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
605         } else {
606           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %D ACCEPTED\n",i);
607         }
608       }
609     }
610     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
611   }
612   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
613   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
614   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
615 
616   /* Get the local G^T explicitly */
617   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
618   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
619   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
620 
621   /* Mark interior nodal dofs */
622   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
623   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
624   for (i=1;i<n_neigh;i++) {
625     for (j=0;j<n_shared[i];j++) {
626       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
627     }
628   }
629   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
630 
631   /* communicate corners and splitpoints */
632   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
633   ierr = PetscArrayzero(sfvleaves,nv);CHKERRQ(ierr);
634   ierr = PetscArrayzero(sfvroots,Lv);CHKERRQ(ierr);
635   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
636 
637   if (print) {
638     IS tbz;
639 
640     cum = 0;
641     for (i=0;i<nv;i++)
642       if (sfvleaves[i])
643         vmarks[cum++] = i;
644 
645     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
646     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
647     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
648     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
649   }
650 
651   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
652   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
653   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves,MPI_REPLACE);CHKERRQ(ierr);
654   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves,MPI_REPLACE);CHKERRQ(ierr);
655 
656   /* Zero rows of lGt corresponding to identified corners
657      and interior nodal dofs */
658   cum = 0;
659   for (i=0;i<nv;i++) {
660     if (sfvleaves[i]) {
661       vmarks[cum++] = i;
662       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
663     }
664     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
665   }
666   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
667   if (print) {
668     IS tbz;
669 
670     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
671     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
672     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
673     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
674   }
675   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
676   ierr = PetscFree(vmarks);CHKERRQ(ierr);
677   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
678   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
679 
680   /* Recompute G */
681   ierr = MatDestroy(&lG);CHKERRQ(ierr);
682   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
683   if (print) {
684     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
685     ierr = MatView(lG,NULL);CHKERRQ(ierr);
686     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
687     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
688   }
689 
690   /* Get primal dofs (if any) */
691   cum = 0;
692   for (i=0;i<ne;i++) {
693     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
694   }
695   if (fl2g) {
696     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
697   }
698   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
699   if (print) {
700     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
701     ierr = ISView(primals,NULL);CHKERRQ(ierr);
702   }
703   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
704   /* TODO: what if the user passed in some of them ?  */
705   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
706   ierr = ISDestroy(&primals);CHKERRQ(ierr);
707 
708   /* Compute edge connectivity */
709   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
710 
711   /* Symbolic conn = lG*lGt */
712   ierr = MatProductCreate(lG,lGt,NULL,&conn);CHKERRQ(ierr);
713   ierr = MatProductSetType(conn,MATPRODUCT_AB);CHKERRQ(ierr);
714   ierr = MatProductSetAlgorithm(conn,"default");CHKERRQ(ierr);
715   ierr = MatProductSetFill(conn,PETSC_DEFAULT);CHKERRQ(ierr);
716   ierr = PetscObjectSetOptionsPrefix((PetscObject)conn,"econn_");CHKERRQ(ierr);
717   ierr = MatProductSetFromOptions(conn);CHKERRQ(ierr);
718   ierr = MatProductSymbolic(conn);CHKERRQ(ierr);
719 
720   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
721   if (fl2g) {
722     PetscBT   btf;
723     PetscInt  *iia,*jja,*iiu,*jju;
724     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
725 
726     /* create CSR for all local dofs */
727     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
728     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
729       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %D. Should be %D",pcbddc->mat_graph->nvtxs_csr,n);
730       iiu = pcbddc->mat_graph->xadj;
731       jju = pcbddc->mat_graph->adjncy;
732     } else if (pcbddc->use_local_adj) {
733       rest = PETSC_TRUE;
734       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
735     } else {
736       free   = PETSC_TRUE;
737       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
738       iiu[0] = 0;
739       for (i=0;i<n;i++) {
740         iiu[i+1] = i+1;
741         jju[i]   = -1;
742       }
743     }
744 
745     /* import sizes of CSR */
746     iia[0] = 0;
747     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
748 
749     /* overwrite entries corresponding to the Nedelec field */
750     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
751     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
752     for (i=0;i<ne;i++) {
753       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
754       iia[idxs[i]+1] = ii[i+1]-ii[i];
755     }
756 
757     /* iia in CSR */
758     for (i=0;i<n;i++) iia[i+1] += iia[i];
759 
760     /* jja in CSR */
761     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
762     for (i=0;i<n;i++)
763       if (!PetscBTLookup(btf,i))
764         for (j=0;j<iiu[i+1]-iiu[i];j++)
765           jja[iia[i]+j] = jju[iiu[i]+j];
766 
767     /* map edge dofs connectivity */
768     if (jj) {
769       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
770       for (i=0;i<ne;i++) {
771         PetscInt e = idxs[i];
772         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
773       }
774     }
775     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
776     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
777     if (rest) {
778       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
779     }
780     if (free) {
781       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
782     }
783     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
784   } else {
785     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
786   }
787 
788   /* Analyze interface for edge dofs */
789   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
790   pcbddc->mat_graph->twodim = PETSC_FALSE;
791 
792   /* Get coarse edges in the edge space */
793   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
794   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
795 
796   if (fl2g) {
797     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
798     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
799     for (i=0;i<nee;i++) {
800       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
801     }
802   } else {
803     eedges  = alleedges;
804     primals = allprimals;
805   }
806 
807   /* Mark fine edge dofs with their coarse edge id */
808   ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
809   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
810   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
811   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
812   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
813   if (print) {
814     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
815     ierr = ISView(primals,NULL);CHKERRQ(ierr);
816   }
817 
818   maxsize = 0;
819   for (i=0;i<nee;i++) {
820     PetscInt size,mark = i+1;
821 
822     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
823     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
824     for (j=0;j<size;j++) marks[idxs[j]] = mark;
825     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
826     maxsize = PetscMax(maxsize,size);
827   }
828 
829   /* Find coarse edge endpoints */
830   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
831   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
832   for (i=0;i<nee;i++) {
833     PetscInt mark = i+1,size;
834 
835     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
836     if (!size && nedfieldlocal) continue;
837     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
838     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
839     if (print) {
840       ierr = PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %D\n",i);CHKERRQ(ierr);
841       ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
842     }
843     for (j=0;j<size;j++) {
844       PetscInt k, ee = idxs[j];
845       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %D\n",ee);
846       for (k=ii[ee];k<ii[ee+1];k++) {
847         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %D\n",jj[k]);
848         if (PetscBTLookup(btv,jj[k])) {
849           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %D\n",jj[k]);
850         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
851           PetscInt  k2;
852           PetscBool corner = PETSC_FALSE;
853           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
854             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]));
855             /* it's a corner if either is connected with an edge dof belonging to a different cc or
856                if the edge dof lie on the natural part of the boundary */
857             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
858               corner = PETSC_TRUE;
859               break;
860             }
861           }
862           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
863             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %D\n",jj[k]);
864             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
865           } else {
866             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
867           }
868         }
869       }
870     }
871     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
872   }
873   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
874   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
875   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
876 
877   /* Reset marked primal dofs */
878   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
879   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
880   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
881   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
882 
883   /* Now use the initial lG */
884   ierr = MatDestroy(&lG);CHKERRQ(ierr);
885   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
886   lG   = lGinit;
887   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
888 
889   /* Compute extended cols indices */
890   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
891   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
892   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
893   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
894   i   *= maxsize;
895   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
896   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
897   eerr = PETSC_FALSE;
898   for (i=0;i<nee;i++) {
899     PetscInt size,found = 0;
900 
901     cum  = 0;
902     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
903     if (!size && nedfieldlocal) continue;
904     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
905     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
906     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
907     for (j=0;j<size;j++) {
908       PetscInt k,ee = idxs[j];
909       for (k=ii[ee];k<ii[ee+1];k++) {
910         PetscInt vv = jj[k];
911         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
912         else if (!PetscBTLookupSet(btvc,vv)) found++;
913       }
914     }
915     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
916     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
917     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
918     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
919     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
920     /* it may happen that endpoints are not defined at this point
921        if it is the case, mark this edge for a second pass */
922     if (cum != size -1 || found != 2) {
923       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
924       if (print) {
925         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
926         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
927         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
928         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
929       }
930       eerr = PETSC_TRUE;
931     }
932   }
933   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
934   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRMPI(ierr);
935   if (done) {
936     PetscInt *newprimals;
937 
938     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
939     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
940     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
941     ierr = PetscArraycpy(newprimals,idxs,cum);CHKERRQ(ierr);
942     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
943     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
944     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %D)\n",eerr);
945     for (i=0;i<nee;i++) {
946       PetscBool has_candidates = PETSC_FALSE;
947       if (PetscBTLookup(bter,i)) {
948         PetscInt size,mark = i+1;
949 
950         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
951         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
952         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
953         for (j=0;j<size;j++) {
954           PetscInt k,ee = idxs[j];
955           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %D [%D %D)\n",ee,ii[ee],ii[ee+1]);
956           for (k=ii[ee];k<ii[ee+1];k++) {
957             /* set all candidates located on the edge as corners */
958             if (PetscBTLookup(btvcand,jj[k])) {
959               PetscInt k2,vv = jj[k];
960               has_candidates = PETSC_TRUE;
961               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %D\n",vv);
962               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
963               /* set all edge dofs connected to candidate as primals */
964               for (k2=iit[vv];k2<iit[vv+1];k2++) {
965                 if (marks[jjt[k2]] == mark) {
966                   PetscInt k3,ee2 = jjt[k2];
967                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %D\n",ee2);
968                   newprimals[cum++] = ee2;
969                   /* finally set the new corners */
970                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
971                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %D\n",jj[k3]);
972                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
973                   }
974                 }
975               }
976             } else {
977               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %D\n",jj[k]);
978             }
979           }
980         }
981         if (!has_candidates) { /* circular edge */
982           PetscInt k, ee = idxs[0],*tmarks;
983 
984           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
985           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %D\n",i);
986           for (k=ii[ee];k<ii[ee+1];k++) {
987             PetscInt k2;
988             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %D\n",jj[k]);
989             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
990             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
991           }
992           for (j=0;j<size;j++) {
993             if (tmarks[idxs[j]] > 1) {
994               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %D\n",idxs[j]);
995               newprimals[cum++] = idxs[j];
996             }
997           }
998           ierr = PetscFree(tmarks);CHKERRQ(ierr);
999         }
1000         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1001       }
1002       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1003     }
1004     ierr = PetscFree(extcols);CHKERRQ(ierr);
1005     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1006     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1007     if (fl2g) {
1008       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1009       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1010       for (i=0;i<nee;i++) {
1011         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1012       }
1013       ierr = PetscFree(eedges);CHKERRQ(ierr);
1014     }
1015     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1016     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1017     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1018     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1019     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1020     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1021     pcbddc->mat_graph->twodim = PETSC_FALSE;
1022     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1023     if (fl2g) {
1024       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1025       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1026       for (i=0;i<nee;i++) {
1027         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1028       }
1029     } else {
1030       eedges  = alleedges;
1031       primals = allprimals;
1032     }
1033     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1034 
1035     /* Mark again */
1036     ierr = PetscArrayzero(marks,ne);CHKERRQ(ierr);
1037     for (i=0;i<nee;i++) {
1038       PetscInt size,mark = i+1;
1039 
1040       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1041       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1042       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1043       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1044     }
1045     if (print) {
1046       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1047       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1048     }
1049 
1050     /* Recompute extended cols */
1051     eerr = PETSC_FALSE;
1052     for (i=0;i<nee;i++) {
1053       PetscInt size;
1054 
1055       cum  = 0;
1056       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1057       if (!size && nedfieldlocal) continue;
1058       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1059       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       for (j=0;j<size;j++) {
1061         PetscInt k,ee = idxs[j];
1062         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1063       }
1064       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1065       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1066       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1067       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1068       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1069       if (cum != size -1) {
1070         if (print) {
1071           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1072           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1073           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1074           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1075         }
1076         eerr = PETSC_TRUE;
1077       }
1078     }
1079   }
1080   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1081   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1082   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1083   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1084   /* an error should not occur at this point */
1085   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1086 
1087   /* Check the number of endpoints */
1088   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1089   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1090   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1091   for (i=0;i<nee;i++) {
1092     PetscInt size, found = 0, gc[2];
1093 
1094     /* init with defaults */
1095     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1096     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1097     if (!size && nedfieldlocal) continue;
1098     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %D",i);
1099     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1100     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1101     for (j=0;j<size;j++) {
1102       PetscInt k,ee = idxs[j];
1103       for (k=ii[ee];k<ii[ee+1];k++) {
1104         PetscInt vv = jj[k];
1105         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1106           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %D",i);
1107           corners[i*2+found++] = vv;
1108         }
1109       }
1110     }
1111     if (found != 2) {
1112       PetscInt e;
1113       if (fl2g) {
1114         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1115       } else {
1116         e = idxs[0];
1117       }
1118       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %D corners for edge %D (astart %D, estart %D)",found,i,e,idxs[0]);
1119     }
1120 
1121     /* get primal dof index on this coarse edge */
1122     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1123     if (gc[0] > gc[1]) {
1124       PetscInt swap  = corners[2*i];
1125       corners[2*i]   = corners[2*i+1];
1126       corners[2*i+1] = swap;
1127     }
1128     cedges[i] = idxs[size-1];
1129     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1130     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %D: ce %D, corners (%D,%D)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1131   }
1132   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1133   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1134 
1135   if (PetscDefined(USE_DEBUG)) {
1136     /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1137      not interfere with neighbouring coarse edges */
1138     ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1139     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1140     for (i=0;i<nv;i++) {
1141       PetscInt emax = 0,eemax = 0;
1142 
1143       if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1144       ierr = PetscArrayzero(emarks,nee+1);CHKERRQ(ierr);
1145       for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1146       for (j=1;j<nee+1;j++) {
1147         if (emax < emarks[j]) {
1148           emax = emarks[j];
1149           eemax = j;
1150         }
1151       }
1152       /* not relevant for edges */
1153       if (!eemax) continue;
1154 
1155       for (j=ii[i];j<ii[i+1];j++) {
1156         if (marks[jj[j]] && marks[jj[j]] != eemax) {
1157           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",marks[jj[j]]-1,eemax,i,jj[j]);
1158         }
1159       }
1160     }
1161     ierr = PetscFree(emarks);CHKERRQ(ierr);
1162     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1163   }
1164 
1165   /* Compute extended rows indices for edge blocks of the change of basis */
1166   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1167   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1168   extmem *= maxsize;
1169   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1170   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1171   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1172   for (i=0;i<nv;i++) {
1173     PetscInt mark = 0,size,start;
1174 
1175     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1176     for (j=ii[i];j<ii[i+1];j++)
1177       if (marks[jj[j]] && !mark)
1178         mark = marks[jj[j]];
1179 
1180     /* not relevant */
1181     if (!mark) continue;
1182 
1183     /* import extended row */
1184     mark--;
1185     start = mark*extmem+extrowcum[mark];
1186     size = ii[i+1]-ii[i];
1187     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %D > %D",extrowcum[mark] + size,extmem);
1188     ierr = PetscArraycpy(extrow+start,jj+ii[i],size);CHKERRQ(ierr);
1189     extrowcum[mark] += size;
1190   }
1191   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1192   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1193   ierr = PetscFree(marks);CHKERRQ(ierr);
1194 
1195   /* Compress extrows */
1196   cum  = 0;
1197   for (i=0;i<nee;i++) {
1198     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1199     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1200     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1201     cum  = PetscMax(cum,size);
1202   }
1203   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1204   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1205   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1206 
1207   /* Workspace for lapack inner calls and VecSetValues */
1208   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1209 
1210   /* Create change of basis matrix (preallocation can be improved) */
1211   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1212   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1213                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1214   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1215   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1216   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1217   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1218   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1219   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1220   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1221 
1222   /* Defaults to identity */
1223   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1224   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1225   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1226   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1227 
1228   /* Create discrete gradient for the coarser level if needed */
1229   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1230   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1231   if (pcbddc->current_level < pcbddc->max_levels) {
1232     ISLocalToGlobalMapping cel2g,cvl2g;
1233     IS                     wis,gwis;
1234     PetscInt               cnv,cne;
1235 
1236     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1237     if (fl2g) {
1238       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1239     } else {
1240       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1241       pcbddc->nedclocal = wis;
1242     }
1243     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1244     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1245     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1249 
1250     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1251     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1252     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1253     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1254     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1255     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1256     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1257 
1258     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1259     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1260     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1261     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1262     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1263     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1264     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1265     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1266   }
1267   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1268 
1269 #if defined(PRINT_GDET)
1270   inc = 0;
1271   lev = pcbddc->current_level;
1272 #endif
1273 
1274   /* Insert values in the change of basis matrix */
1275   for (i=0;i<nee;i++) {
1276     Mat         Gins = NULL, GKins = NULL;
1277     IS          cornersis = NULL;
1278     PetscScalar cvals[2];
1279 
1280     if (pcbddc->nedcG) {
1281       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1282     }
1283     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1284     if (Gins && GKins) {
1285       const PetscScalar *data;
1286       const PetscInt    *rows,*cols;
1287       PetscInt          nrh,nch,nrc,ncc;
1288 
1289       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1290       /* H1 */
1291       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1293       ierr = MatDenseGetArrayRead(Gins,&data);CHKERRQ(ierr);
1294       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1295       ierr = MatDenseRestoreArrayRead(Gins,&data);CHKERRQ(ierr);
1296       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1297       /* complement */
1298       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1299       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %D",i);
1300       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);
1301       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);
1302       ierr = MatDenseGetArrayRead(GKins,&data);CHKERRQ(ierr);
1303       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1304       ierr = MatDenseRestoreArrayRead(GKins,&data);CHKERRQ(ierr);
1305 
1306       /* coarse discrete gradient */
1307       if (pcbddc->nedcG) {
1308         PetscInt cols[2];
1309 
1310         cols[0] = 2*i;
1311         cols[1] = 2*i+1;
1312         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1313       }
1314       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1315     }
1316     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1317     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1318     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1319     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1320     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1321   }
1322   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1323 
1324   /* Start assembling */
1325   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1326   if (pcbddc->nedcG) {
1327     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1328   }
1329 
1330   /* Free */
1331   if (fl2g) {
1332     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1333     for (i=0;i<nee;i++) {
1334       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1335     }
1336     ierr = PetscFree(eedges);CHKERRQ(ierr);
1337   }
1338 
1339   /* hack mat_graph with primal dofs on the coarse edges */
1340   {
1341     PCBDDCGraph graph   = pcbddc->mat_graph;
1342     PetscInt    *oqueue = graph->queue;
1343     PetscInt    *ocptr  = graph->cptr;
1344     PetscInt    ncc,*idxs;
1345 
1346     /* find first primal edge */
1347     if (pcbddc->nedclocal) {
1348       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1349     } else {
1350       if (fl2g) {
1351         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1352       }
1353       idxs = cedges;
1354     }
1355     cum = 0;
1356     while (cum < nee && cedges[cum] < 0) cum++;
1357 
1358     /* adapt connected components */
1359     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1360     graph->cptr[0] = 0;
1361     for (i=0,ncc=0;i<graph->ncc;i++) {
1362       PetscInt lc = ocptr[i+1]-ocptr[i];
1363       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1364         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1365         graph->queue[graph->cptr[ncc]] = cedges[cum];
1366         ncc++;
1367         lc--;
1368         cum++;
1369         while (cum < nee && cedges[cum] < 0) cum++;
1370       }
1371       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1372       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1373       ncc++;
1374     }
1375     graph->ncc = ncc;
1376     if (pcbddc->nedclocal) {
1377       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1378     }
1379     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1380   }
1381   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1382   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1383   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1384   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1385 
1386   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1387   ierr = PetscFree(extrow);CHKERRQ(ierr);
1388   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1389   ierr = PetscFree(corners);CHKERRQ(ierr);
1390   ierr = PetscFree(cedges);CHKERRQ(ierr);
1391   ierr = PetscFree(extrows);CHKERRQ(ierr);
1392   ierr = PetscFree(extcols);CHKERRQ(ierr);
1393   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1394 
1395   /* Complete assembling */
1396   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1397   if (pcbddc->nedcG) {
1398     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1399 #if 0
1400     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1401     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1402 #endif
1403   }
1404 
1405   /* set change of basis */
1406   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1407   ierr = MatDestroy(&T);CHKERRQ(ierr);
1408 
1409   PetscFunctionReturn(0);
1410 }
1411 
1412 /* the near-null space of BDDC carries information on quadrature weights,
1413    and these can be collinear -> so cheat with MatNullSpaceCreate
1414    and create a suitable set of basis vectors first */
1415 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1416 {
1417   PetscErrorCode ierr;
1418   PetscInt       i;
1419 
1420   PetscFunctionBegin;
1421   for (i=0;i<nvecs;i++) {
1422     PetscInt first,last;
1423 
1424     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1425     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1426     if (i>=first && i < last) {
1427       PetscScalar *data;
1428       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1429       if (!has_const) {
1430         data[i-first] = 1.;
1431       } else {
1432         data[2*i-first] = 1./PetscSqrtReal(2.);
1433         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1434       }
1435       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1436     }
1437     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1438   }
1439   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1440   for (i=0;i<nvecs;i++) { /* reset vectors */
1441     PetscInt first,last;
1442     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1443     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1444     if (i>=first && i < last) {
1445       PetscScalar *data;
1446       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1447       if (!has_const) {
1448         data[i-first] = 0.;
1449       } else {
1450         data[2*i-first] = 0.;
1451         data[2*i-first+1] = 0.;
1452       }
1453       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1454     }
1455     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1456     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1457   }
1458   PetscFunctionReturn(0);
1459 }
1460 
1461 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1462 {
1463   Mat                    loc_divudotp;
1464   Vec                    p,v,vins,quad_vec,*quad_vecs;
1465   ISLocalToGlobalMapping map;
1466   PetscScalar            *vals;
1467   const PetscScalar      *array;
1468   PetscInt               i,maxneighs = 0,maxsize,*gidxs;
1469   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1470   PetscMPIInt            rank;
1471   PetscErrorCode         ierr;
1472 
1473   PetscFunctionBegin;
1474   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1475   for (i=0;i<n_neigh;i++) maxneighs = PetscMax(graph->count[shared[i][0]]+1,maxneighs);
1476   ierr = MPIU_Allreduce(MPI_IN_PLACE,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRMPI(ierr);
1477   if (!maxneighs) {
1478     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1479     *nnsp = NULL;
1480     PetscFunctionReturn(0);
1481   }
1482   maxsize = 0;
1483   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1484   ierr = PetscMalloc2(maxsize,&gidxs,maxsize,&vals);CHKERRQ(ierr);
1485   /* create vectors to hold quadrature weights */
1486   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1487   if (!transpose) {
1488     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1489   } else {
1490     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1491   }
1492   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1493   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1494   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1495   for (i=0;i<maxneighs;i++) {
1496     ierr = VecLockReadPop(quad_vecs[i]);CHKERRQ(ierr);
1497   }
1498 
1499   /* compute local quad vec */
1500   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1501   if (!transpose) {
1502     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1503   } else {
1504     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1505   }
1506   ierr = VecSet(p,1.);CHKERRQ(ierr);
1507   if (!transpose) {
1508     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1509   } else {
1510     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1511   }
1512   if (vl2l) {
1513     Mat        lA;
1514     VecScatter sc;
1515 
1516     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1517     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1518     ierr = VecScatterCreate(v,NULL,vins,vl2l,&sc);CHKERRQ(ierr);
1519     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1520     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1521     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1522   } else {
1523     vins = v;
1524   }
1525   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1526   ierr = VecDestroy(&p);CHKERRQ(ierr);
1527 
1528   /* insert in global quadrature vecs */
1529   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRMPI(ierr);
1530   for (i=1;i<n_neigh;i++) {
1531     const PetscInt    *idxs;
1532     PetscInt          idx,nn,j;
1533 
1534     idxs = shared[i];
1535     nn   = n_shared[i];
1536     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1537     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1538     idx  = -(idx+1);
1539     if (idx < 0 || idx >= maxneighs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Invalid index %D not in [0,%D)",idx,maxneighs);
1540     ierr = ISLocalToGlobalMappingApply(map,nn,idxs,gidxs);CHKERRQ(ierr);
1541     ierr = VecSetValues(quad_vecs[idx],nn,gidxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1542   }
1543   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1544   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1545   if (vl2l) {
1546     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1547   }
1548   ierr = VecDestroy(&v);CHKERRQ(ierr);
1549   ierr = PetscFree2(gidxs,vals);CHKERRQ(ierr);
1550 
1551   /* assemble near null space */
1552   for (i=0;i<maxneighs;i++) {
1553     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1554   }
1555   for (i=0;i<maxneighs;i++) {
1556     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1557     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1558     ierr = VecLockReadPush(quad_vecs[i]);CHKERRQ(ierr);
1559   }
1560   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1561   PetscFunctionReturn(0);
1562 }
1563 
1564 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1565 {
1566   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1567   PetscErrorCode ierr;
1568 
1569   PetscFunctionBegin;
1570   if (primalv) {
1571     if (pcbddc->user_primal_vertices_local) {
1572       IS list[2], newp;
1573 
1574       list[0] = primalv;
1575       list[1] = pcbddc->user_primal_vertices_local;
1576       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1577       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1578       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1579       pcbddc->user_primal_vertices_local = newp;
1580     } else {
1581       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1582     }
1583   }
1584   PetscFunctionReturn(0);
1585 }
1586 
1587 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1588 {
1589   PetscInt f, *comp  = (PetscInt *)ctx;
1590 
1591   PetscFunctionBegin;
1592   for (f=0;f<Nf;f++) out[f] = X[*comp];
1593   PetscFunctionReturn(0);
1594 }
1595 
1596 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1597 {
1598   PetscErrorCode ierr;
1599   Vec            local,global;
1600   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1601   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1602   PetscBool      monolithic = PETSC_FALSE;
1603 
1604   PetscFunctionBegin;
1605   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1606   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1607   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1608   /* need to convert from global to local topology information and remove references to information in global ordering */
1609   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1610   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1611   ierr = VecBindToCPU(global,PETSC_TRUE);CHKERRQ(ierr);
1612   ierr = VecBindToCPU(local,PETSC_TRUE);CHKERRQ(ierr);
1613   if (monolithic) { /* just get block size to properly compute vertices */
1614     if (pcbddc->vertex_size == 1) {
1615       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1616     }
1617     goto boundary;
1618   }
1619 
1620   if (pcbddc->user_provided_isfordofs) {
1621     if (pcbddc->n_ISForDofs) {
1622       PetscInt i;
1623 
1624       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1625       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1626         PetscInt bs;
1627 
1628         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1629         ierr = ISGetBlockSize(pcbddc->ISForDofs[i],&bs);CHKERRQ(ierr);
1630         ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1631         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1632       }
1633       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1634       pcbddc->n_ISForDofs = 0;
1635       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1636     }
1637   } else {
1638     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1639       DM dm;
1640 
1641       ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1642       if (!dm) {
1643         ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1644       }
1645       if (dm) {
1646         IS      *fields;
1647         PetscInt nf,i;
1648 
1649         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1650         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1651         for (i=0;i<nf;i++) {
1652           PetscInt bs;
1653 
1654           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1655           ierr = ISGetBlockSize(fields[i],&bs);CHKERRQ(ierr);
1656           ierr = ISSetBlockSize(pcbddc->ISForDofsLocal[i],bs);CHKERRQ(ierr);
1657           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1658         }
1659         ierr = PetscFree(fields);CHKERRQ(ierr);
1660         pcbddc->n_ISForDofsLocal = nf;
1661       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1662         PetscContainer   c;
1663 
1664         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1665         if (c) {
1666           MatISLocalFields lf;
1667           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1668           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1669         } else { /* fallback, create the default fields if bs > 1 */
1670           PetscInt i, n = matis->A->rmap->n;
1671           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1672           if (i > 1) {
1673             pcbddc->n_ISForDofsLocal = i;
1674             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1675             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1676               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1677             }
1678           }
1679         }
1680       }
1681     } else {
1682       PetscInt i;
1683       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1684         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1685       }
1686     }
1687   }
1688 
1689 boundary:
1690   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1691     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1692   } else if (pcbddc->DirichletBoundariesLocal) {
1693     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1694   }
1695   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1696     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1697   } else if (pcbddc->NeumannBoundariesLocal) {
1698     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1699   }
1700   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1701     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1702   }
1703   ierr = VecDestroy(&global);CHKERRQ(ierr);
1704   ierr = VecDestroy(&local);CHKERRQ(ierr);
1705   /* detect local disconnected subdomains if requested (use matis->A) */
1706   if (pcbddc->detect_disconnected) {
1707     IS        primalv = NULL;
1708     PetscInt  i;
1709     PetscBool filter = pcbddc->detect_disconnected_filter;
1710 
1711     for (i=0;i<pcbddc->n_local_subs;i++) {
1712       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1713     }
1714     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1715     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1716     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1717     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1718   }
1719   /* early stage corner detection */
1720   {
1721     DM dm;
1722 
1723     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1724     if (!dm) {
1725       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1726     }
1727     if (dm) {
1728       PetscBool isda;
1729 
1730       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1731       if (isda) {
1732         ISLocalToGlobalMapping l2l;
1733         IS                     corners;
1734         Mat                    lA;
1735         PetscBool              gl,lo;
1736 
1737         {
1738           Vec               cvec;
1739           const PetscScalar *coords;
1740           PetscInt          dof,n,cdim;
1741           PetscBool         memc = PETSC_TRUE;
1742 
1743           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1744           ierr = DMGetCoordinates(dm,&cvec);CHKERRQ(ierr);
1745           ierr = VecGetLocalSize(cvec,&n);CHKERRQ(ierr);
1746           ierr = VecGetBlockSize(cvec,&cdim);CHKERRQ(ierr);
1747           n   /= cdim;
1748           ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
1749           ierr = PetscMalloc1(dof*n*cdim,&pcbddc->mat_graph->coords);CHKERRQ(ierr);
1750           ierr = VecGetArrayRead(cvec,&coords);CHKERRQ(ierr);
1751 #if defined(PETSC_USE_COMPLEX)
1752           memc = PETSC_FALSE;
1753 #endif
1754           if (dof != 1) memc = PETSC_FALSE;
1755           if (memc) {
1756             ierr = PetscArraycpy(pcbddc->mat_graph->coords,coords,cdim*n*dof);CHKERRQ(ierr);
1757           } else { /* BDDC graph does not use any blocked information, we need to replicate the data */
1758             PetscReal *bcoords = pcbddc->mat_graph->coords;
1759             PetscInt  i, b, d;
1760 
1761             for (i=0;i<n;i++) {
1762               for (b=0;b<dof;b++) {
1763                 for (d=0;d<cdim;d++) {
1764                   bcoords[i*dof*cdim + b*cdim + d] = PetscRealPart(coords[i*cdim+d]);
1765                 }
1766               }
1767             }
1768           }
1769           ierr = VecRestoreArrayRead(cvec,&coords);CHKERRQ(ierr);
1770           pcbddc->mat_graph->cdim  = cdim;
1771           pcbddc->mat_graph->cnloc = dof*n;
1772           pcbddc->mat_graph->cloc  = PETSC_FALSE;
1773         }
1774         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1775         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1776         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1777         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1778         lo   = (PetscBool)(l2l && corners);
1779         ierr = MPIU_Allreduce(&lo,&gl,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
1780         if (gl) { /* From PETSc's DMDA */
1781           const PetscInt    *idx;
1782           PetscInt          dof,bs,*idxout,n;
1783 
1784           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1785           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1786           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1787           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1788           if (bs == dof) {
1789             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1790             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1791           } else { /* the original DMDA local-to-local map have been modified */
1792             PetscInt i,d;
1793 
1794             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1795             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1796             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1797 
1798             bs = 1;
1799             n *= dof;
1800           }
1801           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1802           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1803           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1804           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1805           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1806           pcbddc->corner_selected  = PETSC_TRUE;
1807           pcbddc->corner_selection = PETSC_TRUE;
1808         }
1809         if (corners) {
1810           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1811         }
1812       }
1813     }
1814   }
1815   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1816     DM dm;
1817 
1818     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1819     if (!dm) {
1820       ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1821     }
1822     if (dm) { /* this can get very expensive, I need to find a faster alternative */
1823       Vec            vcoords;
1824       PetscSection   section;
1825       PetscReal      *coords;
1826       PetscInt       d,cdim,nl,nf,**ctxs;
1827       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1828 
1829       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1830       ierr = DMGetLocalSection(dm,&section);CHKERRQ(ierr);
1831       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1832       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1833       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1834       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1835       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1836       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1837       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1838       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1839       for (d=0;d<cdim;d++) {
1840         PetscInt          i;
1841         const PetscScalar *v;
1842 
1843         for (i=0;i<nf;i++) ctxs[i][0] = d;
1844         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1845         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1846         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1847         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1848       }
1849       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1850       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1851       ierr = PetscFree(coords);CHKERRQ(ierr);
1852       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1853       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1854     }
1855   }
1856   PetscFunctionReturn(0);
1857 }
1858 
1859 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1860 {
1861   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1862   PetscErrorCode  ierr;
1863   IS              nis;
1864   const PetscInt  *idxs;
1865   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1866   PetscBool       *ld;
1867 
1868   PetscFunctionBegin;
1869   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1870   if (mop == MPI_LAND) {
1871     /* init rootdata with true */
1872     ld   = (PetscBool*) matis->sf_rootdata;
1873     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1874   } else {
1875     ierr = PetscArrayzero(matis->sf_rootdata,pc->pmat->rmap->n);CHKERRQ(ierr);
1876   }
1877   ierr = PetscArrayzero(matis->sf_leafdata,n);CHKERRQ(ierr);
1878   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1879   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1880   ld   = (PetscBool*) matis->sf_leafdata;
1881   for (i=0;i<nd;i++)
1882     if (-1 < idxs[i] && idxs[i] < n)
1883       ld[idxs[i]] = PETSC_TRUE;
1884   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1885   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1886   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1887   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE);CHKERRQ(ierr);
1888   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata,MPI_REPLACE);CHKERRQ(ierr);
1889   if (mop == MPI_LAND) {
1890     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1891   } else {
1892     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1893   }
1894   for (i=0,nnd=0;i<n;i++)
1895     if (ld[i])
1896       nidxs[nnd++] = i;
1897   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1898   ierr = ISDestroy(is);CHKERRQ(ierr);
1899   *is  = nis;
1900   PetscFunctionReturn(0);
1901 }
1902 
1903 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1904 {
1905   PC_IS             *pcis = (PC_IS*)(pc->data);
1906   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1907   PetscErrorCode    ierr;
1908 
1909   PetscFunctionBegin;
1910   if (!pcbddc->benign_have_null) {
1911     PetscFunctionReturn(0);
1912   }
1913   if (pcbddc->ChangeOfBasisMatrix) {
1914     Vec swap;
1915 
1916     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1917     swap = pcbddc->work_change;
1918     pcbddc->work_change = r;
1919     r = swap;
1920   }
1921   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1922   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1923   ierr = PetscLogEventBegin(PC_BDDC_Solves[pcbddc->current_level][0],pc,0,0,0);CHKERRQ(ierr);
1924   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1925   ierr = PetscLogEventEnd(PC_BDDC_Solves[pcbddc->current_level][0],pc,0,0,0);CHKERRQ(ierr);
1926   ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
1927   ierr = VecSet(z,0.);CHKERRQ(ierr);
1928   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1929   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1930   if (pcbddc->ChangeOfBasisMatrix) {
1931     pcbddc->work_change = r;
1932     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1933     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1934   }
1935   PetscFunctionReturn(0);
1936 }
1937 
1938 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1939 {
1940   PCBDDCBenignMatMult_ctx ctx;
1941   PetscErrorCode          ierr;
1942   PetscBool               apply_right,apply_left,reset_x;
1943 
1944   PetscFunctionBegin;
1945   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1946   if (transpose) {
1947     apply_right = ctx->apply_left;
1948     apply_left = ctx->apply_right;
1949   } else {
1950     apply_right = ctx->apply_right;
1951     apply_left = ctx->apply_left;
1952   }
1953   reset_x = PETSC_FALSE;
1954   if (apply_right) {
1955     const PetscScalar *ax;
1956     PetscInt          nl,i;
1957 
1958     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1959     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1960     ierr = PetscArraycpy(ctx->work,ax,nl);CHKERRQ(ierr);
1961     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1962     for (i=0;i<ctx->benign_n;i++) {
1963       PetscScalar    sum,val;
1964       const PetscInt *idxs;
1965       PetscInt       nz,j;
1966       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1967       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1968       sum = 0.;
1969       if (ctx->apply_p0) {
1970         val = ctx->work[idxs[nz-1]];
1971         for (j=0;j<nz-1;j++) {
1972           sum += ctx->work[idxs[j]];
1973           ctx->work[idxs[j]] += val;
1974         }
1975       } else {
1976         for (j=0;j<nz-1;j++) {
1977           sum += ctx->work[idxs[j]];
1978         }
1979       }
1980       ctx->work[idxs[nz-1]] -= sum;
1981       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1982     }
1983     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1984     reset_x = PETSC_TRUE;
1985   }
1986   if (transpose) {
1987     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1988   } else {
1989     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1990   }
1991   if (reset_x) {
1992     ierr = VecResetArray(x);CHKERRQ(ierr);
1993   }
1994   if (apply_left) {
1995     PetscScalar *ay;
1996     PetscInt    i;
1997 
1998     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1999     for (i=0;i<ctx->benign_n;i++) {
2000       PetscScalar    sum,val;
2001       const PetscInt *idxs;
2002       PetscInt       nz,j;
2003       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2004       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2005       val = -ay[idxs[nz-1]];
2006       if (ctx->apply_p0) {
2007         sum = 0.;
2008         for (j=0;j<nz-1;j++) {
2009           sum += ay[idxs[j]];
2010           ay[idxs[j]] += val;
2011         }
2012         ay[idxs[nz-1]] += sum;
2013       } else {
2014         for (j=0;j<nz-1;j++) {
2015           ay[idxs[j]] += val;
2016         }
2017         ay[idxs[nz-1]] = 0.;
2018       }
2019       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2020     }
2021     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
2022   }
2023   PetscFunctionReturn(0);
2024 }
2025 
2026 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
2027 {
2028   PetscErrorCode ierr;
2029 
2030   PetscFunctionBegin;
2031   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
2032   PetscFunctionReturn(0);
2033 }
2034 
2035 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
2036 {
2037   PetscErrorCode ierr;
2038 
2039   PetscFunctionBegin;
2040   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
2041   PetscFunctionReturn(0);
2042 }
2043 
2044 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
2045 {
2046   PC_IS                   *pcis = (PC_IS*)pc->data;
2047   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
2048   PCBDDCBenignMatMult_ctx ctx;
2049   PetscErrorCode          ierr;
2050 
2051   PetscFunctionBegin;
2052   if (!restore) {
2053     Mat                A_IB,A_BI;
2054     PetscScalar        *work;
2055     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
2056 
2057     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
2058     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
2059     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
2060     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
2061     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2062     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
2063     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
2064     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
2065     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2066     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2067     ctx->apply_left = PETSC_TRUE;
2068     ctx->apply_right = PETSC_FALSE;
2069     ctx->apply_p0 = PETSC_FALSE;
2070     ctx->benign_n = pcbddc->benign_n;
2071     if (reuse) {
2072       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2073       ctx->free = PETSC_FALSE;
2074     } else { /* TODO: could be optimized for successive solves */
2075       ISLocalToGlobalMapping N_to_D;
2076       PetscInt               i;
2077 
2078       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2079       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2080       for (i=0;i<pcbddc->benign_n;i++) {
2081         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2082       }
2083       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2084       ctx->free = PETSC_TRUE;
2085     }
2086     ctx->A = pcis->A_IB;
2087     ctx->work = work;
2088     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2089     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2090     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2091     pcis->A_IB = A_IB;
2092 
2093     /* A_BI as A_IB^T */
2094     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2095     pcbddc->benign_original_mat = pcis->A_BI;
2096     pcis->A_BI = A_BI;
2097   } else {
2098     if (!pcbddc->benign_original_mat) {
2099       PetscFunctionReturn(0);
2100     }
2101     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2102     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2103     pcis->A_IB = ctx->A;
2104     ctx->A = NULL;
2105     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2106     pcis->A_BI = pcbddc->benign_original_mat;
2107     pcbddc->benign_original_mat = NULL;
2108     if (ctx->free) {
2109       PetscInt i;
2110       for (i=0;i<ctx->benign_n;i++) {
2111         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2112       }
2113       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2114     }
2115     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2116     ierr = PetscFree(ctx);CHKERRQ(ierr);
2117   }
2118   PetscFunctionReturn(0);
2119 }
2120 
2121 /* used just in bddc debug mode */
2122 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2123 {
2124   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2125   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2126   Mat            An;
2127   PetscErrorCode ierr;
2128 
2129   PetscFunctionBegin;
2130   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2131   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2132   if (is1) {
2133     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2134     ierr = MatDestroy(&An);CHKERRQ(ierr);
2135   } else {
2136     *B = An;
2137   }
2138   PetscFunctionReturn(0);
2139 }
2140 
2141 /* TODO: add reuse flag */
2142 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2143 {
2144   Mat            Bt;
2145   PetscScalar    *a,*bdata;
2146   const PetscInt *ii,*ij;
2147   PetscInt       m,n,i,nnz,*bii,*bij;
2148   PetscBool      flg_row;
2149   PetscErrorCode ierr;
2150 
2151   PetscFunctionBegin;
2152   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2153   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2154   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2155   nnz = n;
2156   for (i=0;i<ii[n];i++) {
2157     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2158   }
2159   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2160   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2161   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2162   nnz = 0;
2163   bii[0] = 0;
2164   for (i=0;i<n;i++) {
2165     PetscInt j;
2166     for (j=ii[i];j<ii[i+1];j++) {
2167       PetscScalar entry = a[j];
2168       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2169         bij[nnz] = ij[j];
2170         bdata[nnz] = entry;
2171         nnz++;
2172       }
2173     }
2174     bii[i+1] = nnz;
2175   }
2176   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2177   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2178   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2179   {
2180     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2181     b->free_a = PETSC_TRUE;
2182     b->free_ij = PETSC_TRUE;
2183   }
2184   if (*B == A) {
2185     ierr = MatDestroy(&A);CHKERRQ(ierr);
2186   }
2187   *B = Bt;
2188   PetscFunctionReturn(0);
2189 }
2190 
2191 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2192 {
2193   Mat                    B = NULL;
2194   DM                     dm;
2195   IS                     is_dummy,*cc_n;
2196   ISLocalToGlobalMapping l2gmap_dummy;
2197   PCBDDCGraph            graph;
2198   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2199   PetscInt               i,n;
2200   PetscInt               *xadj,*adjncy;
2201   PetscBool              isplex = PETSC_FALSE;
2202   PetscErrorCode         ierr;
2203 
2204   PetscFunctionBegin;
2205   if (ncc) *ncc = 0;
2206   if (cc) *cc = NULL;
2207   if (primalv) *primalv = NULL;
2208   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2209   ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2210   if (!dm) {
2211     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2212   }
2213   if (dm) {
2214     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2215   }
2216   if (filter) isplex = PETSC_FALSE;
2217 
2218   if (isplex) { /* this code has been modified from plexpartition.c */
2219     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2220     PetscInt      *adj = NULL;
2221     IS             cellNumbering;
2222     const PetscInt *cellNum;
2223     PetscBool      useCone, useClosure;
2224     PetscSection   section;
2225     PetscSegBuffer adjBuffer;
2226     PetscSF        sfPoint;
2227     PetscErrorCode ierr;
2228 
2229     PetscFunctionBegin;
2230     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2231     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2232     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2233     /* Build adjacency graph via a section/segbuffer */
2234     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2235     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2236     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2237     /* Always use FVM adjacency to create partitioner graph */
2238     ierr = DMGetBasicAdjacency(dm, &useCone, &useClosure);CHKERRQ(ierr);
2239     ierr = DMSetBasicAdjacency(dm, PETSC_TRUE, PETSC_FALSE);CHKERRQ(ierr);
2240     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2241     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2242     for (n = 0, p = pStart; p < pEnd; p++) {
2243       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2244       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2245       adjSize = PETSC_DETERMINE;
2246       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2247       for (a = 0; a < adjSize; ++a) {
2248         const PetscInt point = adj[a];
2249         if (pStart <= point && point < pEnd) {
2250           PetscInt *PETSC_RESTRICT pBuf;
2251           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2252           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2253           *pBuf = point;
2254         }
2255       }
2256       n++;
2257     }
2258     ierr = DMSetBasicAdjacency(dm, useCone, useClosure);CHKERRQ(ierr);
2259     /* Derive CSR graph from section/segbuffer */
2260     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2261     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2262     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2263     for (idx = 0, p = pStart; p < pEnd; p++) {
2264       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2265       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2266     }
2267     xadj[n] = size;
2268     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2269     /* Clean up */
2270     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2271     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2272     ierr = PetscFree(adj);CHKERRQ(ierr);
2273     graph->xadj = xadj;
2274     graph->adjncy = adjncy;
2275   } else {
2276     Mat       A;
2277     PetscBool isseqaij, flg_row;
2278 
2279     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2280     if (!A->rmap->N || !A->cmap->N) {
2281       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2282       PetscFunctionReturn(0);
2283     }
2284     ierr = PetscObjectBaseTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2285     if (!isseqaij && filter) {
2286       PetscBool isseqdense;
2287 
2288       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2289       if (!isseqdense) {
2290         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2291       } else { /* TODO: rectangular case and LDA */
2292         PetscScalar *array;
2293         PetscReal   chop=1.e-6;
2294 
2295         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2296         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2297         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2298         for (i=0;i<n;i++) {
2299           PetscInt j;
2300           for (j=i+1;j<n;j++) {
2301             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2302             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2303             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2304           }
2305         }
2306         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2307         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2308       }
2309     } else {
2310       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2311       B = A;
2312     }
2313     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2314 
2315     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2316     if (filter) {
2317       PetscScalar *data;
2318       PetscInt    j,cum;
2319 
2320       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2321       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2322       cum = 0;
2323       for (i=0;i<n;i++) {
2324         PetscInt t;
2325 
2326         for (j=xadj[i];j<xadj[i+1];j++) {
2327           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2328             continue;
2329           }
2330           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2331         }
2332         t = xadj_filtered[i];
2333         xadj_filtered[i] = cum;
2334         cum += t;
2335       }
2336       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2337       graph->xadj = xadj_filtered;
2338       graph->adjncy = adjncy_filtered;
2339     } else {
2340       graph->xadj = xadj;
2341       graph->adjncy = adjncy;
2342     }
2343   }
2344   /* compute local connected components using PCBDDCGraph */
2345   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2346   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2347   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2348   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2349   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2350   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2351   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2352 
2353   /* partial clean up */
2354   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2355   if (B) {
2356     PetscBool flg_row;
2357     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2358     ierr = MatDestroy(&B);CHKERRQ(ierr);
2359   }
2360   if (isplex) {
2361     ierr = PetscFree(xadj);CHKERRQ(ierr);
2362     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2363   }
2364 
2365   /* get back data */
2366   if (isplex) {
2367     if (ncc) *ncc = graph->ncc;
2368     if (cc || primalv) {
2369       Mat          A;
2370       PetscBT      btv,btvt;
2371       PetscSection subSection;
2372       PetscInt     *ids,cum,cump,*cids,*pids;
2373 
2374       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2375       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2376       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2377       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2378       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2379 
2380       cids[0] = 0;
2381       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2382         PetscInt j;
2383 
2384         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2385         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2386           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2387 
2388           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2389           for (k = 0; k < 2*size; k += 2) {
2390             PetscInt s, pp, p = closure[k], off, dof, cdof;
2391 
2392             ierr = PetscSectionGetConstraintDof(subSection,p,&cdof);CHKERRQ(ierr);
2393             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2394             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2395             for (s = 0; s < dof-cdof; s++) {
2396               if (PetscBTLookupSet(btvt,off+s)) continue;
2397               if (!PetscBTLookup(btv,off+s)) {
2398                 ids[cum++] = off+s;
2399               } else { /* cross-vertex */
2400                 pids[cump++] = off+s;
2401               }
2402             }
2403             ierr = DMPlexGetTreeParent(dm,p,&pp,NULL);CHKERRQ(ierr);
2404             if (pp != p) {
2405               ierr = PetscSectionGetConstraintDof(subSection,pp,&cdof);CHKERRQ(ierr);
2406               ierr = PetscSectionGetOffset(subSection,pp,&off);CHKERRQ(ierr);
2407               ierr = PetscSectionGetDof(subSection,pp,&dof);CHKERRQ(ierr);
2408               for (s = 0; s < dof-cdof; s++) {
2409                 if (PetscBTLookupSet(btvt,off+s)) continue;
2410                 if (!PetscBTLookup(btv,off+s)) {
2411                   ids[cum++] = off+s;
2412                 } else { /* cross-vertex */
2413                   pids[cump++] = off+s;
2414                 }
2415               }
2416             }
2417           }
2418           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2419         }
2420         cids[i+1] = cum;
2421         /* mark dofs as already assigned */
2422         for (j = cids[i]; j < cids[i+1]; j++) {
2423           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2424         }
2425       }
2426       if (cc) {
2427         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2428         for (i = 0; i < graph->ncc; i++) {
2429           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2430         }
2431         *cc = cc_n;
2432       }
2433       if (primalv) {
2434         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2435       }
2436       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2437       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2438       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2439     }
2440   } else {
2441     if (ncc) *ncc = graph->ncc;
2442     if (cc) {
2443       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2444       for (i=0;i<graph->ncc;i++) {
2445         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);
2446       }
2447       *cc = cc_n;
2448     }
2449   }
2450   /* clean up graph */
2451   graph->xadj = NULL;
2452   graph->adjncy = NULL;
2453   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2454   PetscFunctionReturn(0);
2455 }
2456 
2457 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2458 {
2459   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2460   PC_IS*         pcis = (PC_IS*)(pc->data);
2461   IS             dirIS = NULL;
2462   PetscInt       i;
2463   PetscErrorCode ierr;
2464 
2465   PetscFunctionBegin;
2466   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2467   if (zerodiag) {
2468     Mat            A;
2469     Vec            vec3_N;
2470     PetscScalar    *vals;
2471     const PetscInt *idxs;
2472     PetscInt       nz,*count;
2473 
2474     /* p0 */
2475     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2476     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2477     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2478     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2479     for (i=0;i<nz;i++) vals[i] = 1.;
2480     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2481     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2482     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2483     /* v_I */
2484     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2485     for (i=0;i<nz;i++) vals[i] = 0.;
2486     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2487     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2488     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2489     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2490     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2491     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2492     if (dirIS) {
2493       PetscInt n;
2494 
2495       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2496       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2497       for (i=0;i<n;i++) vals[i] = 0.;
2498       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2499       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2500     }
2501     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2502     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2503     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2504     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2505     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2506     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2507     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2508     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]));
2509     ierr = PetscFree(vals);CHKERRQ(ierr);
2510     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2511 
2512     /* there should not be any pressure dofs lying on the interface */
2513     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2514     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2515     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2516     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2517     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2518     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]);
2519     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2520     ierr = PetscFree(count);CHKERRQ(ierr);
2521   }
2522   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2523 
2524   /* check PCBDDCBenignGetOrSetP0 */
2525   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2526   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2527   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2528   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2529   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2530   for (i=0;i<pcbddc->benign_n;i++) {
2531     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2532     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %D instead of %g",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2533   }
2534   PetscFunctionReturn(0);
2535 }
2536 
2537 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, PetscBool reuse, IS *zerodiaglocal)
2538 {
2539   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2540   IS             pressures = NULL,zerodiag = NULL,*bzerodiag = NULL,zerodiag_save,*zerodiag_subs;
2541   PetscInt       nz,n,benign_n,bsp = 1;
2542   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2543   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2544   PetscErrorCode ierr;
2545 
2546   PetscFunctionBegin;
2547   if (reuse) goto project_b0;
2548   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2549   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2550   for (n=0;n<pcbddc->benign_n;n++) {
2551     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2552   }
2553   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2554   has_null_pressures = PETSC_TRUE;
2555   have_null = PETSC_TRUE;
2556   /* if a local information on dofs is present, gets pressure dofs from command line (uses the last field is not provided)
2557      Without local information, it uses only the zerodiagonal dofs (ok if the pressure block is all zero and it is a scalar field)
2558      Checks if all the pressure dofs in each subdomain have a zero diagonal
2559      If not, a change of basis on pressures is not needed
2560      since the local Schur complements are already SPD
2561   */
2562   if (pcbddc->n_ISForDofsLocal) {
2563     IS        iP = NULL;
2564     PetscInt  p,*pp;
2565     PetscBool flg;
2566 
2567     ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pp);CHKERRQ(ierr);
2568     n    = pcbddc->n_ISForDofsLocal;
2569     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2570     ierr = PetscOptionsIntArray("-pc_bddc_pressure_field","Field id for pressures",NULL,pp,&n,&flg);CHKERRQ(ierr);
2571     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2572     if (!flg) {
2573       n = 1;
2574       pp[0] = pcbddc->n_ISForDofsLocal-1;
2575     }
2576 
2577     bsp = 0;
2578     for (p=0;p<n;p++) {
2579       PetscInt bs;
2580 
2581       if (pp[p] < 0 || pp[p] > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",pp[p]);
2582       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2583       bsp += bs;
2584     }
2585     ierr = PetscMalloc1(bsp,&bzerodiag);CHKERRQ(ierr);
2586     bsp  = 0;
2587     for (p=0;p<n;p++) {
2588       const PetscInt *idxs;
2589       PetscInt       b,bs,npl,*bidxs;
2590 
2591       ierr = ISGetBlockSize(pcbddc->ISForDofsLocal[pp[p]],&bs);CHKERRQ(ierr);
2592       ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[pp[p]],&npl);CHKERRQ(ierr);
2593       ierr = ISGetIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2594       ierr = PetscMalloc1(npl/bs,&bidxs);CHKERRQ(ierr);
2595       for (b=0;b<bs;b++) {
2596         PetscInt i;
2597 
2598         for (i=0;i<npl/bs;i++) bidxs[i] = idxs[bs*i+b];
2599         ierr = ISCreateGeneral(PETSC_COMM_SELF,npl/bs,bidxs,PETSC_COPY_VALUES,&bzerodiag[bsp]);CHKERRQ(ierr);
2600         bsp++;
2601       }
2602       ierr = PetscFree(bidxs);CHKERRQ(ierr);
2603       ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[pp[p]],&idxs);CHKERRQ(ierr);
2604     }
2605     ierr = ISConcatenate(PETSC_COMM_SELF,bsp,bzerodiag,&pressures);CHKERRQ(ierr);
2606 
2607     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2608     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2609     if (iP) {
2610       IS newpressures;
2611 
2612       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2613       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2614       pressures = newpressures;
2615     }
2616     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2617     if (!sorted) {
2618       ierr = ISSort(pressures);CHKERRQ(ierr);
2619     }
2620     ierr = PetscFree(pp);CHKERRQ(ierr);
2621   }
2622 
2623   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2624   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2625   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2626   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2627   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2628   if (!sorted) {
2629     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2630   }
2631   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2632   zerodiag_save = zerodiag;
2633   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2634   if (!nz) {
2635     if (n) have_null = PETSC_FALSE;
2636     has_null_pressures = PETSC_FALSE;
2637     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2638   }
2639   recompute_zerodiag = PETSC_FALSE;
2640 
2641   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2642   zerodiag_subs    = NULL;
2643   benign_n         = 0;
2644   n_interior_dofs  = 0;
2645   interior_dofs    = NULL;
2646   nneu             = 0;
2647   if (pcbddc->NeumannBoundariesLocal) {
2648     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2649   }
2650   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2651   if (checkb) { /* need to compute interior nodes */
2652     PetscInt n,i,j;
2653     PetscInt n_neigh,*neigh,*n_shared,**shared;
2654     PetscInt *iwork;
2655 
2656     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2657     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2658     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2659     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2660     for (i=1;i<n_neigh;i++)
2661       for (j=0;j<n_shared[i];j++)
2662           iwork[shared[i][j]] += 1;
2663     for (i=0;i<n;i++)
2664       if (!iwork[i])
2665         interior_dofs[n_interior_dofs++] = i;
2666     ierr = PetscFree(iwork);CHKERRQ(ierr);
2667     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2668   }
2669   if (has_null_pressures) {
2670     IS             *subs;
2671     PetscInt       nsubs,i,j,nl;
2672     const PetscInt *idxs;
2673     PetscScalar    *array;
2674     Vec            *work;
2675     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2676 
2677     subs  = pcbddc->local_subs;
2678     nsubs = pcbddc->n_local_subs;
2679     /* 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) */
2680     if (checkb) {
2681       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2682       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2683       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2684       /* work[0] = 1_p */
2685       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2686       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2687       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2688       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2689       /* work[0] = 1_v */
2690       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2691       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2692       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2693       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2694       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2695     }
2696 
2697     if (nsubs > 1 || bsp > 1) {
2698       IS       *is;
2699       PetscInt b,totb;
2700 
2701       totb  = bsp;
2702       is    = bsp > 1 ? bzerodiag : &zerodiag;
2703       nsubs = PetscMax(nsubs,1);
2704       ierr  = PetscCalloc1(nsubs*totb,&zerodiag_subs);CHKERRQ(ierr);
2705       for (b=0;b<totb;b++) {
2706         for (i=0;i<nsubs;i++) {
2707           ISLocalToGlobalMapping l2g;
2708           IS                     t_zerodiag_subs;
2709           PetscInt               nl;
2710 
2711           if (subs) {
2712             ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2713           } else {
2714             IS tis;
2715 
2716             ierr = MatGetLocalSize(pcbddc->local_mat,&nl,NULL);CHKERRQ(ierr);
2717             ierr = ISCreateStride(PETSC_COMM_SELF,nl,0,1,&tis);CHKERRQ(ierr);
2718             ierr = ISLocalToGlobalMappingCreateIS(tis,&l2g);CHKERRQ(ierr);
2719             ierr = ISDestroy(&tis);CHKERRQ(ierr);
2720           }
2721           ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,is[b],&t_zerodiag_subs);CHKERRQ(ierr);
2722           ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2723           if (nl) {
2724             PetscBool valid = PETSC_TRUE;
2725 
2726             if (checkb) {
2727               ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2728               ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2729               ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2730               ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2731               for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2732               ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2733               ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2734               ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2735               ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2736               ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2737               ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2738               for (j=0;j<n_interior_dofs;j++) {
2739                 if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2740                   valid = PETSC_FALSE;
2741                   break;
2742                 }
2743               }
2744               ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2745             }
2746             if (valid && nneu) {
2747               const PetscInt *idxs;
2748               PetscInt       nzb;
2749 
2750               ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2751               ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2752               ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2753               if (nzb) valid = PETSC_FALSE;
2754             }
2755             if (valid && pressures) {
2756               IS       t_pressure_subs,tmp;
2757               PetscInt i1,i2;
2758 
2759               ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2760               ierr = ISEmbed(t_zerodiag_subs,t_pressure_subs,PETSC_TRUE,&tmp);CHKERRQ(ierr);
2761               ierr = ISGetLocalSize(tmp,&i1);CHKERRQ(ierr);
2762               ierr = ISGetLocalSize(t_zerodiag_subs,&i2);CHKERRQ(ierr);
2763               if (i2 != i1) valid = PETSC_FALSE;
2764               ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2765               ierr = ISDestroy(&tmp);CHKERRQ(ierr);
2766             }
2767             if (valid) {
2768               ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[benign_n]);CHKERRQ(ierr);
2769               benign_n++;
2770             } else recompute_zerodiag = PETSC_TRUE;
2771           }
2772           ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2773           ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2774         }
2775       }
2776     } else { /* there's just one subdomain (or zero if they have not been detected */
2777       PetscBool valid = PETSC_TRUE;
2778 
2779       if (nneu) valid = PETSC_FALSE;
2780       if (valid && pressures) {
2781         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2782       }
2783       if (valid && checkb) {
2784         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2785         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2786         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2787         for (j=0;j<n_interior_dofs;j++) {
2788           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2789             valid = PETSC_FALSE;
2790             break;
2791           }
2792         }
2793         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2794       }
2795       if (valid) {
2796         benign_n = 1;
2797         ierr = PetscMalloc1(benign_n,&zerodiag_subs);CHKERRQ(ierr);
2798         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2799         zerodiag_subs[0] = zerodiag;
2800       }
2801     }
2802     if (checkb) {
2803       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2804     }
2805   }
2806   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2807 
2808   if (!benign_n) {
2809     PetscInt n;
2810 
2811     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2812     recompute_zerodiag = PETSC_FALSE;
2813     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2814     if (n) have_null = PETSC_FALSE;
2815   }
2816 
2817   /* final check for null pressures */
2818   if (zerodiag && pressures) {
2819     ierr = ISEqual(pressures,zerodiag,&have_null);CHKERRQ(ierr);
2820   }
2821 
2822   if (recompute_zerodiag) {
2823     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2824     if (benign_n == 1) {
2825       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2826       zerodiag = zerodiag_subs[0];
2827     } else {
2828       PetscInt i,nzn,*new_idxs;
2829 
2830       nzn = 0;
2831       for (i=0;i<benign_n;i++) {
2832         PetscInt ns;
2833         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2834         nzn += ns;
2835       }
2836       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2837       nzn = 0;
2838       for (i=0;i<benign_n;i++) {
2839         PetscInt ns,*idxs;
2840         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2841         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2842         ierr = PetscArraycpy(new_idxs+nzn,idxs,ns);CHKERRQ(ierr);
2843         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2844         nzn += ns;
2845       }
2846       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2847       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2848     }
2849     have_null = PETSC_FALSE;
2850   }
2851 
2852   /* determines if the coarse solver will be singular or not */
2853   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
2854 
2855   /* Prepare matrix to compute no-net-flux */
2856   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2857     Mat                    A,loc_divudotp;
2858     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2859     IS                     row,col,isused = NULL;
2860     PetscInt               M,N,n,st,n_isused;
2861 
2862     if (pressures) {
2863       isused = pressures;
2864     } else {
2865       isused = zerodiag_save;
2866     }
2867     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2868     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2869     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2870     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");
2871     n_isused = 0;
2872     if (isused) {
2873       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2874     }
2875     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
2876     st = st-n_isused;
2877     if (n) {
2878       const PetscInt *gidxs;
2879 
2880       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2881       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2882       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2883       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2884       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2885       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2886     } else {
2887       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2888       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2889       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2890     }
2891     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2892     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2893     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2894     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2895     ierr = ISDestroy(&row);CHKERRQ(ierr);
2896     ierr = ISDestroy(&col);CHKERRQ(ierr);
2897     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2898     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2899     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2900     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2901     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2902     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2903     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2904     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2905     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2906     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2907   }
2908   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2909   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2910   if (bzerodiag) {
2911     PetscInt i;
2912 
2913     for (i=0;i<bsp;i++) {
2914       ierr = ISDestroy(&bzerodiag[i]);CHKERRQ(ierr);
2915     }
2916     ierr = PetscFree(bzerodiag);CHKERRQ(ierr);
2917   }
2918   pcbddc->benign_n = benign_n;
2919   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2920 
2921   /* determines if the problem has subdomains with 0 pressure block */
2922   have_null = (PetscBool)(!!pcbddc->benign_n);
2923   ierr = MPIU_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
2924 
2925 project_b0:
2926   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2927   /* change of basis and p0 dofs */
2928   if (pcbddc->benign_n) {
2929     PetscInt i,s,*nnz;
2930 
2931     /* local change of basis for pressures */
2932     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2933     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2934     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2935     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2936     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2937     for (i=0;i<n;i++) nnz[i] = 1; /* defaults to identity */
2938     for (i=0;i<pcbddc->benign_n;i++) {
2939       const PetscInt *idxs;
2940       PetscInt       nzs,j;
2941 
2942       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2943       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2944       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2945       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2946       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2947     }
2948     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2949     ierr = MatSetOption(pcbddc->benign_change,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
2950     ierr = PetscFree(nnz);CHKERRQ(ierr);
2951     /* set identity by default */
2952     for (i=0;i<n;i++) {
2953       ierr = MatSetValue(pcbddc->benign_change,i,i,1.,INSERT_VALUES);CHKERRQ(ierr);
2954     }
2955     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2956     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2957     /* set change on pressures */
2958     for (s=0;s<pcbddc->benign_n;s++) {
2959       PetscScalar    *array;
2960       const PetscInt *idxs;
2961       PetscInt       nzs;
2962 
2963       ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2964       ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2965       for (i=0;i<nzs-1;i++) {
2966         PetscScalar vals[2];
2967         PetscInt    cols[2];
2968 
2969         cols[0] = idxs[i];
2970         cols[1] = idxs[nzs-1];
2971         vals[0] = 1.;
2972         vals[1] = 1.;
2973         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2974       }
2975       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2976       for (i=0;i<nzs-1;i++) array[i] = -1.;
2977       array[nzs-1] = 1.;
2978       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2979       /* store local idxs for p0 */
2980       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2981       ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2982       ierr = PetscFree(array);CHKERRQ(ierr);
2983     }
2984     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2985     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2986 
2987     /* project if needed */
2988     if (pcbddc->benign_change_explicit) {
2989       Mat M;
2990 
2991       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2992       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2993       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2994       ierr = MatDestroy(&M);CHKERRQ(ierr);
2995     }
2996     /* store global idxs for p0 */
2997     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2998   }
2999   *zerodiaglocal = zerodiag;
3000   PetscFunctionReturn(0);
3001 }
3002 
3003 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
3004 {
3005   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3006   PetscScalar    *array;
3007   PetscErrorCode ierr;
3008 
3009   PetscFunctionBegin;
3010   if (!pcbddc->benign_sf) {
3011     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
3012     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
3013   }
3014   if (get) {
3015     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3016     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0,MPI_REPLACE);CHKERRQ(ierr);
3017     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0,MPI_REPLACE);CHKERRQ(ierr);
3018     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
3019   } else {
3020     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
3021     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPI_REPLACE);CHKERRQ(ierr);
3022     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPI_REPLACE);CHKERRQ(ierr);
3023     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
3024   }
3025   PetscFunctionReturn(0);
3026 }
3027 
3028 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
3029 {
3030   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
3031   PetscErrorCode ierr;
3032 
3033   PetscFunctionBegin;
3034   /* TODO: add error checking
3035     - avoid nested pop (or push) calls.
3036     - cannot push before pop.
3037     - cannot call this if pcbddc->local_mat is NULL
3038   */
3039   if (!pcbddc->benign_n) {
3040     PetscFunctionReturn(0);
3041   }
3042   if (pop) {
3043     if (pcbddc->benign_change_explicit) {
3044       IS       is_p0;
3045       MatReuse reuse;
3046 
3047       /* extract B_0 */
3048       reuse = MAT_INITIAL_MATRIX;
3049       if (pcbddc->benign_B0) {
3050         reuse = MAT_REUSE_MATRIX;
3051       }
3052       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
3053       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
3054       /* remove rows and cols from local problem */
3055       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
3056       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
3057       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
3058       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3059     } else {
3060       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
3061       PetscScalar *vals;
3062       PetscInt    i,n,*idxs_ins;
3063 
3064       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
3065       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
3066       if (!pcbddc->benign_B0) {
3067         PetscInt *nnz;
3068         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
3069         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
3070         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
3071         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
3072         for (i=0;i<pcbddc->benign_n;i++) {
3073           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
3074           nnz[i] = n - nnz[i];
3075         }
3076         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
3077         ierr = MatSetOption(pcbddc->benign_B0,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
3078         ierr = PetscFree(nnz);CHKERRQ(ierr);
3079       }
3080 
3081       for (i=0;i<pcbddc->benign_n;i++) {
3082         PetscScalar *array;
3083         PetscInt    *idxs,j,nz,cum;
3084 
3085         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
3086         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3087         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3088         for (j=0;j<nz;j++) vals[j] = 1.;
3089         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
3090         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
3091         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
3092         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
3093         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
3094         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
3095         cum = 0;
3096         for (j=0;j<n;j++) {
3097           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
3098             vals[cum] = array[j];
3099             idxs_ins[cum] = j;
3100             cum++;
3101           }
3102         }
3103         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
3104         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
3105         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
3106       }
3107       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3108       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3109       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
3110     }
3111   } else { /* push */
3112     if (pcbddc->benign_change_explicit) {
3113       PetscInt i;
3114 
3115       for (i=0;i<pcbddc->benign_n;i++) {
3116         PetscScalar *B0_vals;
3117         PetscInt    *B0_cols,B0_ncol;
3118 
3119         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3120         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3121         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
3122         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
3123         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
3124       }
3125       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3126       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
3127     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!");
3128   }
3129   PetscFunctionReturn(0);
3130 }
3131 
3132 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3133 {
3134   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3135   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3136   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3137   PetscBLASInt    *B_iwork,*B_ifail;
3138   PetscScalar     *work,lwork;
3139   PetscScalar     *St,*S,*eigv;
3140   PetscScalar     *Sarray,*Starray;
3141   PetscReal       *eigs,thresh,lthresh,uthresh;
3142   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3143   PetscBool       allocated_S_St;
3144 #if defined(PETSC_USE_COMPLEX)
3145   PetscReal       *rwork;
3146 #endif
3147   PetscErrorCode  ierr;
3148 
3149   PetscFunctionBegin;
3150   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3151   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3152   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);
3153   ierr = PetscLogEventBegin(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3154 
3155   if (pcbddc->dbg_flag) {
3156     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3157     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3158     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3159     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3160   }
3161 
3162   if (pcbddc->dbg_flag) {
3163     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %D (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);CHKERRQ(ierr);
3164   }
3165 
3166   /* max size of subsets */
3167   mss = 0;
3168   for (i=0;i<sub_schurs->n_subs;i++) {
3169     PetscInt subset_size;
3170 
3171     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3172     mss = PetscMax(mss,subset_size);
3173   }
3174 
3175   /* min/max and threshold */
3176   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3177   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3178   nmax = PetscMax(nmin,nmax);
3179   allocated_S_St = PETSC_FALSE;
3180   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3181     allocated_S_St = PETSC_TRUE;
3182   }
3183 
3184   /* allocate lapack workspace */
3185   cum = cum2 = 0;
3186   maxneigs = 0;
3187   for (i=0;i<sub_schurs->n_subs;i++) {
3188     PetscInt n,subset_size;
3189 
3190     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3191     n = PetscMin(subset_size,nmax);
3192     cum += subset_size;
3193     cum2 += subset_size*n;
3194     maxneigs = PetscMax(maxneigs,n);
3195   }
3196   lwork = 0;
3197   if (mss) {
3198     if (sub_schurs->is_symmetric) {
3199       PetscScalar  sdummy = 0.;
3200       PetscBLASInt B_itype = 1;
3201       PetscBLASInt B_N = mss, idummy = 0;
3202       PetscReal    rdummy = 0.,zero = 0.0;
3203       PetscReal    eps = 0.0; /* dlamch? */
3204 
3205       B_lwork = -1;
3206       /* some implementations may complain about NULL pointers, even if we are querying */
3207       S = &sdummy;
3208       St = &sdummy;
3209       eigs = &rdummy;
3210       eigv = &sdummy;
3211       B_iwork = &idummy;
3212       B_ifail = &idummy;
3213 #if defined(PETSC_USE_COMPLEX)
3214       rwork = &rdummy;
3215 #endif
3216       thresh = 1.0;
3217       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3218 #if defined(PETSC_USE_COMPLEX)
3219       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));
3220 #else
3221       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));
3222 #endif
3223       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3224       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3225     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3226   }
3227 
3228   nv = 0;
3229   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) */
3230     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3231   }
3232   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3233   if (allocated_S_St) {
3234     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3235   }
3236   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3237 #if defined(PETSC_USE_COMPLEX)
3238   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3239 #endif
3240   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3241                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3242                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3243                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3244                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3245   ierr = PetscArrayzero(pcbddc->adaptive_constraints_n,nv+sub_schurs->n_subs);CHKERRQ(ierr);
3246 
3247   maxneigs = 0;
3248   cum = cumarray = 0;
3249   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3250   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3251   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3252     const PetscInt *idxs;
3253 
3254     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3255     for (cum=0;cum<nv;cum++) {
3256       pcbddc->adaptive_constraints_n[cum] = 1;
3257       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3258       pcbddc->adaptive_constraints_data[cum] = 1.0;
3259       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3260       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3261     }
3262     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3263   }
3264 
3265   if (mss) { /* multilevel */
3266     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3267     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3268   }
3269 
3270   lthresh = pcbddc->adaptive_threshold[0];
3271   uthresh = pcbddc->adaptive_threshold[1];
3272   for (i=0;i<sub_schurs->n_subs;i++) {
3273     const PetscInt *idxs;
3274     PetscReal      upper,lower;
3275     PetscInt       j,subset_size,eigs_start = 0;
3276     PetscBLASInt   B_N;
3277     PetscBool      same_data = PETSC_FALSE;
3278     PetscBool      scal = PETSC_FALSE;
3279 
3280     if (pcbddc->use_deluxe_scaling) {
3281       upper = PETSC_MAX_REAL;
3282       lower = uthresh;
3283     } else {
3284       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3285       upper = 1./uthresh;
3286       lower = 0.;
3287     }
3288     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3289     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3290     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3291     /* this is experimental: we assume the dofs have been properly grouped to have
3292        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3293     if (!sub_schurs->is_posdef) {
3294       Mat T;
3295 
3296       for (j=0;j<subset_size;j++) {
3297         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3298           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3299           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3300           ierr = MatDestroy(&T);CHKERRQ(ierr);
3301           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3302           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3303           ierr = MatDestroy(&T);CHKERRQ(ierr);
3304           if (sub_schurs->change_primal_sub) {
3305             PetscInt       nz,k;
3306             const PetscInt *idxs;
3307 
3308             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3309             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3310             for (k=0;k<nz;k++) {
3311               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3312               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3313             }
3314             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3315           }
3316           scal = PETSC_TRUE;
3317           break;
3318         }
3319       }
3320     }
3321 
3322     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3323       if (sub_schurs->is_symmetric) {
3324         PetscInt j,k;
3325         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscArraycmp() later */
3326           ierr = PetscArrayzero(S,subset_size*subset_size);CHKERRQ(ierr);
3327           ierr = PetscArrayzero(St,subset_size*subset_size);CHKERRQ(ierr);
3328         }
3329         for (j=0;j<subset_size;j++) {
3330           for (k=j;k<subset_size;k++) {
3331             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3332             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3333           }
3334         }
3335       } else {
3336         ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3337         ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3338       }
3339     } else {
3340       S = Sarray + cumarray;
3341       St = Starray + cumarray;
3342     }
3343     /* see if we can save some work */
3344     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3345       ierr = PetscArraycmp(S,St,subset_size*subset_size,&same_data);CHKERRQ(ierr);
3346     }
3347 
3348     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3349       B_neigs = 0;
3350     } else {
3351       if (sub_schurs->is_symmetric) {
3352         PetscBLASInt B_itype = 1;
3353         PetscBLASInt B_IL, B_IU;
3354         PetscReal    eps = -1.0; /* dlamch? */
3355         PetscInt     nmin_s;
3356         PetscBool    compute_range;
3357 
3358         B_neigs = 0;
3359         compute_range = (PetscBool)!same_data;
3360         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3361 
3362         if (pcbddc->dbg_flag) {
3363           PetscInt nc = 0;
3364 
3365           if (sub_schurs->change_primal_sub) {
3366             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3367           }
3368           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %D/%D size %D count %D fid %D (range %d) (change %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,nc);CHKERRQ(ierr);
3369         }
3370 
3371         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3372         if (compute_range) {
3373 
3374           /* ask for eigenvalues larger than thresh */
3375           if (sub_schurs->is_posdef) {
3376 #if defined(PETSC_USE_COMPLEX)
3377             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));
3378 #else
3379             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));
3380 #endif
3381             ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3382           } else { /* no theory so far, but it works nicely */
3383             PetscInt  recipe = 0,recipe_m = 1;
3384             PetscReal bb[2];
3385 
3386             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3387             switch (recipe) {
3388             case 0:
3389               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3390               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3391 #if defined(PETSC_USE_COMPLEX)
3392               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));
3393 #else
3394               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));
3395 #endif
3396               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3397               break;
3398             case 1:
3399               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3400 #if defined(PETSC_USE_COMPLEX)
3401               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));
3402 #else
3403               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));
3404 #endif
3405               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3406               if (!scal) {
3407                 PetscBLASInt B_neigs2 = 0;
3408 
3409                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3410                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3411                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3412 #if defined(PETSC_USE_COMPLEX)
3413                 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));
3414 #else
3415                 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));
3416 #endif
3417                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3418                 B_neigs += B_neigs2;
3419               }
3420               break;
3421             case 2:
3422               if (scal) {
3423                 bb[0] = PETSC_MIN_REAL;
3424                 bb[1] = 0;
3425 #if defined(PETSC_USE_COMPLEX)
3426                 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));
3427 #else
3428                 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));
3429 #endif
3430                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3431               } else {
3432                 PetscBLASInt B_neigs2 = 0;
3433                 PetscBool    import = PETSC_FALSE;
3434 
3435                 lthresh = PetscMax(lthresh,0.0);
3436                 if (lthresh > 0.0) {
3437                   bb[0] = PETSC_MIN_REAL;
3438                   bb[1] = lthresh*lthresh;
3439 
3440                   import = PETSC_TRUE;
3441 #if defined(PETSC_USE_COMPLEX)
3442                   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));
3443 #else
3444                   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));
3445 #endif
3446                   ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3447                 }
3448                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3449                 bb[1] = PETSC_MAX_REAL;
3450                 if (import) {
3451                   ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3452                   ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3453                 }
3454 #if defined(PETSC_USE_COMPLEX)
3455                 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));
3456 #else
3457                 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));
3458 #endif
3459                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3460                 B_neigs += B_neigs2;
3461               }
3462               break;
3463             case 3:
3464               if (scal) {
3465                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3466               } else {
3467                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3468               }
3469               if (!scal) {
3470                 bb[0] = uthresh;
3471                 bb[1] = PETSC_MAX_REAL;
3472 #if defined(PETSC_USE_COMPLEX)
3473                 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));
3474 #else
3475                 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));
3476 #endif
3477                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3478               }
3479               if (recipe_m > 0 && B_N - B_neigs > 0) {
3480                 PetscBLASInt B_neigs2 = 0;
3481 
3482                 B_IL = 1;
3483                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3484                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3485                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3486 #if defined(PETSC_USE_COMPLEX)
3487                 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*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3488 #else
3489                 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*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3490 #endif
3491                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3492                 B_neigs += B_neigs2;
3493               }
3494               break;
3495             case 4:
3496               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3497 #if defined(PETSC_USE_COMPLEX)
3498               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));
3499 #else
3500               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));
3501 #endif
3502               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3503               {
3504                 PetscBLASInt B_neigs2 = 0;
3505 
3506                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3507                 ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3508                 ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3509 #if defined(PETSC_USE_COMPLEX)
3510                 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));
3511 #else
3512                 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));
3513 #endif
3514                 ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3515                 B_neigs += B_neigs2;
3516               }
3517               break;
3518             case 5: /* same as before: first compute all eigenvalues, then filter */
3519 #if defined(PETSC_USE_COMPLEX)
3520               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3521 #else
3522               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3523 #endif
3524               ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3525               {
3526                 PetscInt e,k,ne;
3527                 for (e=0,ne=0;e<B_neigs;e++) {
3528                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3529                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3530                     eigs[ne] = eigs[e];
3531                     ne++;
3532                   }
3533                 }
3534                 ierr = PetscArraycpy(eigv,S,B_N*ne);CHKERRQ(ierr);
3535                 B_neigs = ne;
3536               }
3537               break;
3538             default:
3539               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3540             }
3541           }
3542         } else if (!same_data) { /* this is just to see all the eigenvalues */
3543           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3544           B_IL = 1;
3545 #if defined(PETSC_USE_COMPLEX)
3546           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));
3547 #else
3548           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));
3549 #endif
3550           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3551         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3552           PetscInt k;
3553           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3554           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3555           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3556           nmin = nmax;
3557           ierr = PetscArrayzero(eigv,subset_size*nmax);CHKERRQ(ierr);
3558           for (k=0;k<nmax;k++) {
3559             eigs[k] = 1./PETSC_SMALL;
3560             eigv[k*(subset_size+1)] = 1.0;
3561           }
3562         }
3563         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3564         if (B_ierr) {
3565           if (B_ierr < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3566           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);
3567           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);
3568         }
3569 
3570         if (B_neigs > nmax) {
3571           if (pcbddc->dbg_flag) {
3572             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %D.\n",B_neigs,nmax);CHKERRQ(ierr);
3573           }
3574           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3575           B_neigs = nmax;
3576         }
3577 
3578         nmin_s = PetscMin(nmin,B_N);
3579         if (B_neigs < nmin_s) {
3580           PetscBLASInt B_neigs2 = 0;
3581 
3582           if (pcbddc->use_deluxe_scaling) {
3583             if (scal) {
3584               B_IU = nmin_s;
3585               B_IL = B_neigs + 1;
3586             } else {
3587               B_IL = B_N - nmin_s + 1;
3588               B_IU = B_N - B_neigs;
3589             }
3590           } else {
3591             B_IL = B_neigs + 1;
3592             B_IU = nmin_s;
3593           }
3594           if (pcbddc->dbg_flag) {
3595             ierr = 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);CHKERRQ(ierr);
3596           }
3597           if (sub_schurs->is_symmetric) {
3598             PetscInt j,k;
3599             for (j=0;j<subset_size;j++) {
3600               for (k=j;k<subset_size;k++) {
3601                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3602                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3603               }
3604             }
3605           } else {
3606             ierr = PetscArraycpy(S,Sarray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3607             ierr = PetscArraycpy(St,Starray+cumarray,subset_size*subset_size);CHKERRQ(ierr);
3608           }
3609           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3610 #if defined(PETSC_USE_COMPLEX)
3611           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));
3612 #else
3613           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));
3614 #endif
3615           ierr = PetscLogFlops((4.0*subset_size*subset_size*subset_size)/3.0);CHKERRQ(ierr);
3616           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3617           B_neigs += B_neigs2;
3618         }
3619         if (B_ierr) {
3620           if (B_ierr < 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3621           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);
3622           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);
3623         }
3624         if (pcbddc->dbg_flag) {
3625           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3626           for (j=0;j<B_neigs;j++) {
3627             if (eigs[j] == 0.0) {
3628               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3629             } else {
3630               if (pcbddc->use_deluxe_scaling) {
3631                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3632               } else {
3633                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3634               }
3635             }
3636           }
3637         }
3638       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3639     }
3640     /* change the basis back to the original one */
3641     if (sub_schurs->change) {
3642       Mat change,phi,phit;
3643 
3644       if (pcbddc->dbg_flag > 2) {
3645         PetscInt ii;
3646         for (ii=0;ii<B_neigs;ii++) {
3647           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3648           for (j=0;j<B_N;j++) {
3649 #if defined(PETSC_USE_COMPLEX)
3650             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3651             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3652             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3653 #else
3654             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3655 #endif
3656           }
3657         }
3658       }
3659       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3660       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3661       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3662       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3663       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3664       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3665     }
3666     maxneigs = PetscMax(B_neigs,maxneigs);
3667     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3668     if (B_neigs) {
3669       ierr = PetscArraycpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size);CHKERRQ(ierr);
3670 
3671       if (pcbddc->dbg_flag > 1) {
3672         PetscInt ii;
3673         for (ii=0;ii<B_neigs;ii++) {
3674           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3675           for (j=0;j<B_N;j++) {
3676 #if defined(PETSC_USE_COMPLEX)
3677             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3678             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3679             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3680 #else
3681             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3682 #endif
3683           }
3684         }
3685       }
3686       ierr = PetscArraycpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size);CHKERRQ(ierr);
3687       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3688       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3689       cum++;
3690     }
3691     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3692     /* shift for next computation */
3693     cumarray += subset_size*subset_size;
3694   }
3695   if (pcbddc->dbg_flag) {
3696     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3697   }
3698 
3699   if (mss) {
3700     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3701     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3702     /* destroy matrices (junk) */
3703     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3704     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3705   }
3706   if (allocated_S_St) {
3707     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3708   }
3709   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3710 #if defined(PETSC_USE_COMPLEX)
3711   ierr = PetscFree(rwork);CHKERRQ(ierr);
3712 #endif
3713   if (pcbddc->dbg_flag) {
3714     PetscInt maxneigs_r;
3715     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
3716     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %D\n",maxneigs_r);CHKERRQ(ierr);
3717   }
3718   ierr = PetscLogEventEnd(PC_BDDC_AdaptiveSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3719   PetscFunctionReturn(0);
3720 }
3721 
3722 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3723 {
3724   PetscScalar    *coarse_submat_vals;
3725   PetscErrorCode ierr;
3726 
3727   PetscFunctionBegin;
3728   /* Setup local scatters R_to_B and (optionally) R_to_D */
3729   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3730   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3731 
3732   /* Setup local neumann solver ksp_R */
3733   /* PCBDDCSetUpLocalScatters should be called first! */
3734   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3735 
3736   /*
3737      Setup local correction and local part of coarse basis.
3738      Gives back the dense local part of the coarse matrix in column major ordering
3739   */
3740   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3741 
3742   /* Compute total number of coarse nodes and setup coarse solver */
3743   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3744 
3745   /* free */
3746   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3747   PetscFunctionReturn(0);
3748 }
3749 
3750 PetscErrorCode PCBDDCResetCustomization(PC pc)
3751 {
3752   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3753   PetscErrorCode ierr;
3754 
3755   PetscFunctionBegin;
3756   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3757   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3758   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3759   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3760   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3761   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3762   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3763   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3764   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3765   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3766   PetscFunctionReturn(0);
3767 }
3768 
3769 PetscErrorCode PCBDDCResetTopography(PC pc)
3770 {
3771   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3772   PetscInt       i;
3773   PetscErrorCode ierr;
3774 
3775   PetscFunctionBegin;
3776   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3777   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3778   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3779   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3780   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3781   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3782   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3783   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3784   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3785   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3786   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3787   for (i=0;i<pcbddc->n_local_subs;i++) {
3788     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3789   }
3790   pcbddc->n_local_subs = 0;
3791   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3792   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3793   pcbddc->graphanalyzed        = PETSC_FALSE;
3794   pcbddc->recompute_topography = PETSC_TRUE;
3795   pcbddc->corner_selected      = PETSC_FALSE;
3796   PetscFunctionReturn(0);
3797 }
3798 
3799 PetscErrorCode PCBDDCResetSolvers(PC pc)
3800 {
3801   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3802   PetscErrorCode ierr;
3803 
3804   PetscFunctionBegin;
3805   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3806   if (pcbddc->coarse_phi_B) {
3807     PetscScalar *array;
3808     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3809     ierr = PetscFree(array);CHKERRQ(ierr);
3810   }
3811   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3812   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3813   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3814   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3815   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3816   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3817   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3818   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3819   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3820   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3821   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3822   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3823   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3824   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3825   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3826   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3827   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3828   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3829   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3830   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3831   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3832   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3833   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3834   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3835   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3836   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3837   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3838   if (pcbddc->benign_zerodiag_subs) {
3839     PetscInt i;
3840     for (i=0;i<pcbddc->benign_n;i++) {
3841       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3842     }
3843     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3844   }
3845   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3846   PetscFunctionReturn(0);
3847 }
3848 
3849 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3850 {
3851   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3852   PC_IS          *pcis = (PC_IS*)pc->data;
3853   VecType        impVecType;
3854   PetscInt       n_constraints,n_R,old_size;
3855   PetscErrorCode ierr;
3856 
3857   PetscFunctionBegin;
3858   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3859   n_R = pcis->n - pcbddc->n_vertices;
3860   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3861   /* local work vectors (try to avoid unneeded work)*/
3862   /* R nodes */
3863   old_size = -1;
3864   if (pcbddc->vec1_R) {
3865     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3866   }
3867   if (n_R != old_size) {
3868     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3869     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3870     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3871     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3872     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3873     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3874   }
3875   /* local primal dofs */
3876   old_size = -1;
3877   if (pcbddc->vec1_P) {
3878     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3879   }
3880   if (pcbddc->local_primal_size != old_size) {
3881     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3882     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3883     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3884     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3885   }
3886   /* local explicit constraints */
3887   old_size = -1;
3888   if (pcbddc->vec1_C) {
3889     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3890   }
3891   if (n_constraints && n_constraints != old_size) {
3892     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3893     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3894     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3895     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3896   }
3897   PetscFunctionReturn(0);
3898 }
3899 
3900 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3901 {
3902   PetscErrorCode  ierr;
3903   /* pointers to pcis and pcbddc */
3904   PC_IS*          pcis = (PC_IS*)pc->data;
3905   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3906   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3907   /* submatrices of local problem */
3908   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3909   /* submatrices of local coarse problem */
3910   Mat             S_VV,S_CV,S_VC,S_CC;
3911   /* working matrices */
3912   Mat             C_CR;
3913   /* additional working stuff */
3914   PC              pc_R;
3915   Mat             F,Brhs = NULL;
3916   Vec             dummy_vec;
3917   PetscBool       isLU,isCHOL,need_benign_correction,sparserhs;
3918   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3919   PetscScalar     *work;
3920   PetscInt        *idx_V_B;
3921   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3922   PetscInt        i,n_R,n_D,n_B;
3923   PetscScalar     one=1.0,m_one=-1.0;
3924 
3925   PetscFunctionBegin;
3926   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");
3927   ierr = PetscLogEventBegin(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
3928 
3929   /* Set Non-overlapping dimensions */
3930   n_vertices = pcbddc->n_vertices;
3931   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3932   n_B = pcis->n_B;
3933   n_D = pcis->n - n_B;
3934   n_R = pcis->n - n_vertices;
3935 
3936   /* vertices in boundary numbering */
3937   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3938   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3939   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",n_vertices,i);
3940 
3941   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3942   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3943   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3944   ierr = MatDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3945   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3946   ierr = MatDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3947   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3948   ierr = MatDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3949   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3950   ierr = MatDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3951 
3952   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3953   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3954   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3955   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3956   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3957   lda_rhs = n_R;
3958   need_benign_correction = PETSC_FALSE;
3959   if (isLU || isCHOL) {
3960     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3961   } else if (sub_schurs && sub_schurs->reuse_solver) {
3962     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3963     MatFactorType      type;
3964 
3965     F = reuse_solver->F;
3966     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3967     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3968     if (type == MAT_FACTOR_LU) isLU = PETSC_TRUE;
3969     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3970     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3971   } else F = NULL;
3972 
3973   /* determine if we can use a sparse right-hand side */
3974   sparserhs = PETSC_FALSE;
3975   if (F) {
3976     MatSolverType solver;
3977 
3978     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3979     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3980   }
3981 
3982   /* allocate workspace */
3983   n = 0;
3984   if (n_constraints) {
3985     n += lda_rhs*n_constraints;
3986   }
3987   if (n_vertices) {
3988     n = PetscMax(2*lda_rhs*n_vertices,n);
3989     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3990   }
3991   if (!pcbddc->symmetric_primal) {
3992     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3993   }
3994   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3995 
3996   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3997   dummy_vec = NULL;
3998   if (need_benign_correction && lda_rhs != n_R && F) {
3999     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&dummy_vec);CHKERRQ(ierr);
4000     ierr = VecSetSizes(dummy_vec,lda_rhs,PETSC_DECIDE);CHKERRQ(ierr);
4001     ierr = VecSetType(dummy_vec,((PetscObject)pcis->vec1_N)->type_name);CHKERRQ(ierr);
4002   }
4003 
4004   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
4005   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
4006 
4007   /* Precompute stuffs needed for preprocessing and application of BDDC*/
4008   if (n_constraints) {
4009     Mat         M3,C_B;
4010     IS          is_aux;
4011     PetscScalar *array,*array2;
4012 
4013     /* Extract constraints on R nodes: C_{CR}  */
4014     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
4015     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
4016     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4017 
4018     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
4019     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
4020     if (!sparserhs) {
4021       ierr = PetscArrayzero(work,lda_rhs*n_constraints);CHKERRQ(ierr);
4022       for (i=0;i<n_constraints;i++) {
4023         const PetscScalar *row_cmat_values;
4024         const PetscInt    *row_cmat_indices;
4025         PetscInt          size_of_constraint,j;
4026 
4027         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4028         for (j=0;j<size_of_constraint;j++) {
4029           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
4030         }
4031         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
4032       }
4033       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
4034     } else {
4035       Mat tC_CR;
4036 
4037       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4038       if (lda_rhs != n_R) {
4039         PetscScalar *aa;
4040         PetscInt    r,*ii,*jj;
4041         PetscBool   done;
4042 
4043         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4044         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4045         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
4046         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
4047         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4048         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4049       } else {
4050         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
4051         tC_CR = C_CR;
4052       }
4053       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
4054       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
4055     }
4056     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
4057     if (F) {
4058       if (need_benign_correction) {
4059         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4060 
4061         /* rhs is already zero on interior dofs, no need to change the rhs */
4062         ierr = PetscArrayzero(reuse_solver->benign_save_vals,pcbddc->benign_n);CHKERRQ(ierr);
4063       }
4064       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
4065       if (need_benign_correction) {
4066         PetscScalar        *marr;
4067         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4068 
4069         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4070         if (lda_rhs != n_R) {
4071           for (i=0;i<n_constraints;i++) {
4072             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4073             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4074             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4075           }
4076         } else {
4077           for (i=0;i<n_constraints;i++) {
4078             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4079             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4080             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4081           }
4082         }
4083         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4084       }
4085     } else {
4086       PetscScalar *marr;
4087 
4088       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4089       for (i=0;i<n_constraints;i++) {
4090         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4091         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
4092         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4093         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4094         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4095         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4096       }
4097       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
4098     }
4099     if (sparserhs) {
4100       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
4101     }
4102     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4103     if (!pcbddc->switch_static) {
4104       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4105       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4106       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4107       for (i=0;i<n_constraints;i++) {
4108         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
4109         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
4110         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4111         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4112         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4113         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4114       }
4115       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
4116       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
4117       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4118     } else {
4119       if (lda_rhs != n_R) {
4120         IS dummy;
4121 
4122         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
4123         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4124         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
4125       } else {
4126         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
4127         pcbddc->local_auxmat2 = local_auxmat2_R;
4128       }
4129       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
4130     }
4131     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4132     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR})^{-1}  */
4133     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
4134     if (isCHOL) {
4135       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
4136     } else {
4137       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
4138     }
4139     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
4140     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
4141     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4142     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4143     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
4144     ierr = MatDestroy(&M3);CHKERRQ(ierr);
4145   }
4146 
4147   /* Get submatrices from subdomain matrix */
4148   if (n_vertices) {
4149 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4150     PetscBool oldpin;
4151 #endif
4152     PetscBool isaij;
4153     IS        is_aux;
4154 
4155     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4156       IS tis;
4157 
4158       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4159       ierr = ISSort(tis);CHKERRQ(ierr);
4160       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4161       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4162     } else {
4163       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4164     }
4165 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4166     oldpin = pcbddc->local_mat->boundtocpu;
4167 #endif
4168     ierr = MatBindToCPU(pcbddc->local_mat,PETSC_TRUE);CHKERRQ(ierr);
4169     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4170     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4171     ierr = PetscObjectBaseTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isaij);CHKERRQ(ierr);
4172     if (!isaij) { /* TODO REMOVE: MatMatMult(A_VR,A_RRmA_RV) below may raise an error */
4173       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4174     }
4175     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4176 #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA)
4177     ierr = MatBindToCPU(pcbddc->local_mat,oldpin);CHKERRQ(ierr);
4178 #endif
4179     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4180   }
4181 
4182   /* Matrix of coarse basis functions (local) */
4183   if (pcbddc->coarse_phi_B) {
4184     PetscInt on_B,on_primal,on_D=n_D;
4185     if (pcbddc->coarse_phi_D) {
4186       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4187     }
4188     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4189     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4190       PetscScalar *marray;
4191 
4192       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4193       ierr = PetscFree(marray);CHKERRQ(ierr);
4194       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4195       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4196       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4197       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4198     }
4199   }
4200 
4201   if (!pcbddc->coarse_phi_B) {
4202     PetscScalar *marr;
4203 
4204     /* memory size */
4205     n = n_B*pcbddc->local_primal_size;
4206     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4207     if (!pcbddc->symmetric_primal) n *= 2;
4208     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4209     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4210     marr += n_B*pcbddc->local_primal_size;
4211     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4212       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4213       marr += n_D*pcbddc->local_primal_size;
4214     }
4215     if (!pcbddc->symmetric_primal) {
4216       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4217       marr += n_B*pcbddc->local_primal_size;
4218       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4219         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4220       }
4221     } else {
4222       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4223       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4224       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4225         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4226         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4227       }
4228     }
4229   }
4230 
4231   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4232   p0_lidx_I = NULL;
4233   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4234     const PetscInt *idxs;
4235 
4236     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4237     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4238     for (i=0;i<pcbddc->benign_n;i++) {
4239       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4240     }
4241     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4242   }
4243 
4244   /* vertices */
4245   if (n_vertices) {
4246     PetscBool restoreavr = PETSC_FALSE;
4247 
4248     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4249 
4250     if (n_R) {
4251       Mat               A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4252       PetscBLASInt      B_N,B_one = 1;
4253       const PetscScalar *x;
4254       PetscScalar       *y;
4255 
4256       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4257       if (need_benign_correction) {
4258         ISLocalToGlobalMapping RtoN;
4259         IS                     is_p0;
4260         PetscInt               *idxs_p0,n;
4261 
4262         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4263         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4264         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4265         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %D != %D",n,pcbddc->benign_n);
4266         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4267         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4268         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4269         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4270       }
4271 
4272       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4273       if (!sparserhs || need_benign_correction) {
4274         if (lda_rhs == n_R) {
4275           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4276         } else {
4277           PetscScalar    *av,*array;
4278           const PetscInt *xadj,*adjncy;
4279           PetscInt       n;
4280           PetscBool      flg_row;
4281 
4282           array = work+lda_rhs*n_vertices;
4283           ierr = PetscArrayzero(array,lda_rhs*n_vertices);CHKERRQ(ierr);
4284           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4285           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4286           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4287           for (i=0;i<n;i++) {
4288             PetscInt j;
4289             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4290           }
4291           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4292           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4293           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4294         }
4295         if (need_benign_correction) {
4296           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4297           PetscScalar        *marr;
4298 
4299           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4300           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4301 
4302                  | 0 0  0 | (V)
4303              L = | 0 0 -1 | (P-p0)
4304                  | 0 0 -1 | (p0)
4305 
4306           */
4307           for (i=0;i<reuse_solver->benign_n;i++) {
4308             const PetscScalar *vals;
4309             const PetscInt    *idxs,*idxs_zero;
4310             PetscInt          n,j,nz;
4311 
4312             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4313             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4314             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4315             for (j=0;j<n;j++) {
4316               PetscScalar val = vals[j];
4317               PetscInt    k,col = idxs[j];
4318               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4319             }
4320             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4321             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4322           }
4323           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4324         }
4325         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4326         Brhs = A_RV;
4327       } else {
4328         Mat tA_RVT,A_RVT;
4329 
4330         if (!pcbddc->symmetric_primal) {
4331           /* A_RV already scaled by -1 */
4332           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4333         } else {
4334           restoreavr = PETSC_TRUE;
4335           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4336           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4337           A_RVT = A_VR;
4338         }
4339         if (lda_rhs != n_R) {
4340           PetscScalar *aa;
4341           PetscInt    r,*ii,*jj;
4342           PetscBool   done;
4343 
4344           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4345           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4346           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4347           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4348           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4349           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4350         } else {
4351           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4352           tA_RVT = A_RVT;
4353         }
4354         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4355         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4356         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4357       }
4358       if (F) {
4359         /* need to correct the rhs */
4360         if (need_benign_correction) {
4361           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4362           PetscScalar        *marr;
4363 
4364           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4365           if (lda_rhs != n_R) {
4366             for (i=0;i<n_vertices;i++) {
4367               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4368               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4369               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4370             }
4371           } else {
4372             for (i=0;i<n_vertices;i++) {
4373               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4374               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4375               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4376             }
4377           }
4378           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4379         }
4380         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4381         if (restoreavr) {
4382           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4383         }
4384         /* need to correct the solution */
4385         if (need_benign_correction) {
4386           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4387           PetscScalar        *marr;
4388 
4389           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4390           if (lda_rhs != n_R) {
4391             for (i=0;i<n_vertices;i++) {
4392               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4393               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4394               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4395             }
4396           } else {
4397             for (i=0;i<n_vertices;i++) {
4398               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4399               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4400               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4401             }
4402           }
4403           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4404         }
4405       } else {
4406         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4407         for (i=0;i<n_vertices;i++) {
4408           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4409           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4410           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4411           ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4412           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4413           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4414         }
4415         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4416       }
4417       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4418       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4419       /* S_VV and S_CV */
4420       if (n_constraints) {
4421         Mat B;
4422 
4423         ierr = PetscArrayzero(work+lda_rhs*n_vertices,n_B*n_vertices);CHKERRQ(ierr);
4424         for (i=0;i<n_vertices;i++) {
4425           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4426           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4427           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4428           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4429           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4430           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4431         }
4432         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4433         /* Reuse dense S_C = pcbddc->local_auxmat1 * B */
4434         ierr = MatProductCreateWithMat(pcbddc->local_auxmat1,B,NULL,S_CV);CHKERRQ(ierr);
4435         ierr = MatProductSetType(S_CV,MATPRODUCT_AB);CHKERRQ(ierr);
4436         ierr = MatProductSetFromOptions(S_CV);CHKERRQ(ierr);
4437         ierr = MatProductSymbolic(S_CV);CHKERRQ(ierr);
4438         ierr = MatProductNumeric(S_CV);CHKERRQ(ierr);
4439         ierr = MatProductClear(S_CV);CHKERRQ(ierr);
4440 
4441         ierr = MatDestroy(&B);CHKERRQ(ierr);
4442         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4443         /* Reuse B = local_auxmat2_R * S_CV */
4444         ierr = MatProductCreateWithMat(local_auxmat2_R,S_CV,NULL,B);CHKERRQ(ierr);
4445         ierr = MatProductSetType(B,MATPRODUCT_AB);CHKERRQ(ierr);
4446         ierr = MatProductSetFromOptions(B);CHKERRQ(ierr);
4447         ierr = MatProductSymbolic(B);CHKERRQ(ierr);
4448         ierr = MatProductNumeric(B);CHKERRQ(ierr);
4449 
4450         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4451         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4452         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4453         ierr = MatDestroy(&B);CHKERRQ(ierr);
4454       }
4455       if (lda_rhs != n_R) {
4456         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4457         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4458         ierr = MatDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4459       }
4460       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4461       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4462       if (need_benign_correction) {
4463         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4464         PetscScalar        *marr,*sums;
4465 
4466         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4467         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4468         for (i=0;i<reuse_solver->benign_n;i++) {
4469           const PetscScalar *vals;
4470           const PetscInt    *idxs,*idxs_zero;
4471           PetscInt          n,j,nz;
4472 
4473           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4474           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4475           for (j=0;j<n_vertices;j++) {
4476             PetscInt k;
4477             sums[j] = 0.;
4478             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4479           }
4480           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4481           for (j=0;j<n;j++) {
4482             PetscScalar val = vals[j];
4483             PetscInt k;
4484             for (k=0;k<n_vertices;k++) {
4485               marr[idxs[j]+k*n_vertices] += val*sums[k];
4486             }
4487           }
4488           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4489           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4490         }
4491         ierr = PetscFree(sums);CHKERRQ(ierr);
4492         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4493         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4494       }
4495       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4496       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4497       ierr = MatDenseGetArrayRead(A_VV,&x);CHKERRQ(ierr);
4498       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4499       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4500       ierr = MatDenseRestoreArrayRead(A_VV,&x);CHKERRQ(ierr);
4501       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4502       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4503       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4504     } else {
4505       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4506     }
4507     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4508 
4509     /* coarse basis functions */
4510     for (i=0;i<n_vertices;i++) {
4511       PetscScalar *y;
4512 
4513       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4514       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4515       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4516       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4517       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4518       y[n_B*i+idx_V_B[i]] = 1.0;
4519       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4520       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4521 
4522       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4523         PetscInt j;
4524 
4525         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4526         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4527         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4528         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4529         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4530         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4531         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4532       }
4533       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4534     }
4535     /* if n_R == 0 the object is not destroyed */
4536     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4537   }
4538   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4539 
4540   if (n_constraints) {
4541     Mat B;
4542 
4543     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4544     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4545     ierr = MatProductCreateWithMat(local_auxmat2_R,S_CC,NULL,B);CHKERRQ(ierr);
4546     ierr = MatProductSetType(B,MATPRODUCT_AB);CHKERRQ(ierr);
4547     ierr = MatProductSetFromOptions(B);CHKERRQ(ierr);
4548     ierr = MatProductSymbolic(B);CHKERRQ(ierr);
4549     ierr = MatProductNumeric(B);CHKERRQ(ierr);
4550 
4551     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4552     if (n_vertices) {
4553       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4554         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4555       } else {
4556         Mat S_VCt;
4557 
4558         if (lda_rhs != n_R) {
4559           ierr = MatDestroy(&B);CHKERRQ(ierr);
4560           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4561           ierr = MatDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4562         }
4563         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4564         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4565         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4566       }
4567     }
4568     ierr = MatDestroy(&B);CHKERRQ(ierr);
4569     /* coarse basis functions */
4570     for (i=0;i<n_constraints;i++) {
4571       PetscScalar *y;
4572 
4573       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4574       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4575       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4576       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4577       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4578       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4579       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4580       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4581         PetscInt j;
4582 
4583         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4584         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4585         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4586         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4587         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4588         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4589         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4590       }
4591       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4592     }
4593   }
4594   if (n_constraints) {
4595     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4596   }
4597   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4598 
4599   /* coarse matrix entries relative to B_0 */
4600   if (pcbddc->benign_n) {
4601     Mat               B0_B,B0_BPHI;
4602     IS                is_dummy;
4603     const PetscScalar *data;
4604     PetscInt          j;
4605 
4606     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4607     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4608     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4609     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4610     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4611     ierr = MatDenseGetArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4612     for (j=0;j<pcbddc->benign_n;j++) {
4613       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4614       for (i=0;i<pcbddc->local_primal_size;i++) {
4615         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4616         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4617       }
4618     }
4619     ierr = MatDenseRestoreArrayRead(B0_BPHI,&data);CHKERRQ(ierr);
4620     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4621     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4622   }
4623 
4624   /* compute other basis functions for non-symmetric problems */
4625   if (!pcbddc->symmetric_primal) {
4626     Mat         B_V=NULL,B_C=NULL;
4627     PetscScalar *marray;
4628 
4629     if (n_constraints) {
4630       Mat S_CCT,C_CRT;
4631 
4632       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4633       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4634       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4635       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4636       if (n_vertices) {
4637         Mat S_VCT;
4638 
4639         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4640         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4641         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4642       }
4643       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4644     } else {
4645       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4646     }
4647     if (n_vertices && n_R) {
4648       PetscScalar    *av,*marray;
4649       const PetscInt *xadj,*adjncy;
4650       PetscInt       n;
4651       PetscBool      flg_row;
4652 
4653       /* B_V = B_V - A_VR^T */
4654       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4655       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4656       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4657       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4658       for (i=0;i<n;i++) {
4659         PetscInt j;
4660         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4661       }
4662       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4663       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4664       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4665     }
4666 
4667     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4668     if (n_vertices) {
4669       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4670       for (i=0;i<n_vertices;i++) {
4671         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4672         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4673         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4674         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4675         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4676         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4677       }
4678       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4679     }
4680     if (B_C) {
4681       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4682       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4683         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4684         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4685         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4686         ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
4687         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4688         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4689       }
4690       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4691     }
4692     /* coarse basis functions */
4693     for (i=0;i<pcbddc->local_primal_size;i++) {
4694       PetscScalar *y;
4695 
4696       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4697       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4698       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4699       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4700       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4701       if (i<n_vertices) {
4702         y[n_B*i+idx_V_B[i]] = 1.0;
4703       }
4704       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4705       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4706 
4707       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4708         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4709         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4710         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4711         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4712         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4713         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4714       }
4715       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4716     }
4717     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4718     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4719   }
4720 
4721   /* free memory */
4722   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4723   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4724   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4725   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4726   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4727   ierr = PetscFree(work);CHKERRQ(ierr);
4728   if (n_vertices) {
4729     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4730   }
4731   if (n_constraints) {
4732     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4733   }
4734   ierr = PetscLogEventEnd(PC_BDDC_CorrectionSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
4735 
4736   /* Checking coarse_sub_mat and coarse basis functios */
4737   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4738   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4739   if (pcbddc->dbg_flag) {
4740     Mat         coarse_sub_mat;
4741     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4742     Mat         coarse_phi_D,coarse_phi_B;
4743     Mat         coarse_psi_D,coarse_psi_B;
4744     Mat         A_II,A_BB,A_IB,A_BI;
4745     Mat         C_B,CPHI;
4746     IS          is_dummy;
4747     Vec         mones;
4748     MatType     checkmattype=MATSEQAIJ;
4749     PetscReal   real_value;
4750 
4751     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4752       Mat A;
4753       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4754       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4755       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4756       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4757       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4758       ierr = MatDestroy(&A);CHKERRQ(ierr);
4759     } else {
4760       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4761       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4762       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4763       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4764     }
4765     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4766     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4767     if (!pcbddc->symmetric_primal) {
4768       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4769       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4770     }
4771     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4772 
4773     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4774     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4775     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4776     if (!pcbddc->symmetric_primal) {
4777       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4778       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4779       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4780       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4781       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4782       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4783       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4784       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4785       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4786       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4787       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4788       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4789     } else {
4790       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4791       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4792       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4793       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4794       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4795       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4796       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4797       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4798     }
4799     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4800     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4801     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4802     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4803     if (pcbddc->benign_n) {
4804       Mat               B0_B,B0_BPHI;
4805       const PetscScalar *data2;
4806       PetscScalar       *data;
4807       PetscInt          j;
4808 
4809       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4810       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4811       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4812       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4813       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4814       ierr = MatDenseGetArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4815       for (j=0;j<pcbddc->benign_n;j++) {
4816         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4817         for (i=0;i<pcbddc->local_primal_size;i++) {
4818           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4819           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4820         }
4821       }
4822       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4823       ierr = MatDenseRestoreArrayRead(B0_BPHI,&data2);CHKERRQ(ierr);
4824       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4825       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4826       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4827     }
4828 #if 0
4829   {
4830     PetscViewer viewer;
4831     char filename[256];
4832     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4833     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4834     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4835     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4836     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4837     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4838     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4839     if (pcbddc->coarse_phi_B) {
4840       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4841       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4842     }
4843     if (pcbddc->coarse_phi_D) {
4844       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4845       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4846     }
4847     if (pcbddc->coarse_psi_B) {
4848       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4849       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4850     }
4851     if (pcbddc->coarse_psi_D) {
4852       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4853       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4854     }
4855     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4856     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4857     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4858     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4859     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4860     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4861     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4862     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4863     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4864     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4865     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4866   }
4867 #endif
4868     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4869     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4870     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4871     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4872 
4873     /* check constraints */
4874     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4875     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4876     if (!pcbddc->benign_n) { /* TODO: add benign case */
4877       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4878     } else {
4879       PetscScalar *data;
4880       Mat         tmat;
4881       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4882       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4883       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4884       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4885       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4886     }
4887     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4888     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4889     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4890     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4891     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4892     if (!pcbddc->symmetric_primal) {
4893       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4894       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4895       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4896       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4897       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4898     }
4899     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4900     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4901     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4902     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4903     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4904     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4905     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4906     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4907     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4908     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4909     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4910     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4911     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4912     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4913     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4914     if (!pcbddc->symmetric_primal) {
4915       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4916       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4917     }
4918     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4919   }
4920   /* FINAL CUDA support (we cannot currently mix viennacl and cuda vectors */
4921   {
4922     PetscBool gpu;
4923 
4924     ierr = PetscObjectTypeCompare((PetscObject)pcis->vec1_N,VECSEQCUDA,&gpu);CHKERRQ(ierr);
4925     if (gpu) {
4926       if (pcbddc->local_auxmat1) {
4927         ierr = MatConvert(pcbddc->local_auxmat1,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat1);CHKERRQ(ierr);
4928       }
4929       if (pcbddc->local_auxmat2) {
4930         ierr = MatConvert(pcbddc->local_auxmat2,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
4931       }
4932       if (pcbddc->coarse_phi_B) {
4933         ierr = MatConvert(pcbddc->coarse_phi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4934       }
4935       if (pcbddc->coarse_phi_D) {
4936         ierr = MatConvert(pcbddc->coarse_phi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4937       }
4938       if (pcbddc->coarse_psi_B) {
4939         ierr = MatConvert(pcbddc->coarse_psi_B,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4940       }
4941       if (pcbddc->coarse_psi_D) {
4942         ierr = MatConvert(pcbddc->coarse_psi_D,MATSEQDENSECUDA,MAT_INPLACE_MATRIX,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4943       }
4944     }
4945   }
4946   /* get back data */
4947   *coarse_submat_vals_n = coarse_submat_vals;
4948   PetscFunctionReturn(0);
4949 }
4950 
4951 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4952 {
4953   Mat            *work_mat;
4954   IS             isrow_s,iscol_s;
4955   PetscBool      rsorted,csorted;
4956   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4957   PetscErrorCode ierr;
4958 
4959   PetscFunctionBegin;
4960   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4961   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4962   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4963   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4964 
4965   if (!rsorted) {
4966     const PetscInt *idxs;
4967     PetscInt *idxs_sorted,i;
4968 
4969     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4970     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4971     for (i=0;i<rsize;i++) {
4972       idxs_perm_r[i] = i;
4973     }
4974     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4975     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4976     for (i=0;i<rsize;i++) {
4977       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4978     }
4979     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4980     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4981   } else {
4982     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4983     isrow_s = isrow;
4984   }
4985 
4986   if (!csorted) {
4987     if (isrow == iscol) {
4988       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4989       iscol_s = isrow_s;
4990     } else {
4991       const PetscInt *idxs;
4992       PetscInt       *idxs_sorted,i;
4993 
4994       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4995       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4996       for (i=0;i<csize;i++) {
4997         idxs_perm_c[i] = i;
4998       }
4999       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
5000       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
5001       for (i=0;i<csize;i++) {
5002         idxs_sorted[i] = idxs[idxs_perm_c[i]];
5003       }
5004       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
5005       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
5006     }
5007   } else {
5008     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
5009     iscol_s = iscol;
5010   }
5011 
5012   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5013 
5014   if (!rsorted || !csorted) {
5015     Mat      new_mat;
5016     IS       is_perm_r,is_perm_c;
5017 
5018     if (!rsorted) {
5019       PetscInt *idxs_r,i;
5020       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
5021       for (i=0;i<rsize;i++) {
5022         idxs_r[idxs_perm_r[i]] = i;
5023       }
5024       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
5025       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
5026     } else {
5027       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
5028     }
5029     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
5030 
5031     if (!csorted) {
5032       if (isrow_s == iscol_s) {
5033         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
5034         is_perm_c = is_perm_r;
5035       } else {
5036         PetscInt *idxs_c,i;
5037         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
5038         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
5039         for (i=0;i<csize;i++) {
5040           idxs_c[idxs_perm_c[i]] = i;
5041         }
5042         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
5043         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
5044       }
5045     } else {
5046       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
5047     }
5048     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
5049 
5050     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
5051     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
5052     work_mat[0] = new_mat;
5053     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
5054     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
5055   }
5056 
5057   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
5058   *B = work_mat[0];
5059   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
5060   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
5061   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
5062   PetscFunctionReturn(0);
5063 }
5064 
5065 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
5066 {
5067   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
5068   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
5069   Mat            new_mat,lA;
5070   IS             is_local,is_global;
5071   PetscInt       local_size;
5072   PetscBool      isseqaij;
5073   PetscErrorCode ierr;
5074 
5075   PetscFunctionBegin;
5076   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5077   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
5078   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
5079   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
5080   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
5081   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
5082   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
5083 
5084   if (pcbddc->dbg_flag) {
5085     Vec       x,x_change;
5086     PetscReal error;
5087 
5088     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
5089     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
5090     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
5091     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5092     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5093     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
5094     if (!pcbddc->change_interior) {
5095       const PetscScalar *x,*y,*v;
5096       PetscReal         lerror = 0.;
5097       PetscInt          i;
5098 
5099       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
5100       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
5101       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
5102       for (i=0;i<local_size;i++)
5103         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
5104           lerror = PetscAbsScalar(x[i]-y[i]);
5105       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
5106       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
5107       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
5108       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
5109       if (error > PETSC_SMALL) {
5110         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5111           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e",error);
5112         } else {
5113           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e",error);
5114         }
5115       }
5116     }
5117     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5118     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5119     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
5120     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
5121     if (error > PETSC_SMALL) {
5122       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
5123         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
5124       } else {
5125         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e",error);
5126       }
5127     }
5128     ierr = VecDestroy(&x);CHKERRQ(ierr);
5129     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
5130   }
5131 
5132   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
5133   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
5134 
5135   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
5136   ierr = PetscObjectBaseTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
5137   if (isseqaij) {
5138     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5139     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5140     if (lA) {
5141       Mat work;
5142       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5143       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5144       ierr = MatDestroy(&work);CHKERRQ(ierr);
5145     }
5146   } else {
5147     Mat work_mat;
5148 
5149     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5150     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5151     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
5152     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
5153     if (lA) {
5154       Mat work;
5155       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
5156       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
5157       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
5158       ierr = MatDestroy(&work);CHKERRQ(ierr);
5159     }
5160   }
5161   if (matis->A->symmetric_set) {
5162     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
5163 #if !defined(PETSC_USE_COMPLEX)
5164     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
5165 #endif
5166   }
5167   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
5168   PetscFunctionReturn(0);
5169 }
5170 
5171 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
5172 {
5173   PC_IS*          pcis = (PC_IS*)(pc->data);
5174   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
5175   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5176   PetscInt        *idx_R_local=NULL;
5177   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
5178   PetscInt        vbs,bs;
5179   PetscBT         bitmask=NULL;
5180   PetscErrorCode  ierr;
5181 
5182   PetscFunctionBegin;
5183   /*
5184     No need to setup local scatters if
5185       - primal space is unchanged
5186         AND
5187       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
5188         AND
5189       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
5190   */
5191   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
5192     PetscFunctionReturn(0);
5193   }
5194   /* destroy old objects */
5195   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
5196   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
5197   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
5198   /* Set Non-overlapping dimensions */
5199   n_B = pcis->n_B;
5200   n_D = pcis->n - n_B;
5201   n_vertices = pcbddc->n_vertices;
5202 
5203   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
5204 
5205   /* create auxiliary bitmask and allocate workspace */
5206   if (!sub_schurs || !sub_schurs->reuse_solver) {
5207     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
5208     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5209     for (i=0;i<n_vertices;i++) {
5210       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5211     }
5212 
5213     for (i=0, n_R=0; i<pcis->n; i++) {
5214       if (!PetscBTLookup(bitmask,i)) {
5215         idx_R_local[n_R++] = i;
5216       }
5217     }
5218   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5219     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5220 
5221     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5222     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5223   }
5224 
5225   /* Block code */
5226   vbs = 1;
5227   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5228   if (bs>1 && !(n_vertices%bs)) {
5229     PetscBool is_blocked = PETSC_TRUE;
5230     PetscInt  *vary;
5231     if (!sub_schurs || !sub_schurs->reuse_solver) {
5232       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5233       ierr = PetscArrayzero(vary,pcis->n/bs);CHKERRQ(ierr);
5234       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5235       /* 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 */
5236       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5237       for (i=0; i<pcis->n/bs; i++) {
5238         if (vary[i]!=0 && vary[i]!=bs) {
5239           is_blocked = PETSC_FALSE;
5240           break;
5241         }
5242       }
5243       ierr = PetscFree(vary);CHKERRQ(ierr);
5244     } else {
5245       /* Verify directly the R set */
5246       for (i=0; i<n_R/bs; i++) {
5247         PetscInt j,node=idx_R_local[bs*i];
5248         for (j=1; j<bs; j++) {
5249           if (node != idx_R_local[bs*i+j]-j) {
5250             is_blocked = PETSC_FALSE;
5251             break;
5252           }
5253         }
5254       }
5255     }
5256     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5257       vbs = bs;
5258       for (i=0;i<n_R/vbs;i++) {
5259         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5260       }
5261     }
5262   }
5263   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5264   if (sub_schurs && sub_schurs->reuse_solver) {
5265     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5266 
5267     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5268     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5269     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5270     reuse_solver->is_R = pcbddc->is_R_local;
5271   } else {
5272     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5273   }
5274 
5275   /* print some info if requested */
5276   if (pcbddc->dbg_flag) {
5277     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5278     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5279     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5280     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5281     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %D, dirichlet_size = %D, boundary_size = %D\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5282     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);
5283     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5284   }
5285 
5286   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5287   if (!sub_schurs || !sub_schurs->reuse_solver) {
5288     IS       is_aux1,is_aux2;
5289     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5290 
5291     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5292     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5293     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5294     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5295     for (i=0; i<n_D; i++) {
5296       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5297     }
5298     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5299     for (i=0, j=0; i<n_R; i++) {
5300       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5301         aux_array1[j++] = i;
5302       }
5303     }
5304     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5305     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5306     for (i=0, j=0; i<n_B; i++) {
5307       if (!PetscBTLookup(bitmask,is_indices[i])) {
5308         aux_array2[j++] = i;
5309       }
5310     }
5311     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5312     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5313     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5314     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5315     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5316 
5317     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5318       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5319       for (i=0, j=0; i<n_R; i++) {
5320         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5321           aux_array1[j++] = i;
5322         }
5323       }
5324       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5325       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5326       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5327     }
5328     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5329     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5330   } else {
5331     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5332     IS                 tis;
5333     PetscInt           schur_size;
5334 
5335     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5336     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5337     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5338     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5339     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5340       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5341       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5342       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5343     }
5344   }
5345   PetscFunctionReturn(0);
5346 }
5347 
5348 static PetscErrorCode MatNullSpacePropagateAny_Private(Mat A, IS is, Mat B)
5349 {
5350   MatNullSpace   NullSpace;
5351   Mat            dmat;
5352   const Vec      *nullvecs;
5353   Vec            v,v2,*nullvecs2;
5354   VecScatter     sct = NULL;
5355   PetscContainer c;
5356   PetscScalar    *ddata;
5357   PetscInt       k,nnsp_size,bsiz,bsiz2,n,N,bs;
5358   PetscBool      nnsp_has_cnst;
5359   PetscErrorCode ierr;
5360 
5361   PetscFunctionBegin;
5362   if (!is && !B) { /* MATIS */
5363     Mat_IS* matis = (Mat_IS*)A->data;
5364 
5365     if (!B) {
5366       ierr = MatISGetLocalMat(A,&B);CHKERRQ(ierr);
5367     }
5368     sct  = matis->cctx;
5369     ierr = PetscObjectReference((PetscObject)sct);CHKERRQ(ierr);
5370   } else {
5371     ierr = MatGetNullSpace(B,&NullSpace);CHKERRQ(ierr);
5372     if (!NullSpace) {
5373       ierr = MatGetNearNullSpace(B,&NullSpace);CHKERRQ(ierr);
5374     }
5375     if (NullSpace) PetscFunctionReturn(0);
5376   }
5377   ierr = MatGetNullSpace(A,&NullSpace);CHKERRQ(ierr);
5378   if (!NullSpace) {
5379     ierr = MatGetNearNullSpace(A,&NullSpace);CHKERRQ(ierr);
5380   }
5381   if (!NullSpace) PetscFunctionReturn(0);
5382 
5383   ierr = MatCreateVecs(A,&v,NULL);CHKERRQ(ierr);
5384   ierr = MatCreateVecs(B,&v2,NULL);CHKERRQ(ierr);
5385   if (!sct) {
5386     ierr = VecScatterCreate(v,is,v2,NULL,&sct);CHKERRQ(ierr);
5387   }
5388   ierr = MatNullSpaceGetVecs(NullSpace,&nnsp_has_cnst,&nnsp_size,(const Vec**)&nullvecs);CHKERRQ(ierr);
5389   bsiz = bsiz2 = nnsp_size+!!nnsp_has_cnst;
5390   ierr = PetscMalloc1(bsiz,&nullvecs2);CHKERRQ(ierr);
5391   ierr = VecGetBlockSize(v2,&bs);CHKERRQ(ierr);
5392   ierr = VecGetSize(v2,&N);CHKERRQ(ierr);
5393   ierr = VecGetLocalSize(v2,&n);CHKERRQ(ierr);
5394   ierr = PetscMalloc1(n*bsiz,&ddata);CHKERRQ(ierr);
5395   for (k=0;k<nnsp_size;k++) {
5396     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*k,&nullvecs2[k]);CHKERRQ(ierr);
5397     ierr = VecScatterBegin(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5398     ierr = VecScatterEnd(sct,nullvecs[k],nullvecs2[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5399   }
5400   if (nnsp_has_cnst) {
5401     ierr = VecCreateMPIWithArray(PetscObjectComm((PetscObject)B),bs,n,N,ddata + n*nnsp_size,&nullvecs2[nnsp_size]);CHKERRQ(ierr);
5402     ierr = VecSet(nullvecs2[nnsp_size],1.0);CHKERRQ(ierr);
5403   }
5404   ierr = PCBDDCOrthonormalizeVecs(&bsiz2,nullvecs2);CHKERRQ(ierr);
5405   ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)B),PETSC_FALSE,bsiz2,nullvecs2,&NullSpace);CHKERRQ(ierr);
5406 
5407   ierr = MatCreateDense(PetscObjectComm((PetscObject)B),n,PETSC_DECIDE,N,bsiz2,ddata,&dmat);CHKERRQ(ierr);
5408   ierr = PetscContainerCreate(PetscObjectComm((PetscObject)B),&c);CHKERRQ(ierr);
5409   ierr = PetscContainerSetPointer(c,ddata);CHKERRQ(ierr);
5410   ierr = PetscContainerSetUserDestroy(c,PetscContainerUserDestroyDefault);CHKERRQ(ierr);
5411   ierr = PetscObjectCompose((PetscObject)dmat,"_PBDDC_Null_dmat_arr",(PetscObject)c);CHKERRQ(ierr);
5412   ierr = PetscContainerDestroy(&c);CHKERRQ(ierr);
5413   ierr = PetscObjectCompose((PetscObject)NullSpace,"_PBDDC_Null_dmat",(PetscObject)dmat);CHKERRQ(ierr);
5414   ierr = MatDestroy(&dmat);CHKERRQ(ierr);
5415 
5416   for (k=0;k<bsiz;k++) {
5417     ierr = VecDestroy(&nullvecs2[k]);CHKERRQ(ierr);
5418   }
5419   ierr = PetscFree(nullvecs2);CHKERRQ(ierr);
5420   ierr = MatSetNearNullSpace(B,NullSpace);CHKERRQ(ierr);
5421   ierr = MatNullSpaceDestroy(&NullSpace);CHKERRQ(ierr);
5422   ierr = VecDestroy(&v);CHKERRQ(ierr);
5423   ierr = VecDestroy(&v2);CHKERRQ(ierr);
5424   ierr = VecScatterDestroy(&sct);CHKERRQ(ierr);
5425   PetscFunctionReturn(0);
5426 }
5427 
5428 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5429 {
5430   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5431   PC_IS          *pcis = (PC_IS*)pc->data;
5432   PC             pc_temp;
5433   Mat            A_RR;
5434   MatNullSpace   nnsp;
5435   MatReuse       reuse;
5436   PetscScalar    m_one = -1.0;
5437   PetscReal      value;
5438   PetscInt       n_D,n_R;
5439   PetscBool      issbaij,opts;
5440   PetscErrorCode ierr;
5441   void           (*f)(void) = NULL;
5442   char           dir_prefix[256],neu_prefix[256],str_level[16];
5443   size_t         len;
5444 
5445   PetscFunctionBegin;
5446   ierr = PetscLogEventBegin(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5447   /* approximate solver, propagate NearNullSpace if needed */
5448   if (!pc->setupcalled && (pcbddc->NullSpace_corr[0] || pcbddc->NullSpace_corr[2])) {
5449     MatNullSpace gnnsp1,gnnsp2;
5450     PetscBool    lhas,ghas;
5451 
5452     ierr = MatGetNearNullSpace(pcbddc->local_mat,&nnsp);CHKERRQ(ierr);
5453     ierr = MatGetNearNullSpace(pc->pmat,&gnnsp1);CHKERRQ(ierr);
5454     ierr = MatGetNullSpace(pc->pmat,&gnnsp2);CHKERRQ(ierr);
5455     lhas = nnsp ? PETSC_TRUE : PETSC_FALSE;
5456     ierr = MPIU_Allreduce(&lhas,&ghas,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
5457     if (!ghas && (gnnsp1 || gnnsp2)) {
5458       ierr = MatNullSpacePropagateAny_Private(pc->pmat,NULL,NULL);CHKERRQ(ierr);
5459     }
5460   }
5461 
5462   /* compute prefixes */
5463   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5464   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5465   if (!pcbddc->current_level) {
5466     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5467     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5468     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5469     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5470   } else {
5471     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5472     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5473     len -= 15; /* remove "pc_bddc_coarse_" */
5474     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5475     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5476     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5477     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5478     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5479     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5480     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5481     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5482     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5483   }
5484 
5485   /* DIRICHLET PROBLEM */
5486   if (dirichlet) {
5487     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5488     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5489       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
5490       if (pcbddc->dbg_flag) {
5491         Mat    A_IIn;
5492 
5493         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5494         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5495         pcis->A_II = A_IIn;
5496       }
5497     }
5498     if (pcbddc->local_mat->symmetric_set) {
5499       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5500     }
5501     /* Matrix for Dirichlet problem is pcis->A_II */
5502     n_D  = pcis->n - pcis->n_B;
5503     opts = PETSC_FALSE;
5504     if (!pcbddc->ksp_D) { /* create object if not yet build */
5505       opts = PETSC_TRUE;
5506       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5507       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5508       /* default */
5509       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5510       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5511       ierr = PetscObjectTypeCompare((PetscObject)pcis->pA_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5512       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5513       if (issbaij) {
5514         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5515       } else {
5516         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5517       }
5518       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_D,pc->erroriffailure);CHKERRQ(ierr);
5519     }
5520     ierr = MatSetOptionsPrefix(pcis->pA_II,((PetscObject)pcbddc->ksp_D)->prefix);CHKERRQ(ierr);
5521     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->pA_II);CHKERRQ(ierr);
5522     /* Allow user's customization */
5523     if (opts) {
5524       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5525     }
5526     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5527     if (pcbddc->NullSpace_corr[0] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5528       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcis->is_I_local,pcis->pA_II);CHKERRQ(ierr);
5529     }
5530     ierr = MatGetNearNullSpace(pcis->pA_II,&nnsp);CHKERRQ(ierr);
5531     ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5532     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5533     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5534       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5535       const PetscInt *idxs;
5536       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5537 
5538       ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5539       ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5540       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5541       for (i=0;i<nl;i++) {
5542         for (d=0;d<cdim;d++) {
5543           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5544         }
5545       }
5546       ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5547       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5548       ierr = PetscFree(scoords);CHKERRQ(ierr);
5549     }
5550     if (sub_schurs && sub_schurs->reuse_solver) {
5551       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5552 
5553       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5554     }
5555 
5556     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5557     if (!n_D) {
5558       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5559       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5560     }
5561     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
5562     /* set ksp_D into pcis data */
5563     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5564     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5565     pcis->ksp_D = pcbddc->ksp_D;
5566   }
5567 
5568   /* NEUMANN PROBLEM */
5569   A_RR = NULL;
5570   if (neumann) {
5571     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5572     PetscInt        ibs,mbs;
5573     PetscBool       issbaij, reuse_neumann_solver;
5574     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5575 
5576     reuse_neumann_solver = PETSC_FALSE;
5577     if (sub_schurs && sub_schurs->reuse_solver) {
5578       IS iP;
5579 
5580       reuse_neumann_solver = PETSC_TRUE;
5581       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5582       if (iP) reuse_neumann_solver = PETSC_FALSE;
5583     }
5584     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5585     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5586     if (pcbddc->ksp_R) { /* already created ksp */
5587       PetscInt nn_R;
5588       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5589       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5590       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5591       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5592         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5593         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5594         reuse = MAT_INITIAL_MATRIX;
5595       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5596         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5597           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5598           reuse = MAT_INITIAL_MATRIX;
5599         } else { /* safe to reuse the matrix */
5600           reuse = MAT_REUSE_MATRIX;
5601         }
5602       }
5603       /* last check */
5604       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5605         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5606         reuse = MAT_INITIAL_MATRIX;
5607       }
5608     } else { /* first time, so we need to create the matrix */
5609       reuse = MAT_INITIAL_MATRIX;
5610     }
5611     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection
5612        TODO: Get Rid of these conversions */
5613     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5614     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5615     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5616     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5617       if (matis->A == pcbddc->local_mat) {
5618         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5619         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5620       } else {
5621         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5622       }
5623     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5624       if (matis->A == pcbddc->local_mat) {
5625         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5626         ierr = MatConvert(matis->A,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5627       } else {
5628         ierr = MatConvert(pcbddc->local_mat,mbs > 1 ? MATSEQBAIJ : MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5629       }
5630     }
5631     /* extract A_RR */
5632     if (reuse_neumann_solver) {
5633       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5634 
5635       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5636         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5637         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5638           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5639         } else {
5640           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5641         }
5642       } else {
5643         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5644         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5645         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5646       }
5647     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5648       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5649     }
5650     if (pcbddc->local_mat->symmetric_set) {
5651       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric);CHKERRQ(ierr);
5652     }
5653     opts = PETSC_FALSE;
5654     if (!pcbddc->ksp_R) { /* create object if not present */
5655       opts = PETSC_TRUE;
5656       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5657       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5658       /* default */
5659       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5660       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5661       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5662       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5663       if (issbaij) {
5664         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5665       } else {
5666         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5667       }
5668       ierr = KSPSetErrorIfNotConverged(pcbddc->ksp_R,pc->erroriffailure);CHKERRQ(ierr);
5669     }
5670     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5671     ierr = MatSetOptionsPrefix(A_RR,((PetscObject)pcbddc->ksp_R)->prefix);CHKERRQ(ierr);
5672     if (opts) { /* Allow user's customization once */
5673       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5674     }
5675     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5676     if (pcbddc->NullSpace_corr[2] && !nnsp) { /* approximate solver, propagate NearNullSpace */
5677       ierr = MatNullSpacePropagateAny_Private(pcbddc->local_mat,pcbddc->is_R_local,A_RR);CHKERRQ(ierr);
5678     }
5679     ierr = MatGetNearNullSpace(A_RR,&nnsp);CHKERRQ(ierr);
5680     ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5681     ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5682     if (f && pcbddc->mat_graph->cloc && !nnsp) {
5683       PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5684       const PetscInt *idxs;
5685       PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5686 
5687       ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5688       ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5689       ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5690       for (i=0;i<nl;i++) {
5691         for (d=0;d<cdim;d++) {
5692           scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5693         }
5694       }
5695       ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5696       ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5697       ierr = PetscFree(scoords);CHKERRQ(ierr);
5698     }
5699 
5700     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5701     if (!n_R) {
5702       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5703       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5704     }
5705     /* Reuse solver if it is present */
5706     if (reuse_neumann_solver) {
5707       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5708 
5709       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5710     }
5711     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
5712   }
5713 
5714   if (pcbddc->dbg_flag) {
5715     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5716     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5717     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5718   }
5719   ierr = PetscLogEventEnd(PC_BDDC_LocalSolvers[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
5720 
5721   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5722   if (pcbddc->NullSpace_corr[0]) {
5723     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5724   }
5725   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5726     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5727   }
5728   if (neumann && pcbddc->NullSpace_corr[2]) {
5729     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5730   }
5731   /* check Dirichlet and Neumann solvers */
5732   if (pcbddc->dbg_flag) {
5733     if (dirichlet) { /* Dirichlet */
5734       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5735       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5736       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5737       ierr = KSPCheckSolve(pcbddc->ksp_D,pc,pcis->vec2_D);CHKERRQ(ierr);
5738       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5739       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5740       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);
5741       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5742     }
5743     if (neumann) { /* Neumann */
5744       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5745       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5746       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5747       ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec2_R);CHKERRQ(ierr);
5748       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5749       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5750       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);
5751       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5752     }
5753   }
5754   /* free Neumann problem's matrix */
5755   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5756   PetscFunctionReturn(0);
5757 }
5758 
5759 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5760 {
5761   PetscErrorCode  ierr;
5762   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5763   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5764   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE) : PETSC_FALSE;
5765 
5766   PetscFunctionBegin;
5767   if (!reuse_solver) {
5768     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5769   }
5770   if (!pcbddc->switch_static) {
5771     if (applytranspose && pcbddc->local_auxmat1) {
5772       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5773       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5774     }
5775     if (!reuse_solver) {
5776       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5777       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5778     } else {
5779       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5780 
5781       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5782       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5783     }
5784   } else {
5785     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5786     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5787     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5788     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5789     if (applytranspose && pcbddc->local_auxmat1) {
5790       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5791       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5792       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5793       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5794     }
5795   }
5796   ierr = PetscLogEventBegin(PC_BDDC_Solves[pcbddc->current_level][1],pc,0,0,0);CHKERRQ(ierr);
5797   if (!reuse_solver || pcbddc->switch_static) {
5798     if (applytranspose) {
5799       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5800     } else {
5801       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5802     }
5803     ierr = KSPCheckSolve(pcbddc->ksp_R,pc,pcbddc->vec1_R);CHKERRQ(ierr);
5804   } else {
5805     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5806 
5807     if (applytranspose) {
5808       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5809     } else {
5810       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5811     }
5812   }
5813   ierr = PetscLogEventEnd(PC_BDDC_Solves[pcbddc->current_level][1],pc,0,0,0);CHKERRQ(ierr);
5814   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5815   if (!pcbddc->switch_static) {
5816     if (!reuse_solver) {
5817       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5818       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5819     } else {
5820       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5821 
5822       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5823       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5824     }
5825     if (!applytranspose && pcbddc->local_auxmat1) {
5826       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5827       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5828     }
5829   } else {
5830     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5831     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5832     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5833     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5834     if (!applytranspose && pcbddc->local_auxmat1) {
5835       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5836       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5837     }
5838     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5839     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5840     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5841     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5842   }
5843   PetscFunctionReturn(0);
5844 }
5845 
5846 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5847 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5848 {
5849   PetscErrorCode ierr;
5850   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5851   PC_IS*            pcis = (PC_IS*)  (pc->data);
5852   const PetscScalar zero = 0.0;
5853 
5854   PetscFunctionBegin;
5855   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5856   if (!pcbddc->benign_apply_coarse_only) {
5857     if (applytranspose) {
5858       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5859       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5860     } else {
5861       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5862       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5863     }
5864   } else {
5865     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5866   }
5867 
5868   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5869   if (pcbddc->benign_n) {
5870     PetscScalar *array;
5871     PetscInt    j;
5872 
5873     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5874     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5875     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5876   }
5877 
5878   /* start communications from local primal nodes to rhs of coarse solver */
5879   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5880   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5881   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5882 
5883   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5884   if (pcbddc->coarse_ksp) {
5885     Mat          coarse_mat;
5886     Vec          rhs,sol;
5887     MatNullSpace nullsp;
5888     PetscBool    isbddc = PETSC_FALSE;
5889 
5890     if (pcbddc->benign_have_null) {
5891       PC        coarse_pc;
5892 
5893       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5894       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5895       /* we need to propagate to coarser levels the need for a possible benign correction */
5896       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5897         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5898         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5899         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5900       }
5901     }
5902     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5903     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5904     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5905     if (applytranspose) {
5906       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5907       ierr = PetscLogEventBegin(PC_BDDC_Solves[pcbddc->current_level][2],pc,0,0,0);CHKERRQ(ierr);
5908       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5909       ierr = PetscLogEventEnd(PC_BDDC_Solves[pcbddc->current_level][2],pc,0,0,0);CHKERRQ(ierr);
5910       ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5911       ierr = MatGetTransposeNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5912       if (nullsp) {
5913         ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5914       }
5915     } else {
5916       ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5917       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5918         PC        coarse_pc;
5919 
5920         if (nullsp) {
5921           ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5922         }
5923         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5924         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5925         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5926         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5927       } else {
5928         ierr = PetscLogEventBegin(PC_BDDC_Solves[pcbddc->current_level][2],pc,0,0,0);CHKERRQ(ierr);
5929         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5930         ierr = PetscLogEventEnd(PC_BDDC_Solves[pcbddc->current_level][2],pc,0,0,0);CHKERRQ(ierr);
5931         ierr = KSPCheckSolve(pcbddc->coarse_ksp,pc,sol);CHKERRQ(ierr);
5932         if (nullsp) {
5933           ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5934         }
5935       }
5936     }
5937     /* we don't need the benign correction at coarser levels anymore */
5938     if (pcbddc->benign_have_null && isbddc) {
5939       PC        coarse_pc;
5940       PC_BDDC*  coarsepcbddc;
5941 
5942       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5943       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5944       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5945       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5946     }
5947   }
5948 
5949   /* Local solution on R nodes */
5950   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5951     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5952   }
5953   /* communications from coarse sol to local primal nodes */
5954   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5955   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5956 
5957   /* Sum contributions from the two levels */
5958   if (!pcbddc->benign_apply_coarse_only) {
5959     if (applytranspose) {
5960       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5961       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5962     } else {
5963       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5964       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5965     }
5966     /* store p0 */
5967     if (pcbddc->benign_n) {
5968       PetscScalar *array;
5969       PetscInt    j;
5970 
5971       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5972       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5973       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5974     }
5975   } else { /* expand the coarse solution */
5976     if (applytranspose) {
5977       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5978     } else {
5979       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5980     }
5981   }
5982   PetscFunctionReturn(0);
5983 }
5984 
5985 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5986 {
5987   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
5988   Vec               from,to;
5989   const PetscScalar *array;
5990   PetscErrorCode    ierr;
5991 
5992   PetscFunctionBegin;
5993   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5994     from = pcbddc->coarse_vec;
5995     to = pcbddc->vec1_P;
5996     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5997       Vec tvec;
5998 
5999       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
6000       ierr = VecResetArray(tvec);CHKERRQ(ierr);
6001       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
6002       ierr = VecGetArrayRead(tvec,&array);CHKERRQ(ierr);
6003       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
6004       ierr = VecRestoreArrayRead(tvec,&array);CHKERRQ(ierr);
6005     }
6006   } else { /* from local to global -> put data in coarse right hand side */
6007     from = pcbddc->vec1_P;
6008     to = pcbddc->coarse_vec;
6009   }
6010   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
6011   PetscFunctionReturn(0);
6012 }
6013 
6014 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
6015 {
6016   PC_BDDC*          pcbddc = (PC_BDDC*)(pc->data);
6017   Vec               from,to;
6018   const PetscScalar *array;
6019   PetscErrorCode    ierr;
6020 
6021   PetscFunctionBegin;
6022   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
6023     from = pcbddc->coarse_vec;
6024     to = pcbddc->vec1_P;
6025   } else { /* from local to global -> put data in coarse right hand side */
6026     from = pcbddc->vec1_P;
6027     to = pcbddc->coarse_vec;
6028   }
6029   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
6030   if (smode == SCATTER_FORWARD) {
6031     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
6032       Vec tvec;
6033 
6034       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
6035       ierr = VecGetArrayRead(to,&array);CHKERRQ(ierr);
6036       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
6037       ierr = VecRestoreArrayRead(to,&array);CHKERRQ(ierr);
6038     }
6039   } else {
6040     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
6041      ierr = VecResetArray(from);CHKERRQ(ierr);
6042     }
6043   }
6044   PetscFunctionReturn(0);
6045 }
6046 
6047 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
6048 {
6049   PetscErrorCode    ierr;
6050   PC_IS*            pcis = (PC_IS*)(pc->data);
6051   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
6052   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
6053   /* one and zero */
6054   PetscScalar       one=1.0,zero=0.0;
6055   /* space to store constraints and their local indices */
6056   PetscScalar       *constraints_data;
6057   PetscInt          *constraints_idxs,*constraints_idxs_B;
6058   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
6059   PetscInt          *constraints_n;
6060   /* iterators */
6061   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
6062   /* BLAS integers */
6063   PetscBLASInt      lwork,lierr;
6064   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
6065   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
6066   /* reuse */
6067   PetscInt          olocal_primal_size,olocal_primal_size_cc;
6068   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
6069   /* change of basis */
6070   PetscBool         qr_needed;
6071   PetscBT           change_basis,qr_needed_idx;
6072   /* auxiliary stuff */
6073   PetscInt          *nnz,*is_indices;
6074   PetscInt          ncc;
6075   /* some quantities */
6076   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
6077   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
6078   PetscReal         tol; /* tolerance for retaining eigenmodes */
6079 
6080   PetscFunctionBegin;
6081   tol  = PetscSqrtReal(PETSC_SMALL);
6082   /* Destroy Mat objects computed previously */
6083   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6084   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6085   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
6086   /* save info on constraints from previous setup (if any) */
6087   olocal_primal_size = pcbddc->local_primal_size;
6088   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
6089   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
6090   ierr = PetscArraycpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc);CHKERRQ(ierr);
6091   ierr = PetscArraycpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc);CHKERRQ(ierr);
6092   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
6093   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6094 
6095   if (!pcbddc->adaptive_selection) {
6096     IS           ISForVertices,*ISForFaces,*ISForEdges;
6097     MatNullSpace nearnullsp;
6098     const Vec    *nearnullvecs;
6099     Vec          *localnearnullsp;
6100     PetscScalar  *array;
6101     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
6102     PetscBool    nnsp_has_cnst;
6103     /* LAPACK working arrays for SVD or POD */
6104     PetscBool    skip_lapack,boolforchange;
6105     PetscScalar  *work;
6106     PetscReal    *singular_vals;
6107 #if defined(PETSC_USE_COMPLEX)
6108     PetscReal    *rwork;
6109 #endif
6110     PetscScalar  *temp_basis = NULL,*correlation_mat = NULL;
6111     PetscBLASInt dummy_int=1;
6112     PetscScalar  dummy_scalar=1.;
6113     PetscBool    use_pod = PETSC_FALSE;
6114 
6115     /* MKL SVD with same input gives different results on different processes! */
6116 #if defined(PETSC_MISSING_LAPACK_GESVD) || defined(PETSC_HAVE_MKL)
6117     use_pod = PETSC_TRUE;
6118 #endif
6119     /* Get index sets for faces, edges and vertices from graph */
6120     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
6121     /* print some info */
6122     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
6123       PetscInt nv;
6124 
6125       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
6126       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
6127       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6128       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6129       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
6130       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
6131       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
6132       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6133       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
6134     }
6135 
6136     /* free unneeded index sets */
6137     if (!pcbddc->use_vertices) {
6138       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6139     }
6140     if (!pcbddc->use_edges) {
6141       for (i=0;i<n_ISForEdges;i++) {
6142         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6143       }
6144       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6145       n_ISForEdges = 0;
6146     }
6147     if (!pcbddc->use_faces) {
6148       for (i=0;i<n_ISForFaces;i++) {
6149         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6150       }
6151       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6152       n_ISForFaces = 0;
6153     }
6154 
6155     /* check if near null space is attached to global mat */
6156     if (pcbddc->use_nnsp) {
6157       ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
6158     } else nearnullsp = NULL;
6159 
6160     if (nearnullsp) {
6161       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
6162       /* remove any stored info */
6163       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
6164       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6165       /* store information for BDDC solver reuse */
6166       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
6167       pcbddc->onearnullspace = nearnullsp;
6168       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
6169       for (i=0;i<nnsp_size;i++) {
6170         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
6171       }
6172     } else { /* if near null space is not provided BDDC uses constants by default */
6173       nnsp_size = 0;
6174       nnsp_has_cnst = PETSC_TRUE;
6175     }
6176     /* get max number of constraints on a single cc */
6177     max_constraints = nnsp_size;
6178     if (nnsp_has_cnst) max_constraints++;
6179 
6180     /*
6181          Evaluate maximum storage size needed by the procedure
6182          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
6183          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
6184          There can be multiple constraints per connected component
6185                                                                                                                                                            */
6186     n_vertices = 0;
6187     if (ISForVertices) {
6188       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
6189     }
6190     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
6191     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
6192 
6193     total_counts = n_ISForFaces+n_ISForEdges;
6194     total_counts *= max_constraints;
6195     total_counts += n_vertices;
6196     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
6197 
6198     total_counts = 0;
6199     max_size_of_constraint = 0;
6200     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
6201       IS used_is;
6202       if (i<n_ISForEdges) {
6203         used_is = ISForEdges[i];
6204       } else {
6205         used_is = ISForFaces[i-n_ISForEdges];
6206       }
6207       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
6208       total_counts += j;
6209       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
6210     }
6211     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);
6212 
6213     /* get local part of global near null space vectors */
6214     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
6215     for (k=0;k<nnsp_size;k++) {
6216       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
6217       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6218       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6219     }
6220 
6221     /* whether or not to skip lapack calls */
6222     skip_lapack = PETSC_TRUE;
6223     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
6224 
6225     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
6226     if (!skip_lapack) {
6227       PetscScalar temp_work;
6228 
6229       if (use_pod) {
6230         /* Proper Orthogonal Decomposition (POD) using the snapshot method */
6231         ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
6232         ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
6233         ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
6234 #if defined(PETSC_USE_COMPLEX)
6235         ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
6236 #endif
6237         /* now we evaluate the optimal workspace using query with lwork=-1 */
6238         ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6239         ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
6240         lwork = -1;
6241         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6242 #if !defined(PETSC_USE_COMPLEX)
6243         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
6244 #else
6245         PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
6246 #endif
6247         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6248         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
6249       } else {
6250 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6251         /* SVD */
6252         PetscInt max_n,min_n;
6253         max_n = max_size_of_constraint;
6254         min_n = max_constraints;
6255         if (max_size_of_constraint < max_constraints) {
6256           min_n = max_size_of_constraint;
6257           max_n = max_constraints;
6258         }
6259         ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
6260 #if defined(PETSC_USE_COMPLEX)
6261         ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
6262 #endif
6263         /* now we evaluate the optimal workspace using query with lwork=-1 */
6264         lwork = -1;
6265         ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
6266         ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
6267         ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
6268         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6269 #if !defined(PETSC_USE_COMPLEX)
6270         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));
6271 #else
6272         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));
6273 #endif
6274         ierr = PetscFPTrapPop();CHKERRQ(ierr);
6275         if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
6276 #else
6277         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6278 #endif /* on missing GESVD */
6279       }
6280       /* Allocate optimal workspace */
6281       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
6282       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
6283     }
6284     /* Now we can loop on constraining sets */
6285     total_counts = 0;
6286     constraints_idxs_ptr[0] = 0;
6287     constraints_data_ptr[0] = 0;
6288     /* vertices */
6289     if (n_vertices) {
6290       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6291       ierr = PetscArraycpy(constraints_idxs,is_indices,n_vertices);CHKERRQ(ierr);
6292       for (i=0;i<n_vertices;i++) {
6293         constraints_n[total_counts] = 1;
6294         constraints_data[total_counts] = 1.0;
6295         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
6296         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
6297         total_counts++;
6298       }
6299       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6300       n_vertices = total_counts;
6301     }
6302 
6303     /* edges and faces */
6304     total_counts_cc = total_counts;
6305     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
6306       IS        used_is;
6307       PetscBool idxs_copied = PETSC_FALSE;
6308 
6309       if (ncc<n_ISForEdges) {
6310         used_is = ISForEdges[ncc];
6311         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
6312       } else {
6313         used_is = ISForFaces[ncc-n_ISForEdges];
6314         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
6315       }
6316       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
6317 
6318       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
6319       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6320       /* change of basis should not be performed on local periodic nodes */
6321       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
6322       if (nnsp_has_cnst) {
6323         PetscScalar quad_value;
6324 
6325         ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6326         idxs_copied = PETSC_TRUE;
6327 
6328         if (!pcbddc->use_nnsp_true) {
6329           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
6330         } else {
6331           quad_value = 1.0;
6332         }
6333         for (j=0;j<size_of_constraint;j++) {
6334           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
6335         }
6336         temp_constraints++;
6337         total_counts++;
6338       }
6339       for (k=0;k<nnsp_size;k++) {
6340         PetscReal real_value;
6341         PetscScalar *ptr_to_data;
6342 
6343         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6344         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6345         for (j=0;j<size_of_constraint;j++) {
6346           ptr_to_data[j] = array[is_indices[j]];
6347         }
6348         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6349         /* check if array is null on the connected component */
6350         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6351         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6352         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6353           temp_constraints++;
6354           total_counts++;
6355           if (!idxs_copied) {
6356             ierr = PetscArraycpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint);CHKERRQ(ierr);
6357             idxs_copied = PETSC_TRUE;
6358           }
6359         }
6360       }
6361       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6362       valid_constraints = temp_constraints;
6363       if (!pcbddc->use_nnsp_true && temp_constraints) {
6364         if (temp_constraints == 1) { /* just normalize the constraint */
6365           PetscScalar norm,*ptr_to_data;
6366 
6367           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6368           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6369           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6370           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6371           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6372         } else { /* perform SVD */
6373           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6374 
6375           if (use_pod) {
6376             /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6377                POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6378                -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6379                   the constraints basis will differ (by a complex factor with absolute value equal to 1)
6380                   from that computed using LAPACKgesvd
6381                -> This is due to a different computation of eigenvectors in LAPACKheev
6382                -> The quality of the POD-computed basis will be the same */
6383             ierr = PetscArrayzero(correlation_mat,temp_constraints*temp_constraints);CHKERRQ(ierr);
6384             /* Store upper triangular part of correlation matrix */
6385             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6386             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6387             for (j=0;j<temp_constraints;j++) {
6388               for (k=0;k<j+1;k++) {
6389                 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));
6390               }
6391             }
6392             /* compute eigenvalues and eigenvectors of correlation matrix */
6393             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6394             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6395 #if !defined(PETSC_USE_COMPLEX)
6396             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6397 #else
6398             PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6399 #endif
6400             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6401             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6402             /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6403             j = 0;
6404             while (j < temp_constraints && singular_vals[j]/singular_vals[temp_constraints-1] < tol) j++;
6405             total_counts = total_counts-j;
6406             valid_constraints = temp_constraints-j;
6407             /* scale and copy POD basis into used quadrature memory */
6408             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6409             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6410             ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6411             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6412             ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6413             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6414             if (j<temp_constraints) {
6415               PetscInt ii;
6416               for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6417               ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6418               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));
6419               ierr = PetscFPTrapPop();CHKERRQ(ierr);
6420               for (k=0;k<temp_constraints-j;k++) {
6421                 for (ii=0;ii<size_of_constraint;ii++) {
6422                   ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6423                 }
6424               }
6425             }
6426           } else {
6427 #if !defined(PETSC_MISSING_LAPACK_GESVD)
6428             ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6429             ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6430             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6431             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6432 #if !defined(PETSC_USE_COMPLEX)
6433             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));
6434 #else
6435             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));
6436 #endif
6437             if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6438             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6439             /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6440             k = temp_constraints;
6441             if (k > size_of_constraint) k = size_of_constraint;
6442             j = 0;
6443             while (j < k && singular_vals[k-j-1]/singular_vals[0] < tol) j++;
6444             valid_constraints = k-j;
6445             total_counts = total_counts-temp_constraints+valid_constraints;
6446 #else
6447             SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"This should not happen");
6448 #endif /* on missing GESVD */
6449           }
6450         }
6451       }
6452       /* update pointers information */
6453       if (valid_constraints) {
6454         constraints_n[total_counts_cc] = valid_constraints;
6455         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6456         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6457         /* set change_of_basis flag */
6458         if (boolforchange) {
6459           PetscBTSet(change_basis,total_counts_cc);
6460         }
6461         total_counts_cc++;
6462       }
6463     }
6464     /* free workspace */
6465     if (!skip_lapack) {
6466       ierr = PetscFree(work);CHKERRQ(ierr);
6467 #if defined(PETSC_USE_COMPLEX)
6468       ierr = PetscFree(rwork);CHKERRQ(ierr);
6469 #endif
6470       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6471       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6472       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6473     }
6474     for (k=0;k<nnsp_size;k++) {
6475       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6476     }
6477     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6478     /* free index sets of faces, edges and vertices */
6479     for (i=0;i<n_ISForFaces;i++) {
6480       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6481     }
6482     if (n_ISForFaces) {
6483       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6484     }
6485     for (i=0;i<n_ISForEdges;i++) {
6486       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6487     }
6488     if (n_ISForEdges) {
6489       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6490     }
6491     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6492   } else {
6493     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6494 
6495     total_counts = 0;
6496     n_vertices = 0;
6497     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6498       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6499     }
6500     max_constraints = 0;
6501     total_counts_cc = 0;
6502     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6503       total_counts += pcbddc->adaptive_constraints_n[i];
6504       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6505       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6506     }
6507     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6508     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6509     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6510     constraints_data = pcbddc->adaptive_constraints_data;
6511     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6512     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6513     total_counts_cc = 0;
6514     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6515       if (pcbddc->adaptive_constraints_n[i]) {
6516         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6517       }
6518     }
6519 
6520     max_size_of_constraint = 0;
6521     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]);
6522     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6523     /* Change of basis */
6524     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6525     if (pcbddc->use_change_of_basis) {
6526       for (i=0;i<sub_schurs->n_subs;i++) {
6527         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6528           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6529         }
6530       }
6531     }
6532   }
6533   pcbddc->local_primal_size = total_counts;
6534   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6535 
6536   /* map constraints_idxs in boundary numbering */
6537   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6538   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D",constraints_idxs_ptr[total_counts_cc],i);
6539 
6540   /* Create constraint matrix */
6541   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6542   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6543   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6544 
6545   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6546   /* determine if a QR strategy is needed for change of basis */
6547   qr_needed = pcbddc->use_qr_single;
6548   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6549   total_primal_vertices=0;
6550   pcbddc->local_primal_size_cc = 0;
6551   for (i=0;i<total_counts_cc;i++) {
6552     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6553     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6554       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6555       pcbddc->local_primal_size_cc += 1;
6556     } else if (PetscBTLookup(change_basis,i)) {
6557       for (k=0;k<constraints_n[i];k++) {
6558         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6559       }
6560       pcbddc->local_primal_size_cc += constraints_n[i];
6561       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6562         PetscBTSet(qr_needed_idx,i);
6563         qr_needed = PETSC_TRUE;
6564       }
6565     } else {
6566       pcbddc->local_primal_size_cc += 1;
6567     }
6568   }
6569   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6570   pcbddc->n_vertices = total_primal_vertices;
6571   /* permute indices in order to have a sorted set of vertices */
6572   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6573   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);
6574   ierr = PetscArraycpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices);CHKERRQ(ierr);
6575   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6576 
6577   /* nonzero structure of constraint matrix */
6578   /* and get reference dof for local constraints */
6579   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6580   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6581 
6582   j = total_primal_vertices;
6583   total_counts = total_primal_vertices;
6584   cum = total_primal_vertices;
6585   for (i=n_vertices;i<total_counts_cc;i++) {
6586     if (!PetscBTLookup(change_basis,i)) {
6587       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6588       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6589       cum++;
6590       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6591       for (k=0;k<constraints_n[i];k++) {
6592         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6593         nnz[j+k] = size_of_constraint;
6594       }
6595       j += constraints_n[i];
6596     }
6597   }
6598   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6599   ierr = MatSetOption(pcbddc->ConstraintMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6600   ierr = PetscFree(nnz);CHKERRQ(ierr);
6601 
6602   /* set values in constraint matrix */
6603   for (i=0;i<total_primal_vertices;i++) {
6604     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6605   }
6606   total_counts = total_primal_vertices;
6607   for (i=n_vertices;i<total_counts_cc;i++) {
6608     if (!PetscBTLookup(change_basis,i)) {
6609       PetscInt *cols;
6610 
6611       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6612       cols = constraints_idxs+constraints_idxs_ptr[i];
6613       for (k=0;k<constraints_n[i];k++) {
6614         PetscInt    row = total_counts+k;
6615         PetscScalar *vals;
6616 
6617         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6618         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6619       }
6620       total_counts += constraints_n[i];
6621     }
6622   }
6623   /* assembling */
6624   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6625   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6626   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,(PetscObject)pc,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6627 
6628   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6629   if (pcbddc->use_change_of_basis) {
6630     /* dual and primal dofs on a single cc */
6631     PetscInt     dual_dofs,primal_dofs;
6632     /* working stuff for GEQRF */
6633     PetscScalar  *qr_basis = NULL,*qr_tau = NULL,*qr_work = NULL,lqr_work_t;
6634     PetscBLASInt lqr_work;
6635     /* working stuff for UNGQR */
6636     PetscScalar  *gqr_work = NULL,lgqr_work_t=0.0;
6637     PetscBLASInt lgqr_work;
6638     /* working stuff for TRTRS */
6639     PetscScalar  *trs_rhs = NULL;
6640     PetscBLASInt Blas_NRHS;
6641     /* pointers for values insertion into change of basis matrix */
6642     PetscInt     *start_rows,*start_cols;
6643     PetscScalar  *start_vals;
6644     /* working stuff for values insertion */
6645     PetscBT      is_primal;
6646     PetscInt     *aux_primal_numbering_B;
6647     /* matrix sizes */
6648     PetscInt     global_size,local_size;
6649     /* temporary change of basis */
6650     Mat          localChangeOfBasisMatrix;
6651     /* extra space for debugging */
6652     PetscScalar  *dbg_work = NULL;
6653 
6654     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6655     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6656     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6657     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6658     /* nonzeros for local mat */
6659     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6660     if (!pcbddc->benign_change || pcbddc->fake_change) {
6661       for (i=0;i<pcis->n;i++) nnz[i]=1;
6662     } else {
6663       const PetscInt *ii;
6664       PetscInt       n;
6665       PetscBool      flg_row;
6666       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6667       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6668       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6669     }
6670     for (i=n_vertices;i<total_counts_cc;i++) {
6671       if (PetscBTLookup(change_basis,i)) {
6672         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6673         if (PetscBTLookup(qr_needed_idx,i)) {
6674           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6675         } else {
6676           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6677           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6678         }
6679       }
6680     }
6681     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6682     ierr = MatSetOption(localChangeOfBasisMatrix,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE);CHKERRQ(ierr);
6683     ierr = PetscFree(nnz);CHKERRQ(ierr);
6684     /* Set interior change in the matrix */
6685     if (!pcbddc->benign_change || pcbddc->fake_change) {
6686       for (i=0;i<pcis->n;i++) {
6687         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6688       }
6689     } else {
6690       const PetscInt *ii,*jj;
6691       PetscScalar    *aa;
6692       PetscInt       n;
6693       PetscBool      flg_row;
6694       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6695       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6696       for (i=0;i<n;i++) {
6697         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6698       }
6699       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6700       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6701     }
6702 
6703     if (pcbddc->dbg_flag) {
6704       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6705       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6706     }
6707 
6708     /* Now we loop on the constraints which need a change of basis */
6709     /*
6710        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6711        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6712 
6713        Basic blocks of change of basis matrix T computed by
6714 
6715           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6716 
6717             | 1        0   ...        0         s_1/S |
6718             | 0        1   ...        0         s_2/S |
6719             |              ...                        |
6720             | 0        ...            1     s_{n-1}/S |
6721             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6722 
6723             with S = \sum_{i=1}^n s_i^2
6724             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6725                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6726 
6727           - QR decomposition of constraints otherwise
6728     */
6729     if (qr_needed && max_size_of_constraint) {
6730       /* space to store Q */
6731       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6732       /* array to store scaling factors for reflectors */
6733       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6734       /* first we issue queries for optimal work */
6735       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6736       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6737       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6738       lqr_work = -1;
6739       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6740       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6741       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6742       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6743       lgqr_work = -1;
6744       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6745       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6746       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6747       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6748       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6749       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6750       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6751       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6752       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6753       /* array to store rhs and solution of triangular solver */
6754       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6755       /* allocating workspace for check */
6756       if (pcbddc->dbg_flag) {
6757         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6758       }
6759     }
6760     /* array to store whether a node is primal or not */
6761     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6762     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6763     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6764     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D",total_primal_vertices,i);
6765     for (i=0;i<total_primal_vertices;i++) {
6766       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6767     }
6768     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6769 
6770     /* loop on constraints and see whether or not they need a change of basis and compute it */
6771     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6772       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6773       if (PetscBTLookup(change_basis,total_counts)) {
6774         /* get constraint info */
6775         primal_dofs = constraints_n[total_counts];
6776         dual_dofs = size_of_constraint-primal_dofs;
6777 
6778         if (pcbddc->dbg_flag) {
6779           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);
6780         }
6781 
6782         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6783 
6784           /* copy quadrature constraints for change of basis check */
6785           if (pcbddc->dbg_flag) {
6786             ierr = PetscArraycpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6787           }
6788           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6789           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6790 
6791           /* compute QR decomposition of constraints */
6792           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6793           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6794           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6795           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6796           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6797           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6798           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6799 
6800           /* explictly compute R^-T */
6801           ierr = PetscArrayzero(trs_rhs,primal_dofs*primal_dofs);CHKERRQ(ierr);
6802           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6803           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6804           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6805           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6806           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6807           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6808           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6809           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6810           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6811 
6812           /* explicitly compute all columns of Q (Q = [Q1 | Q2]) overwriting QR factorization in qr_basis */
6813           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6814           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6815           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6816           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6817           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6818           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6819           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6820           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6821 
6822           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6823              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6824              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6825           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6826           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6827           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6828           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6829           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6830           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6831           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6832           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));
6833           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6834           ierr = PetscArraycpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs);CHKERRQ(ierr);
6835 
6836           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6837           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6838           /* insert cols for primal dofs */
6839           for (j=0;j<primal_dofs;j++) {
6840             start_vals = &qr_basis[j*size_of_constraint];
6841             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6842             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6843           }
6844           /* insert cols for dual dofs */
6845           for (j=0,k=0;j<dual_dofs;k++) {
6846             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6847               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6848               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6849               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6850               j++;
6851             }
6852           }
6853 
6854           /* check change of basis */
6855           if (pcbddc->dbg_flag) {
6856             PetscInt   ii,jj;
6857             PetscBool valid_qr=PETSC_TRUE;
6858             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6859             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6860             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6861             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6862             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6863             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6864             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6865             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));
6866             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6867             for (jj=0;jj<size_of_constraint;jj++) {
6868               for (ii=0;ii<primal_dofs;ii++) {
6869                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6870                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6871               }
6872             }
6873             if (!valid_qr) {
6874               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6875               for (jj=0;jj<size_of_constraint;jj++) {
6876                 for (ii=0;ii<primal_dofs;ii++) {
6877                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6878                     ierr = 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]));CHKERRQ(ierr);
6879                   }
6880                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6881                     ierr = 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]));CHKERRQ(ierr);
6882                   }
6883                 }
6884               }
6885             } else {
6886               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6887             }
6888           }
6889         } else { /* simple transformation block */
6890           PetscInt    row,col;
6891           PetscScalar val,norm;
6892 
6893           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6894           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6895           for (j=0;j<size_of_constraint;j++) {
6896             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6897             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6898             if (!PetscBTLookup(is_primal,row_B)) {
6899               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6900               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6901               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6902             } else {
6903               for (k=0;k<size_of_constraint;k++) {
6904                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6905                 if (row != col) {
6906                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6907                 } else {
6908                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6909                 }
6910                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6911               }
6912             }
6913           }
6914           if (pcbddc->dbg_flag) {
6915             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6916           }
6917         }
6918       } else {
6919         if (pcbddc->dbg_flag) {
6920           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %D does not need a change of basis (size %D)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6921         }
6922       }
6923     }
6924 
6925     /* free workspace */
6926     if (qr_needed) {
6927       if (pcbddc->dbg_flag) {
6928         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6929       }
6930       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6931       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6932       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6933       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6934       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6935     }
6936     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6937     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6938     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6939 
6940     /* assembling of global change of variable */
6941     if (!pcbddc->fake_change) {
6942       Mat      tmat;
6943       PetscInt bs;
6944 
6945       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6946       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6947       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6948       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6949       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6950       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6951       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6952       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6953       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6954       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6955       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6956       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6957       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6958       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6959       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6960       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6961       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6962       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6963       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6964       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6965 
6966       /* check */
6967       if (pcbddc->dbg_flag) {
6968         PetscReal error;
6969         Vec       x,x_change;
6970 
6971         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6972         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6973         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6974         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6975         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6976         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6977         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6978         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6979         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6980         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6981         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6982         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6983         if (error > PETSC_SMALL) {
6984           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e",error);
6985         }
6986         ierr = VecDestroy(&x);CHKERRQ(ierr);
6987         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6988       }
6989       /* adapt sub_schurs computed (if any) */
6990       if (pcbddc->use_deluxe_scaling) {
6991         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6992 
6993         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");
6994         if (sub_schurs && sub_schurs->S_Ej_all) {
6995           Mat                    S_new,tmat;
6996           IS                     is_all_N,is_V_Sall = NULL;
6997 
6998           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6999           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
7000           if (pcbddc->deluxe_zerorows) {
7001             ISLocalToGlobalMapping NtoSall;
7002             IS                     is_V;
7003             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
7004             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
7005             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
7006             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
7007             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
7008           }
7009           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
7010           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7011           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
7012           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7013           if (pcbddc->deluxe_zerorows) {
7014             const PetscScalar *array;
7015             const PetscInt    *idxs_V,*idxs_all;
7016             PetscInt          i,n_V;
7017 
7018             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7019             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
7020             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7021             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7022             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
7023             for (i=0;i<n_V;i++) {
7024               PetscScalar val;
7025               PetscInt    idx;
7026 
7027               idx = idxs_V[i];
7028               val = array[idxs_all[idxs_V[i]]];
7029               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
7030             }
7031             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7032             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7033             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
7034             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
7035             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
7036           }
7037           sub_schurs->S_Ej_all = S_new;
7038           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7039           if (sub_schurs->sum_S_Ej_all) {
7040             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
7041             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
7042             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
7043             if (pcbddc->deluxe_zerorows) {
7044               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
7045             }
7046             sub_schurs->sum_S_Ej_all = S_new;
7047             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
7048           }
7049           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
7050           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
7051         }
7052         /* destroy any change of basis context in sub_schurs */
7053         if (sub_schurs && sub_schurs->change) {
7054           PetscInt i;
7055 
7056           for (i=0;i<sub_schurs->n_subs;i++) {
7057             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
7058           }
7059           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
7060         }
7061       }
7062       if (pcbddc->switch_static) { /* need to save the local change */
7063         pcbddc->switch_static_change = localChangeOfBasisMatrix;
7064       } else {
7065         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
7066       }
7067       /* determine if any process has changed the pressures locally */
7068       pcbddc->change_interior = pcbddc->benign_have_null;
7069     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
7070       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
7071       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
7072       pcbddc->use_qr_single = qr_needed;
7073     }
7074   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
7075     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
7076       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
7077       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
7078     } else {
7079       Mat benign_global = NULL;
7080       if (pcbddc->benign_have_null) {
7081         Mat M;
7082 
7083         pcbddc->change_interior = PETSC_TRUE;
7084         ierr = VecCopy(matis->counter,pcis->vec1_N);CHKERRQ(ierr);
7085         ierr = VecReciprocal(pcis->vec1_N);CHKERRQ(ierr);
7086         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&benign_global);CHKERRQ(ierr);
7087         if (pcbddc->benign_change) {
7088           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
7089           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
7090         } else {
7091           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&M);CHKERRQ(ierr);
7092           ierr = MatDiagonalSet(M,pcis->vec1_N,INSERT_VALUES);CHKERRQ(ierr);
7093         }
7094         ierr = MatISSetLocalMat(benign_global,M);CHKERRQ(ierr);
7095         ierr = MatDestroy(&M);CHKERRQ(ierr);
7096         ierr = MatAssemblyBegin(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7097         ierr = MatAssemblyEnd(benign_global,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7098       }
7099       if (pcbddc->user_ChangeOfBasisMatrix) {
7100         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
7101         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
7102       } else if (pcbddc->benign_have_null) {
7103         pcbddc->ChangeOfBasisMatrix = benign_global;
7104       }
7105     }
7106     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
7107       IS             is_global;
7108       const PetscInt *gidxs;
7109 
7110       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7111       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
7112       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
7113       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
7114       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
7115     }
7116   }
7117   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
7118     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
7119   }
7120 
7121   if (!pcbddc->fake_change) {
7122     /* add pressure dofs to set of primal nodes for numbering purposes */
7123     for (i=0;i<pcbddc->benign_n;i++) {
7124       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
7125       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
7126       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
7127       pcbddc->local_primal_size_cc++;
7128       pcbddc->local_primal_size++;
7129     }
7130 
7131     /* check if a new primal space has been introduced (also take into account benign trick) */
7132     pcbddc->new_primal_space_local = PETSC_TRUE;
7133     if (olocal_primal_size == pcbddc->local_primal_size) {
7134       ierr = PetscArraycmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7135       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7136       if (!pcbddc->new_primal_space_local) {
7137         ierr = PetscArraycmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc,&pcbddc->new_primal_space_local);CHKERRQ(ierr);
7138         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
7139       }
7140     }
7141     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
7142     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
7143   }
7144   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
7145 
7146   /* flush dbg viewer */
7147   if (pcbddc->dbg_flag) {
7148     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7149   }
7150 
7151   /* free workspace */
7152   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
7153   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
7154   if (!pcbddc->adaptive_selection) {
7155     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
7156     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
7157   } else {
7158     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
7159                       pcbddc->adaptive_constraints_idxs_ptr,
7160                       pcbddc->adaptive_constraints_data_ptr,
7161                       pcbddc->adaptive_constraints_idxs,
7162                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
7163     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
7164     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
7165   }
7166   PetscFunctionReturn(0);
7167 }
7168 
7169 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
7170 {
7171   ISLocalToGlobalMapping map;
7172   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7173   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
7174   PetscInt               i,N;
7175   PetscBool              rcsr = PETSC_FALSE;
7176   PetscErrorCode         ierr;
7177 
7178   PetscFunctionBegin;
7179   if (pcbddc->recompute_topography) {
7180     pcbddc->graphanalyzed = PETSC_FALSE;
7181     /* Reset previously computed graph */
7182     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
7183     /* Init local Graph struct */
7184     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
7185     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
7186     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
7187 
7188     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
7189       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7190     }
7191     /* Check validity of the csr graph passed in by the user */
7192     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",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
7193 
7194     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
7195     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
7196       PetscInt  *xadj,*adjncy;
7197       PetscInt  nvtxs;
7198       PetscBool flg_row=PETSC_FALSE;
7199 
7200       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7201       if (flg_row) {
7202         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
7203         pcbddc->computed_rowadj = PETSC_TRUE;
7204       }
7205       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
7206       rcsr = PETSC_TRUE;
7207     }
7208     if (pcbddc->dbg_flag) {
7209       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7210     }
7211 
7212     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
7213       PetscReal    *lcoords;
7214       PetscInt     n;
7215       MPI_Datatype dimrealtype;
7216 
7217       /* TODO: support for blocked */
7218       if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
7219       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7220       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
7221       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRMPI(ierr);
7222       ierr = MPI_Type_commit(&dimrealtype);CHKERRMPI(ierr);
7223       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords,MPI_REPLACE);CHKERRQ(ierr);
7224       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords,MPI_REPLACE);CHKERRQ(ierr);
7225       ierr = MPI_Type_free(&dimrealtype);CHKERRMPI(ierr);
7226       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
7227 
7228       pcbddc->mat_graph->coords = lcoords;
7229       pcbddc->mat_graph->cloc   = PETSC_TRUE;
7230       pcbddc->mat_graph->cnloc  = n;
7231     }
7232     if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
7233     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && pcbddc->mat_graph->cdim && !pcbddc->corner_selected);
7234 
7235     /* Setup of Graph */
7236     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
7237     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
7238 
7239     /* attach info on disconnected subdomains if present */
7240     if (pcbddc->n_local_subs) {
7241       PetscInt *local_subs,n,totn;
7242 
7243       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
7244       ierr = PetscMalloc1(n,&local_subs);CHKERRQ(ierr);
7245       for (i=0;i<n;i++) local_subs[i] = pcbddc->n_local_subs;
7246       for (i=0;i<pcbddc->n_local_subs;i++) {
7247         const PetscInt *idxs;
7248         PetscInt       nl,j;
7249 
7250         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
7251         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7252         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
7253         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
7254       }
7255       for (i=0,totn=0;i<n;i++) totn = PetscMax(totn,local_subs[i]);
7256       pcbddc->mat_graph->n_local_subs = totn + 1;
7257       pcbddc->mat_graph->local_subs = local_subs;
7258     }
7259   }
7260 
7261   if (!pcbddc->graphanalyzed) {
7262     /* Graph's connected components analysis */
7263     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
7264     pcbddc->graphanalyzed = PETSC_TRUE;
7265     pcbddc->corner_selected = pcbddc->corner_selection;
7266   }
7267   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
7268   PetscFunctionReturn(0);
7269 }
7270 
7271 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt *nio, Vec vecs[])
7272 {
7273   PetscInt       i,j,n;
7274   PetscScalar    *alphas;
7275   PetscReal      norm,*onorms;
7276   PetscErrorCode ierr;
7277 
7278   PetscFunctionBegin;
7279   n = *nio;
7280   if (!n) PetscFunctionReturn(0);
7281   ierr = PetscMalloc2(n,&alphas,n,&onorms);CHKERRQ(ierr);
7282   ierr = VecNormalize(vecs[0],&norm);CHKERRQ(ierr);
7283   if (norm < PETSC_SMALL) {
7284     onorms[0] = 0.0;
7285     ierr = VecSet(vecs[0],0.0);CHKERRQ(ierr);
7286   } else {
7287     onorms[0] = norm;
7288   }
7289 
7290   for (i=1;i<n;i++) {
7291     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
7292     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
7293     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
7294     ierr = VecNormalize(vecs[i],&norm);CHKERRQ(ierr);
7295     if (norm < PETSC_SMALL) {
7296       onorms[i] = 0.0;
7297       ierr = VecSet(vecs[i],0.0);CHKERRQ(ierr);
7298     } else {
7299       onorms[i] = norm;
7300     }
7301   }
7302   /* push nonzero vectors at the beginning */
7303   for (i=0;i<n;i++) {
7304     if (onorms[i] == 0.0) {
7305       for (j=i+1;j<n;j++) {
7306         if (onorms[j] != 0.0) {
7307           ierr = VecCopy(vecs[j],vecs[i]);CHKERRQ(ierr);
7308           onorms[j] = 0.0;
7309         }
7310       }
7311     }
7312   }
7313   for (i=0,*nio=0;i<n;i++) *nio += onorms[i] != 0.0 ? 1 : 0;
7314   ierr = PetscFree2(alphas,onorms);CHKERRQ(ierr);
7315   PetscFunctionReturn(0);
7316 }
7317 
7318 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
7319 {
7320   Mat            A;
7321   PetscInt       n_neighs,*neighs,*n_shared,**shared;
7322   PetscMPIInt    size,rank,color;
7323   PetscInt       *xadj,*adjncy;
7324   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
7325   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
7326   PetscInt       void_procs,*procs_candidates = NULL;
7327   PetscInt       xadj_count,*count;
7328   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
7329   PetscSubcomm   psubcomm;
7330   MPI_Comm       subcomm;
7331   PetscErrorCode ierr;
7332 
7333   PetscFunctionBegin;
7334   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7335   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7336   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);
7337   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7338   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7339   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %D",*n_subdomains);
7340 
7341   if (have_void) *have_void = PETSC_FALSE;
7342   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRMPI(ierr);
7343   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRMPI(ierr);
7344   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7345   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7346   im_active = !!n;
7347   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRMPI(ierr);
7348   void_procs = size - active_procs;
7349   /* get ranks of of non-active processes in mat communicator */
7350   if (void_procs) {
7351     PetscInt ncand;
7352 
7353     if (have_void) *have_void = PETSC_TRUE;
7354     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7355     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRMPI(ierr);
7356     for (i=0,ncand=0;i<size;i++) {
7357       if (!procs_candidates[i]) {
7358         procs_candidates[ncand++] = i;
7359       }
7360     }
7361     /* force n_subdomains to be not greater that the number of non-active processes */
7362     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7363   }
7364 
7365   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7366      number of subdomains requested 1 -> send to rank-0 or first candidate in voids  */
7367   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7368   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7369     PetscInt issize,isidx,dest;
7370     if (*n_subdomains == 1) dest = 0;
7371     else dest = rank;
7372     if (im_active) {
7373       issize = 1;
7374       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7375         isidx = procs_candidates[dest];
7376       } else {
7377         isidx = dest;
7378       }
7379     } else {
7380       issize = 0;
7381       isidx = -1;
7382     }
7383     if (*n_subdomains != 1) *n_subdomains = active_procs;
7384     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7385     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7386     PetscFunctionReturn(0);
7387   }
7388   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7389   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7390   threshold = PetscMax(threshold,2);
7391 
7392   /* Get info on mapping */
7393   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7394 
7395   /* build local CSR graph of subdomains' connectivity */
7396   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7397   xadj[0] = 0;
7398   xadj[1] = PetscMax(n_neighs-1,0);
7399   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7400   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7401   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7402   for (i=1;i<n_neighs;i++)
7403     for (j=0;j<n_shared[i];j++)
7404       count[shared[i][j]] += 1;
7405 
7406   xadj_count = 0;
7407   for (i=1;i<n_neighs;i++) {
7408     for (j=0;j<n_shared[i];j++) {
7409       if (count[shared[i][j]] < threshold) {
7410         adjncy[xadj_count] = neighs[i];
7411         adjncy_wgt[xadj_count] = n_shared[i];
7412         xadj_count++;
7413         break;
7414       }
7415     }
7416   }
7417   xadj[1] = xadj_count;
7418   ierr = PetscFree(count);CHKERRQ(ierr);
7419   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7420   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7421 
7422   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7423 
7424   /* Restrict work on active processes only */
7425   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7426   if (void_procs) {
7427     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7428     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7429     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7430     subcomm = PetscSubcommChild(psubcomm);
7431   } else {
7432     psubcomm = NULL;
7433     subcomm = PetscObjectComm((PetscObject)mat);
7434   }
7435 
7436   v_wgt = NULL;
7437   if (!color) {
7438     ierr = PetscFree(xadj);CHKERRQ(ierr);
7439     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7440     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7441   } else {
7442     Mat             subdomain_adj;
7443     IS              new_ranks,new_ranks_contig;
7444     MatPartitioning partitioner;
7445     PetscInt        rstart=0,rend=0;
7446     PetscInt        *is_indices,*oldranks;
7447     PetscMPIInt     size;
7448     PetscBool       aggregate;
7449 
7450     ierr = MPI_Comm_size(subcomm,&size);CHKERRMPI(ierr);
7451     if (void_procs) {
7452       PetscInt prank = rank;
7453       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7454       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRMPI(ierr);
7455       for (i=0;i<xadj[1];i++) {
7456         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7457       }
7458       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7459     } else {
7460       oldranks = NULL;
7461     }
7462     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7463     if (aggregate) { /* TODO: all this part could be made more efficient */
7464       PetscInt    lrows,row,ncols,*cols;
7465       PetscMPIInt nrank;
7466       PetscScalar *vals;
7467 
7468       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRMPI(ierr);
7469       lrows = 0;
7470       if (nrank<redprocs) {
7471         lrows = size/redprocs;
7472         if (nrank<size%redprocs) lrows++;
7473       }
7474       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7475       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7476       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7477       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7478       row = nrank;
7479       ncols = xadj[1]-xadj[0];
7480       cols = adjncy;
7481       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7482       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7483       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7484       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7485       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7486       ierr = PetscFree(xadj);CHKERRQ(ierr);
7487       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7488       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7489       ierr = PetscFree(vals);CHKERRQ(ierr);
7490       if (use_vwgt) {
7491         Vec               v;
7492         const PetscScalar *array;
7493         PetscInt          nl;
7494 
7495         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7496         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7497         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7498         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7499         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7500         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7501         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7502         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7503         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7504         ierr = VecDestroy(&v);CHKERRQ(ierr);
7505       }
7506     } else {
7507       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7508       if (use_vwgt) {
7509         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7510         v_wgt[0] = n;
7511       }
7512     }
7513     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7514 
7515     /* Partition */
7516     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7517 #if defined(PETSC_HAVE_PTSCOTCH)
7518     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPTSCOTCH);CHKERRQ(ierr);
7519 #elif defined(PETSC_HAVE_PARMETIS)
7520     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGPARMETIS);CHKERRQ(ierr);
7521 #else
7522     ierr = MatPartitioningSetType(partitioner,MATPARTITIONINGAVERAGE);CHKERRQ(ierr);
7523 #endif
7524     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7525     if (v_wgt) {
7526       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7527     }
7528     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7529     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7530     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7531     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7532     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7533 
7534     /* renumber new_ranks to avoid "holes" in new set of processors */
7535     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7536     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7537     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7538     if (!aggregate) {
7539       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7540         if (PetscUnlikelyDebug(!oldranks)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7541         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7542       } else if (oldranks) {
7543         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7544       } else {
7545         ranks_send_to_idx[0] = is_indices[0];
7546       }
7547     } else {
7548       PetscInt    idx = 0;
7549       PetscMPIInt tag;
7550       MPI_Request *reqs;
7551 
7552       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7553       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7554       for (i=rstart;i<rend;i++) {
7555         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRMPI(ierr);
7556       }
7557       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRMPI(ierr);
7558       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
7559       ierr = PetscFree(reqs);CHKERRQ(ierr);
7560       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7561         if (PetscUnlikelyDebug(!oldranks)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7562         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7563       } else if (oldranks) {
7564         ranks_send_to_idx[0] = oldranks[idx];
7565       } else {
7566         ranks_send_to_idx[0] = idx;
7567       }
7568     }
7569     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7570     /* clean up */
7571     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7572     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7573     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7574     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7575   }
7576   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7577   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7578 
7579   /* assemble parallel IS for sends */
7580   i = 1;
7581   if (!color) i=0;
7582   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7583   PetscFunctionReturn(0);
7584 }
7585 
7586 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7587 
7588 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[])
7589 {
7590   Mat                    local_mat;
7591   IS                     is_sends_internal;
7592   PetscInt               rows,cols,new_local_rows;
7593   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7594   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7595   ISLocalToGlobalMapping l2gmap;
7596   PetscInt*              l2gmap_indices;
7597   const PetscInt*        is_indices;
7598   MatType                new_local_type;
7599   /* buffers */
7600   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7601   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7602   PetscInt               *recv_buffer_idxs_local;
7603   PetscScalar            *ptr_vals,*recv_buffer_vals;
7604   const PetscScalar      *send_buffer_vals;
7605   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7606   /* MPI */
7607   MPI_Comm               comm,comm_n;
7608   PetscSubcomm           subcomm;
7609   PetscMPIInt            n_sends,n_recvs,size;
7610   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7611   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7612   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7613   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7614   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7615   PetscErrorCode         ierr;
7616 
7617   PetscFunctionBegin;
7618   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7619   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7620   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);
7621   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7622   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7623   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7624   PetscValidLogicalCollectiveBool(mat,reuse,6);
7625   PetscValidLogicalCollectiveInt(mat,nis,8);
7626   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7627   if (nvecs) {
7628     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7629     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7630   }
7631   /* further checks */
7632   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7633   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7634   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7635   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7636   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7637   if (reuse && *mat_n) {
7638     PetscInt mrows,mcols,mnrows,mncols;
7639     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7640     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7641     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7642     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7643     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7644     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7645     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7646   }
7647   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7648   PetscValidLogicalCollectiveInt(mat,bs,1);
7649 
7650   /* prepare IS for sending if not provided */
7651   if (!is_sends) {
7652     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7653     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7654   } else {
7655     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7656     is_sends_internal = is_sends;
7657   }
7658 
7659   /* get comm */
7660   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7661 
7662   /* compute number of sends */
7663   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7664   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7665 
7666   /* compute number of receives */
7667   ierr = MPI_Comm_size(comm,&size);CHKERRMPI(ierr);
7668   ierr = PetscMalloc1(size,&iflags);CHKERRQ(ierr);
7669   ierr = PetscArrayzero(iflags,size);CHKERRQ(ierr);
7670   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7671   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7672   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7673   ierr = PetscFree(iflags);CHKERRQ(ierr);
7674 
7675   /* restrict comm if requested */
7676   subcomm = NULL;
7677   destroy_mat = PETSC_FALSE;
7678   if (restrict_comm) {
7679     PetscMPIInt color,subcommsize;
7680 
7681     color = 0;
7682     if (restrict_full) {
7683       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7684     } else {
7685       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7686     }
7687     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRMPI(ierr);
7688     subcommsize = size - subcommsize;
7689     /* check if reuse has been requested */
7690     if (reuse) {
7691       if (*mat_n) {
7692         PetscMPIInt subcommsize2;
7693         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRMPI(ierr);
7694         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7695         comm_n = PetscObjectComm((PetscObject)*mat_n);
7696       } else {
7697         comm_n = PETSC_COMM_SELF;
7698       }
7699     } else { /* MAT_INITIAL_MATRIX */
7700       PetscMPIInt rank;
7701 
7702       ierr = MPI_Comm_rank(comm,&rank);CHKERRMPI(ierr);
7703       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7704       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7705       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7706       comm_n = PetscSubcommChild(subcomm);
7707     }
7708     /* flag to destroy *mat_n if not significative */
7709     if (color) destroy_mat = PETSC_TRUE;
7710   } else {
7711     comm_n = comm;
7712   }
7713 
7714   /* prepare send/receive buffers */
7715   ierr = PetscMalloc1(size,&ilengths_idxs);CHKERRQ(ierr);
7716   ierr = PetscArrayzero(ilengths_idxs,size);CHKERRQ(ierr);
7717   ierr = PetscMalloc1(size,&ilengths_vals);CHKERRQ(ierr);
7718   ierr = PetscArrayzero(ilengths_vals,size);CHKERRQ(ierr);
7719   if (nis) {
7720     ierr = PetscCalloc1(size,&ilengths_idxs_is);CHKERRQ(ierr);
7721   }
7722 
7723   /* Get data from local matrices */
7724   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7725     /* TODO: See below some guidelines on how to prepare the local buffers */
7726     /*
7727        send_buffer_vals should contain the raw values of the local matrix
7728        send_buffer_idxs should contain:
7729        - MatType_PRIVATE type
7730        - PetscInt        size_of_l2gmap
7731        - PetscInt        global_row_indices[size_of_l2gmap]
7732        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7733     */
7734   else {
7735     ierr = MatDenseGetArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7736     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7737     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7738     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7739     send_buffer_idxs[1] = i;
7740     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7741     ierr = PetscArraycpy(&send_buffer_idxs[2],ptr_idxs,i);CHKERRQ(ierr);
7742     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7743     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7744     for (i=0;i<n_sends;i++) {
7745       ilengths_vals[is_indices[i]] = len*len;
7746       ilengths_idxs[is_indices[i]] = len+2;
7747     }
7748   }
7749   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7750   /* additional is (if any) */
7751   if (nis) {
7752     PetscMPIInt psum;
7753     PetscInt j;
7754     for (j=0,psum=0;j<nis;j++) {
7755       PetscInt plen;
7756       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7757       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7758       psum += len+1; /* indices + lenght */
7759     }
7760     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7761     for (j=0,psum=0;j<nis;j++) {
7762       PetscInt plen;
7763       const PetscInt *is_array_idxs;
7764       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7765       send_buffer_idxs_is[psum] = plen;
7766       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7767       ierr = PetscArraycpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen);CHKERRQ(ierr);
7768       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7769       psum += plen+1; /* indices + lenght */
7770     }
7771     for (i=0;i<n_sends;i++) {
7772       ilengths_idxs_is[is_indices[i]] = psum;
7773     }
7774     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7775   }
7776   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7777 
7778   buf_size_idxs = 0;
7779   buf_size_vals = 0;
7780   buf_size_idxs_is = 0;
7781   buf_size_vecs = 0;
7782   for (i=0;i<n_recvs;i++) {
7783     buf_size_idxs += (PetscInt)olengths_idxs[i];
7784     buf_size_vals += (PetscInt)olengths_vals[i];
7785     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7786     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7787   }
7788   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7789   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7790   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7791   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7792 
7793   /* get new tags for clean communications */
7794   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7795   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7796   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7797   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7798 
7799   /* allocate for requests */
7800   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7801   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7802   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7803   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7804   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7805   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7806   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7807   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7808 
7809   /* communications */
7810   ptr_idxs = recv_buffer_idxs;
7811   ptr_vals = recv_buffer_vals;
7812   ptr_idxs_is = recv_buffer_idxs_is;
7813   ptr_vecs = recv_buffer_vecs;
7814   for (i=0;i<n_recvs;i++) {
7815     source_dest = onodes[i];
7816     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRMPI(ierr);
7817     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRMPI(ierr);
7818     ptr_idxs += olengths_idxs[i];
7819     ptr_vals += olengths_vals[i];
7820     if (nis) {
7821       source_dest = onodes_is[i];
7822       ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRMPI(ierr);
7823       ptr_idxs_is += olengths_idxs_is[i];
7824     }
7825     if (nvecs) {
7826       source_dest = onodes[i];
7827       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRMPI(ierr);
7828       ptr_vecs += olengths_idxs[i]-2;
7829     }
7830   }
7831   for (i=0;i<n_sends;i++) {
7832     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7833     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRMPI(ierr);
7834     ierr = MPI_Isend((PetscScalar*)send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRMPI(ierr);
7835     if (nis) {
7836       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]);CHKERRMPI(ierr);
7837     }
7838     if (nvecs) {
7839       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7840       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRMPI(ierr);
7841     }
7842   }
7843   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7844   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7845 
7846   /* assemble new l2g map */
7847   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
7848   ptr_idxs = recv_buffer_idxs;
7849   new_local_rows = 0;
7850   for (i=0;i<n_recvs;i++) {
7851     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7852     ptr_idxs += olengths_idxs[i];
7853   }
7854   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7855   ptr_idxs = recv_buffer_idxs;
7856   new_local_rows = 0;
7857   for (i=0;i<n_recvs;i++) {
7858     ierr = PetscArraycpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,*(ptr_idxs+1));CHKERRQ(ierr);
7859     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7860     ptr_idxs += olengths_idxs[i];
7861   }
7862   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7863   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7864   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7865 
7866   /* infer new local matrix type from received local matrices type */
7867   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7868   /* 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) */
7869   if (n_recvs) {
7870     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7871     ptr_idxs = recv_buffer_idxs;
7872     for (i=0;i<n_recvs;i++) {
7873       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7874         new_local_type_private = MATAIJ_PRIVATE;
7875         break;
7876       }
7877       ptr_idxs += olengths_idxs[i];
7878     }
7879     switch (new_local_type_private) {
7880       case MATDENSE_PRIVATE:
7881         new_local_type = MATSEQAIJ;
7882         bs = 1;
7883         break;
7884       case MATAIJ_PRIVATE:
7885         new_local_type = MATSEQAIJ;
7886         bs = 1;
7887         break;
7888       case MATBAIJ_PRIVATE:
7889         new_local_type = MATSEQBAIJ;
7890         break;
7891       case MATSBAIJ_PRIVATE:
7892         new_local_type = MATSEQSBAIJ;
7893         break;
7894       default:
7895         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7896     }
7897   } else { /* by default, new_local_type is seqaij */
7898     new_local_type = MATSEQAIJ;
7899     bs = 1;
7900   }
7901 
7902   /* create MATIS object if needed */
7903   if (!reuse) {
7904     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7905     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7906   } else {
7907     /* it also destroys the local matrices */
7908     if (*mat_n) {
7909       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7910     } else { /* this is a fake object */
7911       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7912     }
7913   }
7914   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7915   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7916 
7917   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
7918 
7919   /* Global to local map of received indices */
7920   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7921   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7922   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7923 
7924   /* restore attributes -> type of incoming data and its size */
7925   buf_size_idxs = 0;
7926   for (i=0;i<n_recvs;i++) {
7927     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7928     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7929     buf_size_idxs += (PetscInt)olengths_idxs[i];
7930   }
7931   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7932 
7933   /* set preallocation */
7934   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7935   if (!newisdense) {
7936     PetscInt *new_local_nnz=NULL;
7937 
7938     ptr_idxs = recv_buffer_idxs_local;
7939     if (n_recvs) {
7940       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7941     }
7942     for (i=0;i<n_recvs;i++) {
7943       PetscInt j;
7944       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7945         for (j=0;j<*(ptr_idxs+1);j++) {
7946           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7947         }
7948       } else {
7949         /* TODO */
7950       }
7951       ptr_idxs += olengths_idxs[i];
7952     }
7953     if (new_local_nnz) {
7954       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7955       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7956       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7957       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7958       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7959       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7960     } else {
7961       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7962     }
7963     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7964   } else {
7965     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7966   }
7967 
7968   /* set values */
7969   ptr_vals = recv_buffer_vals;
7970   ptr_idxs = recv_buffer_idxs_local;
7971   for (i=0;i<n_recvs;i++) {
7972     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7973       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7974       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7975       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7976       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7977       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7978     } else {
7979       /* TODO */
7980     }
7981     ptr_idxs += olengths_idxs[i];
7982     ptr_vals += olengths_vals[i];
7983   }
7984   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7985   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7986   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7987   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7988   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7989   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7990 
7991 #if 0
7992   if (!restrict_comm) { /* check */
7993     Vec       lvec,rvec;
7994     PetscReal infty_error;
7995 
7996     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7997     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7998     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7999     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
8000     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
8001     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8002     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
8003     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
8004     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
8005   }
8006 #endif
8007 
8008   /* assemble new additional is (if any) */
8009   if (nis) {
8010     PetscInt **temp_idxs,*count_is,j,psum;
8011 
8012     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
8013     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
8014     ptr_idxs = recv_buffer_idxs_is;
8015     psum = 0;
8016     for (i=0;i<n_recvs;i++) {
8017       for (j=0;j<nis;j++) {
8018         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8019         count_is[j] += plen; /* increment counting of buffer for j-th IS */
8020         psum += plen;
8021         ptr_idxs += plen+1; /* shift pointer to received data */
8022       }
8023     }
8024     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
8025     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
8026     for (i=1;i<nis;i++) {
8027       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
8028     }
8029     ierr = PetscArrayzero(count_is,nis);CHKERRQ(ierr);
8030     ptr_idxs = recv_buffer_idxs_is;
8031     for (i=0;i<n_recvs;i++) {
8032       for (j=0;j<nis;j++) {
8033         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
8034         ierr = PetscArraycpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen);CHKERRQ(ierr);
8035         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
8036         ptr_idxs += plen+1; /* shift pointer to received data */
8037       }
8038     }
8039     for (i=0;i<nis;i++) {
8040       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8041       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);
8042       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8043     }
8044     ierr = PetscFree(count_is);CHKERRQ(ierr);
8045     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
8046     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
8047   }
8048   /* free workspace */
8049   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
8050   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
8051   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
8052   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
8053   if (isdense) {
8054     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
8055     ierr = MatDenseRestoreArrayRead(local_mat,&send_buffer_vals);CHKERRQ(ierr);
8056     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
8057   } else {
8058     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
8059   }
8060   if (nis) {
8061     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
8062     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
8063   }
8064 
8065   if (nvecs) {
8066     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
8067     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRMPI(ierr);
8068     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8069     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8070     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
8071     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
8072     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
8073     /* set values */
8074     ptr_vals = recv_buffer_vecs;
8075     ptr_idxs = recv_buffer_idxs_local;
8076     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8077     for (i=0;i<n_recvs;i++) {
8078       PetscInt j;
8079       for (j=0;j<*(ptr_idxs+1);j++) {
8080         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
8081       }
8082       ptr_idxs += olengths_idxs[i];
8083       ptr_vals += olengths_idxs[i]-2;
8084     }
8085     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
8086     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
8087     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
8088   }
8089 
8090   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
8091   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
8092   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
8093   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
8094   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
8095   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
8096   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
8097   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
8098   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
8099   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
8100   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
8101   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
8102   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
8103   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
8104   ierr = PetscFree(onodes);CHKERRQ(ierr);
8105   if (nis) {
8106     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
8107     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
8108     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
8109   }
8110   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
8111   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
8112     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
8113     for (i=0;i<nis;i++) {
8114       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8115     }
8116     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
8117       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
8118     }
8119     *mat_n = NULL;
8120   }
8121   PetscFunctionReturn(0);
8122 }
8123 
8124 /* temporary hack into ksp private data structure */
8125 #include <petsc/private/kspimpl.h>
8126 
8127 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
8128 {
8129   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
8130   PC_IS                  *pcis = (PC_IS*)pc->data;
8131   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
8132   Mat                    coarsedivudotp = NULL;
8133   Mat                    coarseG,t_coarse_mat_is;
8134   MatNullSpace           CoarseNullSpace = NULL;
8135   ISLocalToGlobalMapping coarse_islg;
8136   IS                     coarse_is,*isarray,corners;
8137   PetscInt               i,im_active=-1,active_procs=-1;
8138   PetscInt               nis,nisdofs,nisneu,nisvert;
8139   PetscInt               coarse_eqs_per_proc;
8140   PC                     pc_temp;
8141   PCType                 coarse_pc_type;
8142   KSPType                coarse_ksp_type;
8143   PetscBool              multilevel_requested,multilevel_allowed;
8144   PetscBool              coarse_reuse;
8145   PetscInt               ncoarse,nedcfield;
8146   PetscBool              compute_vecs = PETSC_FALSE;
8147   PetscScalar            *array;
8148   MatReuse               coarse_mat_reuse;
8149   PetscBool              restr, full_restr, have_void;
8150   PetscMPIInt            size;
8151   PetscErrorCode         ierr;
8152 
8153   PetscFunctionBegin;
8154   ierr = PetscLogEventBegin(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8155   /* Assign global numbering to coarse dofs */
8156   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 */
8157     PetscInt ocoarse_size;
8158     compute_vecs = PETSC_TRUE;
8159 
8160     pcbddc->new_primal_space = PETSC_TRUE;
8161     ocoarse_size = pcbddc->coarse_size;
8162     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
8163     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
8164     /* see if we can avoid some work */
8165     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
8166       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
8167       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
8168         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
8169         coarse_reuse = PETSC_FALSE;
8170       } else { /* we can safely reuse already computed coarse matrix */
8171         coarse_reuse = PETSC_TRUE;
8172       }
8173     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
8174       coarse_reuse = PETSC_FALSE;
8175     }
8176     /* reset any subassembling information */
8177     if (!coarse_reuse || pcbddc->recompute_topography) {
8178       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8179     }
8180   } else { /* primal space is unchanged, so we can reuse coarse matrix */
8181     coarse_reuse = PETSC_TRUE;
8182   }
8183   if (coarse_reuse && pcbddc->coarse_ksp) {
8184     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
8185     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
8186     coarse_mat_reuse = MAT_REUSE_MATRIX;
8187   } else {
8188     coarse_mat = NULL;
8189     coarse_mat_reuse = MAT_INITIAL_MATRIX;
8190   }
8191 
8192   /* creates temporary l2gmap and IS for coarse indexes */
8193   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
8194   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
8195 
8196   /* creates temporary MATIS object for coarse matrix */
8197   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_submat_dense);CHKERRQ(ierr);
8198   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);
8199   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
8200   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8201   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
8202   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
8203 
8204   /* count "active" (i.e. with positive local size) and "void" processes */
8205   im_active = !!(pcis->n);
8206   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
8207 
8208   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
8209   /* restr : whether we want to exclude senders (which are not receivers) from the subassembling pattern */
8210   /* full_restr : just use the receivers from the subassembling pattern */
8211   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRMPI(ierr);
8212   coarse_mat_is        = NULL;
8213   multilevel_allowed   = PETSC_FALSE;
8214   multilevel_requested = PETSC_FALSE;
8215   coarse_eqs_per_proc  = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
8216   if (coarse_eqs_per_proc < 0) coarse_eqs_per_proc = pcbddc->coarse_size;
8217   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
8218   if (pcbddc->coarse_size <= pcbddc->coarse_eqs_limit) multilevel_requested = PETSC_FALSE;
8219   if (multilevel_requested) {
8220     ncoarse    = active_procs/pcbddc->coarsening_ratio;
8221     restr      = PETSC_FALSE;
8222     full_restr = PETSC_FALSE;
8223   } else {
8224     ncoarse    = pcbddc->coarse_size/coarse_eqs_per_proc + !!(pcbddc->coarse_size%coarse_eqs_per_proc);
8225     restr      = PETSC_TRUE;
8226     full_restr = PETSC_TRUE;
8227   }
8228   if (!pcbddc->coarse_size || size == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
8229   ncoarse = PetscMax(1,ncoarse);
8230   if (!pcbddc->coarse_subassembling) {
8231     if (pcbddc->coarsening_ratio > 1) {
8232       if (multilevel_requested) {
8233         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8234       } else {
8235         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
8236       }
8237     } else {
8238       PetscMPIInt rank;
8239 
8240       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRMPI(ierr);
8241       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
8242       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
8243     }
8244   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
8245     PetscInt    psum;
8246     if (pcbddc->coarse_ksp) psum = 1;
8247     else psum = 0;
8248     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
8249     have_void = ncoarse < size ? PETSC_TRUE : PETSC_FALSE;
8250   }
8251   /* determine if we can go multilevel */
8252   if (multilevel_requested) {
8253     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
8254     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
8255   }
8256   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
8257 
8258   /* dump subassembling pattern */
8259   if (pcbddc->dbg_flag && multilevel_allowed) {
8260     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
8261   }
8262   /* compute dofs splitting and neumann boundaries for coarse dofs */
8263   nedcfield = -1;
8264   corners = NULL;
8265   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal || pcbddc->corner_selected)) { /* protects from unneeded computations */
8266     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
8267     const PetscInt         *idxs;
8268     ISLocalToGlobalMapping tmap;
8269 
8270     /* create map between primal indices (in local representative ordering) and local primal numbering */
8271     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
8272     /* allocate space for temporary storage */
8273     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
8274     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
8275     /* allocate for IS array */
8276     nisdofs = pcbddc->n_ISForDofsLocal;
8277     if (pcbddc->nedclocal) {
8278       if (pcbddc->nedfield > -1) {
8279         nedcfield = pcbddc->nedfield;
8280       } else {
8281         nedcfield = 0;
8282         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%D)",nisdofs);
8283         nisdofs = 1;
8284       }
8285     }
8286     nisneu = !!pcbddc->NeumannBoundariesLocal;
8287     nisvert = 0; /* nisvert is not used */
8288     nis = nisdofs + nisneu + nisvert;
8289     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
8290     /* dofs splitting */
8291     for (i=0;i<nisdofs;i++) {
8292       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
8293       if (nedcfield != i) {
8294         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
8295         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8296         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8297         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
8298       } else {
8299         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
8300         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8301         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8302         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %D != %D",tsize,nout);
8303         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
8304       }
8305       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8306       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
8307       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
8308     }
8309     /* neumann boundaries */
8310     if (pcbddc->NeumannBoundariesLocal) {
8311       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
8312       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
8313       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8314       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8315       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
8316       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8317       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
8318       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
8319     }
8320     /* coordinates */
8321     if (pcbddc->corner_selected) {
8322       ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8323       ierr = ISGetLocalSize(corners,&tsize);CHKERRQ(ierr);
8324       ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8325       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
8326       if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping corners! %D != %D",tsize,nout);
8327       ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8328       ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&corners);CHKERRQ(ierr);
8329       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
8330       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&corners);CHKERRQ(ierr);
8331     }
8332     ierr = PetscFree(tidxs);CHKERRQ(ierr);
8333     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
8334     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
8335   } else {
8336     nis = 0;
8337     nisdofs = 0;
8338     nisneu = 0;
8339     nisvert = 0;
8340     isarray = NULL;
8341   }
8342   /* destroy no longer needed map */
8343   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
8344 
8345   /* subassemble */
8346   if (multilevel_allowed) {
8347     Vec       vp[1];
8348     PetscInt  nvecs = 0;
8349     PetscBool reuse,reuser;
8350 
8351     if (coarse_mat) reuse = PETSC_TRUE;
8352     else reuse = PETSC_FALSE;
8353     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
8354     vp[0] = NULL;
8355     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8356       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8357       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8358       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8359       nvecs = 1;
8360 
8361       if (pcbddc->divudotp) {
8362         Mat      B,loc_divudotp;
8363         Vec      v,p;
8364         IS       dummy;
8365         PetscInt np;
8366 
8367         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8368         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8369         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8370         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8371         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8372         ierr = VecSet(p,1.);CHKERRQ(ierr);
8373         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8374         ierr = VecDestroy(&p);CHKERRQ(ierr);
8375         ierr = MatDestroy(&B);CHKERRQ(ierr);
8376         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8377         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8378         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8379         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8380         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8381         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8382         ierr = VecDestroy(&v);CHKERRQ(ierr);
8383       }
8384     }
8385     if (reuser) {
8386       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8387     } else {
8388       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8389     }
8390     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8391       PetscScalar       *arraym;
8392       const PetscScalar *arrayv;
8393       PetscInt          nl;
8394       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8395       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8396       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8397       ierr = VecGetArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8398       ierr = PetscArraycpy(arraym,arrayv,nl);CHKERRQ(ierr);
8399       ierr = VecRestoreArrayRead(vp[0],&arrayv);CHKERRQ(ierr);
8400       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8401       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8402     } else {
8403       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8404     }
8405   } else {
8406     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8407   }
8408   if (coarse_mat_is || coarse_mat) {
8409     if (!multilevel_allowed) {
8410       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8411     } else {
8412       /* if this matrix is present, it means we are not reusing the coarse matrix */
8413       if (coarse_mat_is) {
8414         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8415         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8416         coarse_mat = coarse_mat_is;
8417       }
8418     }
8419   }
8420   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8421   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8422 
8423   /* create local to global scatters for coarse problem */
8424   if (compute_vecs) {
8425     PetscInt lrows;
8426     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8427     if (coarse_mat) {
8428       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8429     } else {
8430       lrows = 0;
8431     }
8432     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8433     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8434     ierr = VecSetType(pcbddc->coarse_vec,coarse_mat ? coarse_mat->defaultvectype : VECSTANDARD);CHKERRQ(ierr);
8435     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8436     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8437   }
8438   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8439 
8440   /* set defaults for coarse KSP and PC */
8441   if (multilevel_allowed) {
8442     coarse_ksp_type = KSPRICHARDSON;
8443     coarse_pc_type  = PCBDDC;
8444   } else {
8445     coarse_ksp_type = KSPPREONLY;
8446     coarse_pc_type  = PCREDUNDANT;
8447   }
8448 
8449   /* print some info if requested */
8450   if (pcbddc->dbg_flag) {
8451     if (!multilevel_allowed) {
8452       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8453       if (multilevel_requested) {
8454         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);
8455       } else if (pcbddc->max_levels) {
8456         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%D)\n",pcbddc->max_levels);CHKERRQ(ierr);
8457       }
8458       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8459     }
8460   }
8461 
8462   /* communicate coarse discrete gradient */
8463   coarseG = NULL;
8464   if (pcbddc->nedcG && multilevel_allowed) {
8465     MPI_Comm ccomm;
8466     if (coarse_mat) {
8467       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8468     } else {
8469       ccomm = MPI_COMM_NULL;
8470     }
8471     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8472   }
8473 
8474   /* create the coarse KSP object only once with defaults */
8475   if (coarse_mat) {
8476     PetscBool   isredundant,isbddc,force,valid;
8477     PetscViewer dbg_viewer = NULL;
8478 
8479     if (pcbddc->dbg_flag) {
8480       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8481       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8482     }
8483     if (!pcbddc->coarse_ksp) {
8484       char   prefix[256],str_level[16];
8485       size_t len;
8486 
8487       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8488       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8489       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8490       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8491       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8492       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8493       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8494       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8495       /* TODO is this logic correct? should check for coarse_mat type */
8496       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8497       /* prefix */
8498       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8499       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8500       if (!pcbddc->current_level) {
8501         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8502         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8503       } else {
8504         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8505         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8506         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8507         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8508         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8509         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8510         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8511       }
8512       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8513       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8514       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8515       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8516       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8517       /* allow user customization */
8518       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8519       /* get some info after set from options */
8520       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8521       /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8522       force = PETSC_FALSE;
8523       ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8524       ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8525       ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8526       if (multilevel_allowed && !force && !valid) {
8527         isbddc = PETSC_TRUE;
8528         ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8529         ierr   = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8530         ierr   = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8531         ierr   = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8532         if (pc_temp->ops->setfromoptions) { /* need to setfromoptions again, skipping the pc_type */
8533           ierr = PetscObjectOptionsBegin((PetscObject)pc_temp);CHKERRQ(ierr);
8534           ierr = (*pc_temp->ops->setfromoptions)(PetscOptionsObject,pc_temp);CHKERRQ(ierr);
8535           ierr = PetscObjectProcessOptionsHandlers(PetscOptionsObject,(PetscObject)pc_temp);CHKERRQ(ierr);
8536           ierr = PetscOptionsEnd();CHKERRQ(ierr);
8537           pc_temp->setfromoptionscalled++;
8538         }
8539       }
8540     }
8541     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8542     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8543     if (nisdofs) {
8544       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8545       for (i=0;i<nisdofs;i++) {
8546         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8547       }
8548     }
8549     if (nisneu) {
8550       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8551       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8552     }
8553     if (nisvert) {
8554       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8555       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8556     }
8557     if (coarseG) {
8558       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8559     }
8560 
8561     /* get some info after set from options */
8562     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8563 
8564     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8565     if (isbddc && !multilevel_allowed) {
8566       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8567     }
8568     /* multilevel cannot be done with coarse PC different from BDDC, NN, HPDDM, unless forced to */
8569     force = PETSC_FALSE;
8570     ierr = PetscOptionsGetBool(NULL,((PetscObject)pc_temp)->prefix,"-pc_type_forced",&force,NULL);CHKERRQ(ierr);
8571     ierr = PetscObjectTypeCompareAny((PetscObject)pc_temp,&valid,PCBDDC,PCNN,PCHPDDM,"");CHKERRQ(ierr);
8572     if (multilevel_requested && multilevel_allowed && !valid && !force) {
8573       ierr = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8574     }
8575     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8576     if (isredundant) {
8577       KSP inner_ksp;
8578       PC  inner_pc;
8579 
8580       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8581       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8582     }
8583 
8584     /* parameters which miss an API */
8585     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8586     if (isbddc) {
8587       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8588 
8589       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8590       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8591       pcbddc_coarse->coarse_eqs_limit    = pcbddc->coarse_eqs_limit;
8592       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8593       if (pcbddc_coarse->benign_saddle_point) {
8594         Mat                    coarsedivudotp_is;
8595         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8596         IS                     row,col;
8597         const PetscInt         *gidxs;
8598         PetscInt               n,st,M,N;
8599 
8600         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8601         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRMPI(ierr);
8602         st   = st-n;
8603         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8604         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8605         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8606         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8607         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8608         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8609         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8610         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8611         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8612         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8613         ierr = ISDestroy(&row);CHKERRQ(ierr);
8614         ierr = ISDestroy(&col);CHKERRQ(ierr);
8615         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8616         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8617         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8618         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8619         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8620         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8621         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8622         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8623         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8624         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8625         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8626         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8627       }
8628     }
8629 
8630     /* propagate symmetry info of coarse matrix */
8631     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8632     if (pc->pmat->symmetric_set) {
8633       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8634     }
8635     if (pc->pmat->hermitian_set) {
8636       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8637     }
8638     if (pc->pmat->spd_set) {
8639       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8640     }
8641     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8642       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8643     }
8644     /* set operators */
8645     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8646     ierr = MatSetOptionsPrefix(coarse_mat,((PetscObject)pcbddc->coarse_ksp)->prefix);CHKERRQ(ierr);
8647     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8648     if (pcbddc->dbg_flag) {
8649       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8650     }
8651   }
8652   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8653   ierr = PetscFree(isarray);CHKERRQ(ierr);
8654 #if 0
8655   {
8656     PetscViewer viewer;
8657     char filename[256];
8658     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8659     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8660     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8661     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8662     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8663     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8664   }
8665 #endif
8666 
8667   if (corners) {
8668     Vec            gv;
8669     IS             is;
8670     const PetscInt *idxs;
8671     PetscInt       i,d,N,n,cdim = pcbddc->mat_graph->cdim;
8672     PetscScalar    *coords;
8673 
8674     if (!pcbddc->mat_graph->cloc) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Missing local coordinates");
8675     ierr = VecGetSize(pcbddc->coarse_vec,&N);CHKERRQ(ierr);
8676     ierr = VecGetLocalSize(pcbddc->coarse_vec,&n);CHKERRQ(ierr);
8677     ierr = VecCreate(PetscObjectComm((PetscObject)pcbddc->coarse_vec),&gv);CHKERRQ(ierr);
8678     ierr = VecSetBlockSize(gv,cdim);CHKERRQ(ierr);
8679     ierr = VecSetSizes(gv,n*cdim,N*cdim);CHKERRQ(ierr);
8680     ierr = VecSetType(gv,VECSTANDARD);CHKERRQ(ierr);
8681     ierr = VecSetFromOptions(gv);CHKERRQ(ierr);
8682     ierr = VecSet(gv,PETSC_MAX_REAL);CHKERRQ(ierr); /* we only propagate coordinates from vertices constraints */
8683 
8684     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8685     ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
8686     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
8687     ierr = PetscMalloc1(n*cdim,&coords);CHKERRQ(ierr);
8688     for (i=0;i<n;i++) {
8689       for (d=0;d<cdim;d++) {
8690         coords[cdim*i+d] = pcbddc->mat_graph->coords[cdim*idxs[i]+d];
8691       }
8692     }
8693     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
8694     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&is);CHKERRQ(ierr);
8695 
8696     ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
8697     ierr = ISGetIndices(corners,&idxs);CHKERRQ(ierr);
8698     ierr = VecSetValuesBlocked(gv,n,idxs,coords,INSERT_VALUES);CHKERRQ(ierr);
8699     ierr = ISRestoreIndices(corners,&idxs);CHKERRQ(ierr);
8700     ierr = PetscFree(coords);CHKERRQ(ierr);
8701     ierr = VecAssemblyBegin(gv);CHKERRQ(ierr);
8702     ierr = VecAssemblyEnd(gv);CHKERRQ(ierr);
8703     ierr = VecGetArray(gv,&coords);CHKERRQ(ierr);
8704     if (pcbddc->coarse_ksp) {
8705       PC        coarse_pc;
8706       PetscBool isbddc;
8707 
8708       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
8709       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
8710       if (isbddc) { /* coarse coordinates have PETSC_MAX_REAL, specific for BDDC */
8711         PetscReal *realcoords;
8712 
8713         ierr = VecGetLocalSize(gv,&n);CHKERRQ(ierr);
8714 #if defined(PETSC_USE_COMPLEX)
8715         ierr = PetscMalloc1(n,&realcoords);CHKERRQ(ierr);
8716         for (i=0;i<n;i++) realcoords[i] = PetscRealPart(coords[i]);
8717 #else
8718         realcoords = coords;
8719 #endif
8720         ierr = PCSetCoordinates(coarse_pc,cdim,n/cdim,realcoords);CHKERRQ(ierr);
8721 #if defined(PETSC_USE_COMPLEX)
8722         ierr = PetscFree(realcoords);CHKERRQ(ierr);
8723 #endif
8724       }
8725     }
8726     ierr = VecRestoreArray(gv,&coords);CHKERRQ(ierr);
8727     ierr = VecDestroy(&gv);CHKERRQ(ierr);
8728   }
8729   ierr = ISDestroy(&corners);CHKERRQ(ierr);
8730 
8731   if (pcbddc->coarse_ksp) {
8732     Vec crhs,csol;
8733 
8734     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8735     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8736     if (!csol) {
8737       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8738     }
8739     if (!crhs) {
8740       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8741     }
8742   }
8743   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8744 
8745   /* compute null space for coarse solver if the benign trick has been requested */
8746   if (pcbddc->benign_null) {
8747 
8748     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8749     for (i=0;i<pcbddc->benign_n;i++) {
8750       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8751     }
8752     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8753     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8754     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8755     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8756     if (coarse_mat) {
8757       Vec         nullv;
8758       PetscScalar *array,*array2;
8759       PetscInt    nl;
8760 
8761       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8762       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8763       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8764       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8765       ierr = PetscArraycpy(array2,array,nl);CHKERRQ(ierr);
8766       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8767       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8768       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8769       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8770       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8771     }
8772   }
8773   ierr = PetscLogEventEnd(PC_BDDC_CoarseSetUp[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8774 
8775   ierr = PetscLogEventBegin(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8776   if (pcbddc->coarse_ksp) {
8777     PetscBool ispreonly;
8778 
8779     if (CoarseNullSpace) {
8780       PetscBool isnull;
8781       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8782       if (isnull) {
8783         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8784       }
8785       /* TODO: add local nullspaces (if any) */
8786     }
8787     /* setup coarse ksp */
8788     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8789     /* Check coarse problem if in debug mode or if solving with an iterative method */
8790     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8791     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates)) {
8792       KSP       check_ksp;
8793       KSPType   check_ksp_type;
8794       PC        check_pc;
8795       Vec       check_vec,coarse_vec;
8796       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8797       PetscInt  its;
8798       PetscBool compute_eigs;
8799       PetscReal *eigs_r,*eigs_c;
8800       PetscInt  neigs;
8801       const char *prefix;
8802 
8803       /* Create ksp object suitable for estimation of extreme eigenvalues */
8804       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8805       ierr = PetscObjectIncrementTabLevel((PetscObject)check_ksp,(PetscObject)pcbddc->coarse_ksp,0);CHKERRQ(ierr);
8806       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,PETSC_FALSE);CHKERRQ(ierr);
8807       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8808       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8809       /* prevent from setup unneeded object */
8810       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8811       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8812       if (ispreonly) {
8813         check_ksp_type = KSPPREONLY;
8814         compute_eigs = PETSC_FALSE;
8815       } else {
8816         check_ksp_type = KSPGMRES;
8817         compute_eigs = PETSC_TRUE;
8818       }
8819       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8820       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8821       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8822       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8823       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8824       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8825       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8826       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8827       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8828       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8829       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8830       /* create random vec */
8831       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8832       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8833       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8834       /* solve coarse problem */
8835       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8836       ierr = KSPCheckSolve(check_ksp,pc,coarse_vec);CHKERRQ(ierr);
8837       /* set eigenvalue estimation if preonly has not been requested */
8838       if (compute_eigs) {
8839         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8840         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8841         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8842         if (neigs) {
8843           lambda_max = eigs_r[neigs-1];
8844           lambda_min = eigs_r[0];
8845           if (pcbddc->use_coarse_estimates) {
8846             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8847               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8848               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8849             }
8850           }
8851         }
8852       }
8853 
8854       /* check coarse problem residual error */
8855       if (pcbddc->dbg_flag) {
8856         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8857         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8858         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8859         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8860         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8861         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8862         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8863         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8864         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8865         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8866         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8867         if (CoarseNullSpace) {
8868           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8869         }
8870         if (compute_eigs) {
8871           PetscReal          lambda_max_s,lambda_min_s;
8872           KSPConvergedReason reason;
8873           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8874           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8875           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8876           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8877           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);
8878           for (i=0;i<neigs;i++) {
8879             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8880           }
8881         }
8882         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8883         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8884       }
8885       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8886       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8887       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8888       if (compute_eigs) {
8889         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8890         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8891       }
8892     }
8893   }
8894   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8895   /* print additional info */
8896   if (pcbddc->dbg_flag) {
8897     /* waits until all processes reaches this point */
8898     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8899     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %D\n",pcbddc->current_level);CHKERRQ(ierr);
8900     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8901   }
8902 
8903   /* free memory */
8904   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8905   ierr = PetscLogEventEnd(PC_BDDC_CoarseSolver[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
8906   PetscFunctionReturn(0);
8907 }
8908 
8909 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8910 {
8911   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8912   PC_IS*         pcis = (PC_IS*)pc->data;
8913   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8914   IS             subset,subset_mult,subset_n;
8915   PetscInt       local_size,coarse_size=0;
8916   PetscInt       *local_primal_indices=NULL;
8917   const PetscInt *t_local_primal_indices;
8918   PetscErrorCode ierr;
8919 
8920   PetscFunctionBegin;
8921   /* Compute global number of coarse dofs */
8922   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8923   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8924   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8925   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8926   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8927   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8928   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8929   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8930   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8931   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);
8932   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8933   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8934   ierr = PetscArraycpy(local_primal_indices,t_local_primal_indices,local_size);CHKERRQ(ierr);
8935   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8936   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8937 
8938   /* check numbering */
8939   if (pcbddc->dbg_flag) {
8940     PetscScalar coarsesum,*array,*array2;
8941     PetscInt    i;
8942     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8943 
8944     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8945     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8946     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8947     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8948     /* counter */
8949     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8950     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8951     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8952     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8953     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8954     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8955     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8956     for (i=0;i<pcbddc->local_primal_size;i++) {
8957       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8958     }
8959     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8960     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8961     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8962     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8963     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8964     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8965     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8966     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8967     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8968     for (i=0;i<pcis->n;i++) {
8969       if (array[i] != 0.0 && array[i] != array2[i]) {
8970         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8971         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8972         set_error = PETSC_TRUE;
8973         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8974         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);
8975       }
8976     }
8977     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8978     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
8979     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8980     for (i=0;i<pcis->n;i++) {
8981       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8982     }
8983     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8984     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8985     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8986     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8987     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8988     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %D (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8989     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8990       PetscInt *gidxs;
8991 
8992       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8993       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8994       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8995       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8996       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8997       for (i=0;i<pcbddc->local_primal_size;i++) {
8998         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);
8999       }
9000       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9001       ierr = PetscFree(gidxs);CHKERRQ(ierr);
9002     }
9003     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9004     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9005     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
9006   }
9007 
9008   /* get back data */
9009   *coarse_size_n = coarse_size;
9010   *local_primal_indices_n = local_primal_indices;
9011   PetscFunctionReturn(0);
9012 }
9013 
9014 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
9015 {
9016   IS             localis_t;
9017   PetscInt       i,lsize,*idxs,n;
9018   PetscScalar    *vals;
9019   PetscErrorCode ierr;
9020 
9021   PetscFunctionBegin;
9022   /* get indices in local ordering exploiting local to global map */
9023   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
9024   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
9025   for (i=0;i<lsize;i++) vals[i] = 1.0;
9026   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9027   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
9028   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
9029   if (idxs) { /* multilevel guard */
9030     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
9031     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
9032   }
9033   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
9034   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
9035   ierr = PetscFree(vals);CHKERRQ(ierr);
9036   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
9037   /* now compute set in local ordering */
9038   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9039   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9040   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9041   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
9042   for (i=0,lsize=0;i<n;i++) {
9043     if (PetscRealPart(vals[i]) > 0.5) {
9044       lsize++;
9045     }
9046   }
9047   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
9048   for (i=0,lsize=0;i<n;i++) {
9049     if (PetscRealPart(vals[i]) > 0.5) {
9050       idxs[lsize++] = i;
9051     }
9052   }
9053   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
9054   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
9055   *localis = localis_t;
9056   PetscFunctionReturn(0);
9057 }
9058 
9059 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
9060 {
9061   PC_IS               *pcis=(PC_IS*)pc->data;
9062   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9063   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
9064   Mat                 S_j;
9065   PetscInt            *used_xadj,*used_adjncy;
9066   PetscBool           free_used_adj;
9067   PetscErrorCode      ierr;
9068 
9069   PetscFunctionBegin;
9070   ierr = PetscLogEventBegin(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9071   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
9072   free_used_adj = PETSC_FALSE;
9073   if (pcbddc->sub_schurs_layers == -1) {
9074     used_xadj = NULL;
9075     used_adjncy = NULL;
9076   } else {
9077     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
9078       used_xadj = pcbddc->mat_graph->xadj;
9079       used_adjncy = pcbddc->mat_graph->adjncy;
9080     } else if (pcbddc->computed_rowadj) {
9081       used_xadj = pcbddc->mat_graph->xadj;
9082       used_adjncy = pcbddc->mat_graph->adjncy;
9083     } else {
9084       PetscBool      flg_row=PETSC_FALSE;
9085       const PetscInt *xadj,*adjncy;
9086       PetscInt       nvtxs;
9087 
9088       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9089       if (flg_row) {
9090         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
9091         ierr = PetscArraycpy(used_xadj,xadj,nvtxs+1);CHKERRQ(ierr);
9092         ierr = PetscArraycpy(used_adjncy,adjncy,xadj[nvtxs]);CHKERRQ(ierr);
9093         free_used_adj = PETSC_TRUE;
9094       } else {
9095         pcbddc->sub_schurs_layers = -1;
9096         used_xadj = NULL;
9097         used_adjncy = NULL;
9098       }
9099       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
9100     }
9101   }
9102 
9103   /* setup sub_schurs data */
9104   ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9105   if (!sub_schurs->schur_explicit) {
9106     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
9107     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9108     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);
9109   } else {
9110     Mat       change = NULL;
9111     Vec       scaling = NULL;
9112     IS        change_primal = NULL, iP;
9113     PetscInt  benign_n;
9114     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
9115     PetscBool need_change = PETSC_FALSE;
9116     PetscBool discrete_harmonic = PETSC_FALSE;
9117 
9118     if (!pcbddc->use_vertices && reuse_solvers) {
9119       PetscInt n_vertices;
9120 
9121       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
9122       reuse_solvers = (PetscBool)!n_vertices;
9123     }
9124     if (!pcbddc->benign_change_explicit) {
9125       benign_n = pcbddc->benign_n;
9126     } else {
9127       benign_n = 0;
9128     }
9129     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
9130        We need a global reduction to avoid possible deadlocks.
9131        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
9132     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
9133       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
9134       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRMPI(ierr);
9135       need_change = (PetscBool)(!need_change);
9136     }
9137     /* If the user defines additional constraints, we import them here.
9138        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 */
9139     if (need_change) {
9140       PC_IS   *pcisf;
9141       PC_BDDC *pcbddcf;
9142       PC      pcf;
9143 
9144       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
9145       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
9146       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
9147       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
9148 
9149       /* hacks */
9150       pcisf                        = (PC_IS*)pcf->data;
9151       pcisf->is_B_local            = pcis->is_B_local;
9152       pcisf->vec1_N                = pcis->vec1_N;
9153       pcisf->BtoNmap               = pcis->BtoNmap;
9154       pcisf->n                     = pcis->n;
9155       pcisf->n_B                   = pcis->n_B;
9156       pcbddcf                      = (PC_BDDC*)pcf->data;
9157       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
9158       pcbddcf->mat_graph           = pcbddc->mat_graph;
9159       pcbddcf->use_faces           = PETSC_TRUE;
9160       pcbddcf->use_change_of_basis = PETSC_TRUE;
9161       pcbddcf->use_change_on_faces = PETSC_TRUE;
9162       pcbddcf->use_qr_single       = PETSC_TRUE;
9163       pcbddcf->fake_change         = PETSC_TRUE;
9164 
9165       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
9166       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
9167       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
9168       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
9169       change = pcbddcf->ConstraintMatrix;
9170       pcbddcf->ConstraintMatrix = NULL;
9171 
9172       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
9173       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
9174       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
9175       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
9176       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
9177       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
9178       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
9179       pcf->ops->destroy = NULL;
9180       pcf->ops->reset   = NULL;
9181       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
9182     }
9183     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
9184 
9185     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
9186     if (iP) {
9187       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
9188       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
9189       ierr = PetscOptionsEnd();CHKERRQ(ierr);
9190     }
9191     if (discrete_harmonic) {
9192       Mat A;
9193       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
9194       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
9195       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
9196       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);
9197       ierr = MatDestroy(&A);CHKERRQ(ierr);
9198     } else {
9199       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);
9200     }
9201     ierr = MatDestroy(&change);CHKERRQ(ierr);
9202     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
9203   }
9204   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9205 
9206   /* free adjacency */
9207   if (free_used_adj) {
9208     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
9209   }
9210   ierr = PetscLogEventEnd(PC_BDDC_Schurs[pcbddc->current_level],pc,0,0,0);CHKERRQ(ierr);
9211   PetscFunctionReturn(0);
9212 }
9213 
9214 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
9215 {
9216   PC_IS               *pcis=(PC_IS*)pc->data;
9217   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9218   PCBDDCGraph         graph;
9219   PetscErrorCode      ierr;
9220 
9221   PetscFunctionBegin;
9222   /* attach interface graph for determining subsets */
9223   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
9224     IS       verticesIS,verticescomm;
9225     PetscInt vsize,*idxs;
9226 
9227     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9228     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
9229     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9230     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
9231     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
9232     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
9233     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
9234     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
9235     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
9236     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
9237     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
9238   } else {
9239     graph = pcbddc->mat_graph;
9240   }
9241   /* print some info */
9242   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
9243     IS       vertices;
9244     PetscInt nv,nedges,nfaces;
9245     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
9246     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9247     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
9248     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9249     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
9250     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%D)\n",PetscGlobalRank,(int)nv,pcbddc->use_vertices);CHKERRQ(ierr);
9251     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%D)\n",PetscGlobalRank,(int)nedges,pcbddc->use_edges);CHKERRQ(ierr);
9252     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%D)\n",PetscGlobalRank,(int)nfaces,pcbddc->use_faces);CHKERRQ(ierr);
9253     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
9254     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
9255     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
9256   }
9257 
9258   /* sub_schurs init */
9259   if (!pcbddc->sub_schurs) {
9260     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
9261   }
9262   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);
9263 
9264   /* free graph struct */
9265   if (pcbddc->sub_schurs_rebuild) {
9266     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
9267   }
9268   PetscFunctionReturn(0);
9269 }
9270 
9271 PetscErrorCode PCBDDCCheckOperator(PC pc)
9272 {
9273   PC_IS               *pcis=(PC_IS*)pc->data;
9274   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
9275   PetscErrorCode      ierr;
9276 
9277   PetscFunctionBegin;
9278   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
9279     IS             zerodiag = NULL;
9280     Mat            S_j,B0_B=NULL;
9281     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
9282     PetscScalar    *p0_check,*array,*array2;
9283     PetscReal      norm;
9284     PetscInt       i;
9285 
9286     /* B0 and B0_B */
9287     if (zerodiag) {
9288       IS       dummy;
9289 
9290       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
9291       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
9292       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
9293       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
9294     }
9295     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
9296     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
9297     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
9298     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9299     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9300     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9301     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9302     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
9303     /* S_j */
9304     ierr = MatCreateSchurComplement(pcis->A_II,pcis->pA_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
9305     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
9306 
9307     /* mimic vector in \widetilde{W}_\Gamma */
9308     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
9309     /* continuous in primal space */
9310     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
9311     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9312     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9313     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9314     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
9315     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
9316     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9317     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9318     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9319     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9320     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9321     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9322     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
9323     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
9324 
9325     /* assemble rhs for coarse problem */
9326     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
9327     /* local with Schur */
9328     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
9329     if (zerodiag) {
9330       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9331       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
9332       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9333       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
9334     }
9335     /* sum on primal nodes the local contributions */
9336     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9337     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9338     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9339     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9340     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
9341     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
9342     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
9343     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
9344     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9345     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9346     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9347     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
9348     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9349     /* scale primal nodes (BDDC sums contibutions) */
9350     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
9351     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
9352     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
9353     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
9354     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
9355     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9356     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
9357     /* global: \widetilde{B0}_B w_\Gamma */
9358     if (zerodiag) {
9359       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
9360       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
9361       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
9362       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
9363     }
9364     /* BDDC */
9365     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
9366     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
9367 
9368     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
9369     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
9370     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
9371     ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);CHKERRQ(ierr);
9372     for (i=0;i<pcbddc->benign_n;i++) {
9373       ierr = PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%D] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));CHKERRQ(ierr);
9374     }
9375     ierr = PetscFree(p0_check);CHKERRQ(ierr);
9376     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
9377     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
9378     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
9379     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
9380     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
9381   }
9382   PetscFunctionReturn(0);
9383 }
9384 
9385 #include <../src/mat/impls/aij/mpi/mpiaij.h>
9386 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
9387 {
9388   Mat            At;
9389   IS             rows;
9390   PetscInt       rst,ren;
9391   PetscErrorCode ierr;
9392   PetscLayout    rmap;
9393 
9394   PetscFunctionBegin;
9395   rst = ren = 0;
9396   if (ccomm != MPI_COMM_NULL) {
9397     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
9398     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
9399     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
9400     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
9401     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
9402   }
9403   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
9404   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
9405   ierr = ISDestroy(&rows);CHKERRQ(ierr);
9406 
9407   if (ccomm != MPI_COMM_NULL) {
9408     Mat_MPIAIJ *a,*b;
9409     IS         from,to;
9410     Vec        gvec;
9411     PetscInt   lsize;
9412 
9413     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
9414     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
9415     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
9416     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
9417     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
9418     a    = (Mat_MPIAIJ*)At->data;
9419     b    = (Mat_MPIAIJ*)(*B)->data;
9420     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRMPI(ierr);
9421     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRMPI(ierr);
9422     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
9423     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9424     b->A = a->A;
9425     b->B = a->B;
9426 
9427     b->donotstash      = a->donotstash;
9428     b->roworiented     = a->roworiented;
9429     b->rowindices      = NULL;
9430     b->rowvalues       = NULL;
9431     b->getrowactive    = PETSC_FALSE;
9432 
9433     (*B)->rmap         = rmap;
9434     (*B)->factortype   = A->factortype;
9435     (*B)->assembled    = PETSC_TRUE;
9436     (*B)->insertmode   = NOT_SET_VALUES;
9437     (*B)->preallocated = PETSC_TRUE;
9438 
9439     if (a->colmap) {
9440 #if defined(PETSC_USE_CTABLE)
9441       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9442 #else
9443       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9444       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9445       ierr = PetscArraycpy(b->colmap,a->colmap,At->cmap->N);CHKERRQ(ierr);
9446 #endif
9447     } else b->colmap = NULL;
9448     if (a->garray) {
9449       PetscInt len;
9450       len  = a->B->cmap->n;
9451       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9452       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9453       if (len) { ierr = PetscArraycpy(b->garray,a->garray,len);CHKERRQ(ierr); }
9454     } else b->garray = NULL;
9455 
9456     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9457     b->lvec = a->lvec;
9458     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9459 
9460     /* cannot use VecScatterCopy */
9461     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9462     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9463     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9464     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9465     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9466     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9467     ierr = ISDestroy(&from);CHKERRQ(ierr);
9468     ierr = ISDestroy(&to);CHKERRQ(ierr);
9469     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9470   }
9471   ierr = MatDestroy(&At);CHKERRQ(ierr);
9472   PetscFunctionReturn(0);
9473 }
9474