xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 2958b453f9d98803cebf5c29aa0f73659373cd58)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
324   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
458   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
459   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
460   for (i=1,cum=0;i<n_neigh;i++) {
461     cum += n_shared[i];
462     for (j=0;j<n_shared[i];j++) {
463       ecount[shared[i][j]]++;
464     }
465   }
466   if (ne) {
467     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
468   }
469   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
470   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
471   for (i=1;i<n_neigh;i++) {
472     for (j=0;j<n_shared[i];j++) {
473       PetscInt k = shared[i][j];
474       eneighs[k][ecount[k]] = neigh[i];
475       ecount[k]++;
476     }
477   }
478   for (i=0;i<ne;i++) {
479     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
480   }
481   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
482   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
483   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
484   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
485   for (i=1,cum=0;i<n_neigh;i++) {
486     cum += n_shared[i];
487     for (j=0;j<n_shared[i];j++) {
488       vcount[shared[i][j]]++;
489     }
490   }
491   if (nv) {
492     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
493   }
494   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
495   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
496   for (i=1;i<n_neigh;i++) {
497     for (j=0;j<n_shared[i];j++) {
498       PetscInt k = shared[i][j];
499       vneighs[k][vcount[k]] = neigh[i];
500       vcount[k]++;
501     }
502   }
503   for (i=0;i<nv;i++) {
504     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
505   }
506   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
507 
508   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
509      for proper detection of coarse edges' endpoints */
510   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
511   for (i=0;i<ne;i++) {
512     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
513       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
514     }
515   }
516   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
517   if (!conforming) {
518     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
519     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
520   }
521   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
522   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
523   cum  = 0;
524   for (i=0;i<ne;i++) {
525     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
526     if (!PetscBTLookup(btee,i)) {
527       marks[cum++] = i;
528       continue;
529     }
530     /* set badly connected edge dofs as primal */
531     if (!conforming) {
532       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
533         marks[cum++] = i;
534         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
535         for (j=ii[i];j<ii[i+1];j++) {
536           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
537         }
538       } else {
539         /* every edge dofs should be connected trough a certain number of nodal dofs
540            to other edge dofs belonging to coarse edges
541            - at most 2 endpoints
542            - order-1 interior nodal dofs
543            - no undefined nodal dofs (nconn < order)
544         */
545         PetscInt ends = 0,ints = 0, undef = 0;
546         for (j=ii[i];j<ii[i+1];j++) {
547           PetscInt v = jj[j],k;
548           PetscInt nconn = iit[v+1]-iit[v];
549           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
550           if (nconn > order) ends++;
551           else if (nconn == order) ints++;
552           else undef++;
553         }
554         if (undef || ends > 2 || ints != order -1) {
555           marks[cum++] = i;
556           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
557           for (j=ii[i];j<ii[i+1];j++) {
558             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
559           }
560         }
561       }
562     }
563     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
564     if (!order && ii[i+1] != ii[i]) {
565       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
566       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
567     }
568   }
569   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
570   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
571   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
572   if (!conforming) {
573     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
574     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
575   }
576   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
577 
578   /* identify splitpoints and corner candidates */
579   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
580   if (print) {
581     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
582     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
583     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
584     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
585   }
586   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
587   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
588   for (i=0;i<nv;i++) {
589     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
590     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
591     if (!order) { /* variable order */
592       PetscReal vorder = 0.;
593 
594       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
595       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
596       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
597       ord  = 1;
598     }
599 #if defined(PETSC_USE_DEBUG)
600     if (test%ord) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected number of edge dofs %d connected with nodal dof %d with order %d",test,i,ord);
601 #endif
602     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
603       if (PetscBTLookup(btbd,jj[j])) {
604         bdir = PETSC_TRUE;
605         break;
606       }
607       if (vc != ecount[jj[j]]) {
608         sneighs = PETSC_FALSE;
609       } else {
610         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
611         for (k=0;k<vc;k++) {
612           if (vn[k] != en[k]) {
613             sneighs = PETSC_FALSE;
614             break;
615           }
616         }
617       }
618     }
619     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
620       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
621       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
622     } else if (test == ord) {
623       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
624         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
625         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
626       } else {
627         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
628         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
629       }
630     }
631   }
632   ierr = PetscFree(ecount);CHKERRQ(ierr);
633   ierr = PetscFree(vcount);CHKERRQ(ierr);
634   if (ne) {
635     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
636   }
637   if (nv) {
638     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
639   }
640   ierr = PetscFree(eneighs);CHKERRQ(ierr);
641   ierr = PetscFree(vneighs);CHKERRQ(ierr);
642   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
643 
644   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
645   if (order != 1) {
646     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
647     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
648     for (i=0;i<nv;i++) {
649       if (PetscBTLookup(btvcand,i)) {
650         PetscBool found = PETSC_FALSE;
651         for (j=ii[i];j<ii[i+1] && !found;j++) {
652           PetscInt k,e = jj[j];
653           if (PetscBTLookup(bte,e)) continue;
654           for (k=iit[e];k<iit[e+1];k++) {
655             PetscInt v = jjt[k];
656             if (v != i && PetscBTLookup(btvcand,v)) {
657               found = PETSC_TRUE;
658               break;
659             }
660           }
661         }
662         if (!found) {
663           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
664           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
665         } else {
666           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
667         }
668       }
669     }
670     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
671   }
672   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
673   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
674   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
675 
676   /* Get the local G^T explicitly */
677   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
678   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
679   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
680 
681   /* Mark interior nodal dofs */
682   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
683   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
684   for (i=1;i<n_neigh;i++) {
685     for (j=0;j<n_shared[i];j++) {
686       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
687     }
688   }
689   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
690 
691   /* communicate corners and splitpoints */
692   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
693   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
694   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
695   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
696 
697   if (print) {
698     IS tbz;
699 
700     cum = 0;
701     for (i=0;i<nv;i++)
702       if (sfvleaves[i])
703         vmarks[cum++] = i;
704 
705     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
706     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
707     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
708     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
709   }
710 
711   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
712   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
713   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
714   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
715 
716   /* Zero rows of lGt corresponding to identified corners
717      and interior nodal dofs */
718   cum = 0;
719   for (i=0;i<nv;i++) {
720     if (sfvleaves[i]) {
721       vmarks[cum++] = i;
722       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
723     }
724     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
725   }
726   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
727   if (print) {
728     IS tbz;
729 
730     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
731     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
732     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
733     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
734   }
735   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
736   ierr = PetscFree(vmarks);CHKERRQ(ierr);
737   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
738   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
739 
740   /* Recompute G */
741   ierr = MatDestroy(&lG);CHKERRQ(ierr);
742   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
743   if (print) {
744     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
745     ierr = MatView(lG,NULL);CHKERRQ(ierr);
746     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
747     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
748   }
749 
750   /* Get primal dofs (if any) */
751   cum = 0;
752   for (i=0;i<ne;i++) {
753     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
754   }
755   if (fl2g) {
756     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
757   }
758   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
759   if (print) {
760     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
761     ierr = ISView(primals,NULL);CHKERRQ(ierr);
762   }
763   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
764   /* TODO: what if the user passed in some of them ?  */
765   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
766   ierr = ISDestroy(&primals);CHKERRQ(ierr);
767 
768   /* Compute edge connectivity */
769   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
770   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
771   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
772   if (fl2g) {
773     PetscBT   btf;
774     PetscInt  *iia,*jja,*iiu,*jju;
775     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
776 
777     /* create CSR for all local dofs */
778     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
779     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
780       if (pcbddc->mat_graph->nvtxs_csr != n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid size of CSR graph %d. Should be %d\n",pcbddc->mat_graph->nvtxs_csr,n);
781       iiu = pcbddc->mat_graph->xadj;
782       jju = pcbddc->mat_graph->adjncy;
783     } else if (pcbddc->use_local_adj) {
784       rest = PETSC_TRUE;
785       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
786     } else {
787       free   = PETSC_TRUE;
788       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
789       iiu[0] = 0;
790       for (i=0;i<n;i++) {
791         iiu[i+1] = i+1;
792         jju[i]   = -1;
793       }
794     }
795 
796     /* import sizes of CSR */
797     iia[0] = 0;
798     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
799 
800     /* overwrite entries corresponding to the Nedelec field */
801     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
802     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
803     for (i=0;i<ne;i++) {
804       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
805       iia[idxs[i]+1] = ii[i+1]-ii[i];
806     }
807 
808     /* iia in CSR */
809     for (i=0;i<n;i++) iia[i+1] += iia[i];
810 
811     /* jja in CSR */
812     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
813     for (i=0;i<n;i++)
814       if (!PetscBTLookup(btf,i))
815         for (j=0;j<iiu[i+1]-iiu[i];j++)
816           jja[iia[i]+j] = jju[iiu[i]+j];
817 
818     /* map edge dofs connectivity */
819     if (jj) {
820       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
821       for (i=0;i<ne;i++) {
822         PetscInt e = idxs[i];
823         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
824       }
825     }
826     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
827     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
828     if (rest) {
829       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
830     }
831     if (free) {
832       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
833     }
834     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
835   } else {
836     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
837   }
838 
839   /* Analyze interface for edge dofs */
840   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
841   pcbddc->mat_graph->twodim = PETSC_FALSE;
842 
843   /* Get coarse edges in the edge space */
844   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
845   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
846 
847   if (fl2g) {
848     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
849     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
850     for (i=0;i<nee;i++) {
851       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
852     }
853   } else {
854     eedges  = alleedges;
855     primals = allprimals;
856   }
857 
858   /* Mark fine edge dofs with their coarse edge id */
859   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
860   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
861   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
862   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
863   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
864   if (print) {
865     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
866     ierr = ISView(primals,NULL);CHKERRQ(ierr);
867   }
868 
869   maxsize = 0;
870   for (i=0;i<nee;i++) {
871     PetscInt size,mark = i+1;
872 
873     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
874     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
875     for (j=0;j<size;j++) marks[idxs[j]] = mark;
876     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
877     maxsize = PetscMax(maxsize,size);
878   }
879 
880   /* Find coarse edge endpoints */
881   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
882   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
883   for (i=0;i<nee;i++) {
884     PetscInt mark = i+1,size;
885 
886     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
887     if (!size && nedfieldlocal) continue;
888     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
889     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
890     if (print) {
891       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
892       ISView(eedges[i],NULL);
893     }
894     for (j=0;j<size;j++) {
895       PetscInt k, ee = idxs[j];
896       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
897       for (k=ii[ee];k<ii[ee+1];k++) {
898         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
899         if (PetscBTLookup(btv,jj[k])) {
900           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
901         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
902           PetscInt  k2;
903           PetscBool corner = PETSC_FALSE;
904           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
905             if (print) PetscPrintf(PETSC_COMM_SELF,"        INSPECTING %d: mark %d (ref mark %d), boundary %d\n",jjt[k2],marks[jjt[k2]],mark,!!PetscBTLookup(btb,jjt[k2]));
906             /* it's a corner if either is connected with an edge dof belonging to a different cc or
907                if the edge dof lie on the natural part of the boundary */
908             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
909               corner = PETSC_TRUE;
910               break;
911             }
912           }
913           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
914             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
915             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
916           } else {
917             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
918           }
919         }
920       }
921     }
922     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
923   }
924   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
925   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
926   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
927 
928   /* Reset marked primal dofs */
929   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
930   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
931   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
932   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
933 
934   /* Now use the initial lG */
935   ierr = MatDestroy(&lG);CHKERRQ(ierr);
936   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
937   lG   = lGinit;
938   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
939 
940   /* Compute extended cols indices */
941   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
942   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
943   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
944   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
945   i   *= maxsize;
946   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
947   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
948   eerr = PETSC_FALSE;
949   for (i=0;i<nee;i++) {
950     PetscInt size,found = 0;
951 
952     cum  = 0;
953     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
954     if (!size && nedfieldlocal) continue;
955     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
956     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
957     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
958     for (j=0;j<size;j++) {
959       PetscInt k,ee = idxs[j];
960       for (k=ii[ee];k<ii[ee+1];k++) {
961         PetscInt vv = jj[k];
962         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
963         else if (!PetscBTLookupSet(btvc,vv)) found++;
964       }
965     }
966     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
967     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
968     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
969     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
970     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
971     /* it may happen that endpoints are not defined at this point
972        if it is the case, mark this edge for a second pass */
973     if (cum != size -1 || found != 2) {
974       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
975       if (print) {
976         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
977         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
978         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
979         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
980       }
981       eerr = PETSC_TRUE;
982     }
983   }
984   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
985   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
986   if (done) {
987     PetscInt *newprimals;
988 
989     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
990     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
991     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
992     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
993     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
994     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
995     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
996     for (i=0;i<nee;i++) {
997       PetscBool has_candidates = PETSC_FALSE;
998       if (PetscBTLookup(bter,i)) {
999         PetscInt size,mark = i+1;
1000 
1001         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1002         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1003         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1004         for (j=0;j<size;j++) {
1005           PetscInt k,ee = idxs[j];
1006           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1007           for (k=ii[ee];k<ii[ee+1];k++) {
1008             /* set all candidates located on the edge as corners */
1009             if (PetscBTLookup(btvcand,jj[k])) {
1010               PetscInt k2,vv = jj[k];
1011               has_candidates = PETSC_TRUE;
1012               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1013               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1014               /* set all edge dofs connected to candidate as primals */
1015               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1016                 if (marks[jjt[k2]] == mark) {
1017                   PetscInt k3,ee2 = jjt[k2];
1018                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1019                   newprimals[cum++] = ee2;
1020                   /* finally set the new corners */
1021                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1022                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1023                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1024                   }
1025                 }
1026               }
1027             } else {
1028               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1029             }
1030           }
1031         }
1032         if (!has_candidates) { /* circular edge */
1033           PetscInt k, ee = idxs[0],*tmarks;
1034 
1035           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1036           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1037           for (k=ii[ee];k<ii[ee+1];k++) {
1038             PetscInt k2;
1039             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1040             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1041             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1042           }
1043           for (j=0;j<size;j++) {
1044             if (tmarks[idxs[j]] > 1) {
1045               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1046               newprimals[cum++] = idxs[j];
1047             }
1048           }
1049           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1050         }
1051         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1052       }
1053       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1054     }
1055     ierr = PetscFree(extcols);CHKERRQ(ierr);
1056     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1057     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1058     if (fl2g) {
1059       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1060       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1061       for (i=0;i<nee;i++) {
1062         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1063       }
1064       ierr = PetscFree(eedges);CHKERRQ(ierr);
1065     }
1066     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1067     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1068     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1069     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1070     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1071     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1072     pcbddc->mat_graph->twodim = PETSC_FALSE;
1073     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1074     if (fl2g) {
1075       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1076       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1077       for (i=0;i<nee;i++) {
1078         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1079       }
1080     } else {
1081       eedges  = alleedges;
1082       primals = allprimals;
1083     }
1084     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1085 
1086     /* Mark again */
1087     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1088     for (i=0;i<nee;i++) {
1089       PetscInt size,mark = i+1;
1090 
1091       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1093       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1094       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     }
1096     if (print) {
1097       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1098       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1099     }
1100 
1101     /* Recompute extended cols */
1102     eerr = PETSC_FALSE;
1103     for (i=0;i<nee;i++) {
1104       PetscInt size;
1105 
1106       cum  = 0;
1107       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1108       if (!size && nedfieldlocal) continue;
1109       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1110       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1111       for (j=0;j<size;j++) {
1112         PetscInt k,ee = idxs[j];
1113         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1114       }
1115       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1116       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1117       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1118       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1119       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1120       if (cum != size -1) {
1121         if (print) {
1122           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1123           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1124           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1125           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1126         }
1127         eerr = PETSC_TRUE;
1128       }
1129     }
1130   }
1131   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1132   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1133   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1134   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1135   /* an error should not occur at this point */
1136   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1137 
1138   /* Check the number of endpoints */
1139   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1140   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1141   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1142   for (i=0;i<nee;i++) {
1143     PetscInt size, found = 0, gc[2];
1144 
1145     /* init with defaults */
1146     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1147     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1148     if (!size && nedfieldlocal) continue;
1149     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1150     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1151     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1152     for (j=0;j<size;j++) {
1153       PetscInt k,ee = idxs[j];
1154       for (k=ii[ee];k<ii[ee+1];k++) {
1155         PetscInt vv = jj[k];
1156         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1157           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1158           corners[i*2+found++] = vv;
1159         }
1160       }
1161     }
1162     if (found != 2) {
1163       PetscInt e;
1164       if (fl2g) {
1165         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1166       } else {
1167         e = idxs[0];
1168       }
1169       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1170     }
1171 
1172     /* get primal dof index on this coarse edge */
1173     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1174     if (gc[0] > gc[1]) {
1175       PetscInt swap  = corners[2*i];
1176       corners[2*i]   = corners[2*i+1];
1177       corners[2*i+1] = swap;
1178     }
1179     cedges[i] = idxs[size-1];
1180     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1181     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1182   }
1183   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1184   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1185 
1186 #if defined(PETSC_USE_DEBUG)
1187   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1188      not interfere with neighbouring coarse edges */
1189   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1190   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1191   for (i=0;i<nv;i++) {
1192     PetscInt emax = 0,eemax = 0;
1193 
1194     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1195     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1196     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1197     for (j=1;j<nee+1;j++) {
1198       if (emax < emarks[j]) {
1199         emax = emarks[j];
1200         eemax = j;
1201       }
1202     }
1203     /* not relevant for edges */
1204     if (!eemax) continue;
1205 
1206     for (j=ii[i];j<ii[i+1];j++) {
1207       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1208         SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_SUP,"Found 2 coarse edges (id %d and %d) connected through the %d nodal dof at edge dof %d\n",marks[jj[j]]-1,eemax,i,jj[j]);
1209       }
1210     }
1211   }
1212   ierr = PetscFree(emarks);CHKERRQ(ierr);
1213   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1214 #endif
1215 
1216   /* Compute extended rows indices for edge blocks of the change of basis */
1217   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1218   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1219   extmem *= maxsize;
1220   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1221   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1222   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1223   for (i=0;i<nv;i++) {
1224     PetscInt mark = 0,size,start;
1225 
1226     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1227     for (j=ii[i];j<ii[i+1];j++)
1228       if (marks[jj[j]] && !mark)
1229         mark = marks[jj[j]];
1230 
1231     /* not relevant */
1232     if (!mark) continue;
1233 
1234     /* import extended row */
1235     mark--;
1236     start = mark*extmem+extrowcum[mark];
1237     size = ii[i+1]-ii[i];
1238     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1239     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1240     extrowcum[mark] += size;
1241   }
1242   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1243   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1244   ierr = PetscFree(marks);CHKERRQ(ierr);
1245 
1246   /* Compress extrows */
1247   cum  = 0;
1248   for (i=0;i<nee;i++) {
1249     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1250     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1251     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1252     cum  = PetscMax(cum,size);
1253   }
1254   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1255   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1256   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1257 
1258   /* Workspace for lapack inner calls and VecSetValues */
1259   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1260 
1261   /* Create change of basis matrix (preallocation can be improved) */
1262   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1263   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1264                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1265   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1266   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1267   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1268   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1269   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1270   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1271   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1272 
1273   /* Defaults to identity */
1274   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1275   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1276   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1277   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1278 
1279   /* Create discrete gradient for the coarser level if needed */
1280   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1281   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1282   if (pcbddc->current_level < pcbddc->max_levels) {
1283     ISLocalToGlobalMapping cel2g,cvl2g;
1284     IS                     wis,gwis;
1285     PetscInt               cnv,cne;
1286 
1287     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1288     if (fl2g) {
1289       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1290     } else {
1291       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1292       pcbddc->nedclocal = wis;
1293     }
1294     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1295     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1296     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1297     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1298     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1299     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1300 
1301     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1302     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1303     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1304     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1305     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1306     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1307     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1308 
1309     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1310     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1311     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1312     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1313     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1314     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1315     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1316     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1317   }
1318   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1319 
1320 #if defined(PRINT_GDET)
1321   inc = 0;
1322   lev = pcbddc->current_level;
1323 #endif
1324 
1325   /* Insert values in the change of basis matrix */
1326   for (i=0;i<nee;i++) {
1327     Mat         Gins = NULL, GKins = NULL;
1328     IS          cornersis = NULL;
1329     PetscScalar cvals[2];
1330 
1331     if (pcbddc->nedcG) {
1332       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1333     }
1334     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1335     if (Gins && GKins) {
1336       PetscScalar    *data;
1337       const PetscInt *rows,*cols;
1338       PetscInt       nrh,nch,nrc,ncc;
1339 
1340       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1341       /* H1 */
1342       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1343       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1344       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1345       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1346       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1347       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1348       /* complement */
1349       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1350       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1351       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1352       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1353       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1354       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1355       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1356 
1357       /* coarse discrete gradient */
1358       if (pcbddc->nedcG) {
1359         PetscInt cols[2];
1360 
1361         cols[0] = 2*i;
1362         cols[1] = 2*i+1;
1363         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1364       }
1365       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1366     }
1367     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1368     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1369     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1370     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1371     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1372   }
1373   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1374 
1375   /* Start assembling */
1376   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1377   if (pcbddc->nedcG) {
1378     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1379   }
1380 
1381   /* Free */
1382   if (fl2g) {
1383     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1384     for (i=0;i<nee;i++) {
1385       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1386     }
1387     ierr = PetscFree(eedges);CHKERRQ(ierr);
1388   }
1389 
1390   /* hack mat_graph with primal dofs on the coarse edges */
1391   {
1392     PCBDDCGraph graph   = pcbddc->mat_graph;
1393     PetscInt    *oqueue = graph->queue;
1394     PetscInt    *ocptr  = graph->cptr;
1395     PetscInt    ncc,*idxs;
1396 
1397     /* find first primal edge */
1398     if (pcbddc->nedclocal) {
1399       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1400     } else {
1401       if (fl2g) {
1402         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1403       }
1404       idxs = cedges;
1405     }
1406     cum = 0;
1407     while (cum < nee && cedges[cum] < 0) cum++;
1408 
1409     /* adapt connected components */
1410     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1411     graph->cptr[0] = 0;
1412     for (i=0,ncc=0;i<graph->ncc;i++) {
1413       PetscInt lc = ocptr[i+1]-ocptr[i];
1414       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1415         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1416         graph->queue[graph->cptr[ncc]] = cedges[cum];
1417         ncc++;
1418         lc--;
1419         cum++;
1420         while (cum < nee && cedges[cum] < 0) cum++;
1421       }
1422       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1423       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1424       ncc++;
1425     }
1426     graph->ncc = ncc;
1427     if (pcbddc->nedclocal) {
1428       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1429     }
1430     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1431   }
1432   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1433   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1434   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1435   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1436 
1437   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1438   ierr = PetscFree(extrow);CHKERRQ(ierr);
1439   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1440   ierr = PetscFree(corners);CHKERRQ(ierr);
1441   ierr = PetscFree(cedges);CHKERRQ(ierr);
1442   ierr = PetscFree(extrows);CHKERRQ(ierr);
1443   ierr = PetscFree(extcols);CHKERRQ(ierr);
1444   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1445 
1446   /* Complete assembling */
1447   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1448   if (pcbddc->nedcG) {
1449     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1450 #if 0
1451     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1452     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1453 #endif
1454   }
1455 
1456   /* set change of basis */
1457   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1458   ierr = MatDestroy(&T);CHKERRQ(ierr);
1459 
1460   PetscFunctionReturn(0);
1461 }
1462 
1463 /* the near-null space of BDDC carries information on quadrature weights,
1464    and these can be collinear -> so cheat with MatNullSpaceCreate
1465    and create a suitable set of basis vectors first */
1466 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1467 {
1468   PetscErrorCode ierr;
1469   PetscInt       i;
1470 
1471   PetscFunctionBegin;
1472   for (i=0;i<nvecs;i++) {
1473     PetscInt first,last;
1474 
1475     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1476     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1477     if (i>=first && i < last) {
1478       PetscScalar *data;
1479       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1480       if (!has_const) {
1481         data[i-first] = 1.;
1482       } else {
1483         data[2*i-first] = 1./PetscSqrtReal(2.);
1484         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1485       }
1486       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1487     }
1488     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1489   }
1490   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1491   for (i=0;i<nvecs;i++) { /* reset vectors */
1492     PetscInt first,last;
1493     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1494     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1495     if (i>=first && i < last) {
1496       PetscScalar *data;
1497       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1498       if (!has_const) {
1499         data[i-first] = 0.;
1500       } else {
1501         data[2*i-first] = 0.;
1502         data[2*i-first+1] = 0.;
1503       }
1504       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1505     }
1506     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1507     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1508   }
1509   PetscFunctionReturn(0);
1510 }
1511 
1512 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1513 {
1514   Mat                    loc_divudotp;
1515   Vec                    p,v,vins,quad_vec,*quad_vecs;
1516   ISLocalToGlobalMapping map;
1517   PetscScalar            *vals;
1518   const PetscScalar      *array;
1519   PetscInt               i,maxneighs,maxsize;
1520   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1521   PetscMPIInt            rank;
1522   PetscErrorCode         ierr;
1523 
1524   PetscFunctionBegin;
1525   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1526   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1527   maxsize = 0;
1528   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1529   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1530   /* create vectors to hold quadrature weights */
1531   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1532   if (!transpose) {
1533     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1534   } else {
1535     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1536   }
1537   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1538   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1539   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1540   for (i=0;i<maxneighs;i++) {
1541     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1542     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1543   }
1544 
1545   /* compute local quad vec */
1546   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1547   if (!transpose) {
1548     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1549   } else {
1550     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1551   }
1552   ierr = VecSet(p,1.);CHKERRQ(ierr);
1553   if (!transpose) {
1554     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1555   } else {
1556     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1557   }
1558   if (vl2l) {
1559     Mat        lA;
1560     VecScatter sc;
1561 
1562     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1563     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1564     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1565     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1566     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1567     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1568   } else {
1569     vins = v;
1570   }
1571   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1572   ierr = VecDestroy(&p);CHKERRQ(ierr);
1573 
1574   /* insert in global quadrature vecs */
1575   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1576   for (i=0;i<n_neigh;i++) {
1577     const PetscInt    *idxs;
1578     PetscInt          idx,nn,j;
1579 
1580     idxs = shared[i];
1581     nn   = n_shared[i];
1582     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1583     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1584     idx  = -(idx+1);
1585     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1586   }
1587   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1588   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1589   if (vl2l) {
1590     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1591   }
1592   ierr = VecDestroy(&v);CHKERRQ(ierr);
1593   ierr = PetscFree(vals);CHKERRQ(ierr);
1594 
1595   /* assemble near null space */
1596   for (i=0;i<maxneighs;i++) {
1597     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1598   }
1599   for (i=0;i<maxneighs;i++) {
1600     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1601     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1602     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1603   }
1604   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1605   PetscFunctionReturn(0);
1606 }
1607 
1608 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1609 {
1610   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1611   PetscErrorCode ierr;
1612 
1613   PetscFunctionBegin;
1614   if (primalv) {
1615     if (pcbddc->user_primal_vertices_local) {
1616       IS list[2], newp;
1617 
1618       list[0] = primalv;
1619       list[1] = pcbddc->user_primal_vertices_local;
1620       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1621       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1622       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1623       pcbddc->user_primal_vertices_local = newp;
1624     } else {
1625       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1626     }
1627   }
1628   PetscFunctionReturn(0);
1629 }
1630 
1631 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1632 {
1633   PetscErrorCode ierr;
1634   Vec            local,global;
1635   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1636   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1637   PetscBool      monolithic = PETSC_FALSE;
1638 
1639   PetscFunctionBegin;
1640   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1641   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1642   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1643   /* need to convert from global to local topology information and remove references to information in global ordering */
1644   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1645   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1646   if (monolithic) { /* just get block size to properly compute vertices */
1647     if (pcbddc->vertex_size == 1) {
1648       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1649     }
1650     goto boundary;
1651   }
1652 
1653   if (pcbddc->user_provided_isfordofs) {
1654     if (pcbddc->n_ISForDofs) {
1655       PetscInt i;
1656       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1657       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1658         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1659         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1660       }
1661       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1662       pcbddc->n_ISForDofs = 0;
1663       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1664     }
1665   } else {
1666     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1667       DM dm;
1668 
1669       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1670       if (!dm) {
1671         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1672       }
1673       if (dm) {
1674         IS      *fields;
1675         PetscInt nf,i;
1676         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1677         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1678         for (i=0;i<nf;i++) {
1679           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1680           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1681         }
1682         ierr = PetscFree(fields);CHKERRQ(ierr);
1683         pcbddc->n_ISForDofsLocal = nf;
1684       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1685         PetscContainer   c;
1686 
1687         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1688         if (c) {
1689           MatISLocalFields lf;
1690           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1691           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1692         } else { /* fallback, create the default fields if bs > 1 */
1693           PetscInt i, n = matis->A->rmap->n;
1694           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1695           if (i > 1) {
1696             pcbddc->n_ISForDofsLocal = i;
1697             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1698             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1699               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1700             }
1701           }
1702         }
1703       }
1704     } else {
1705       PetscInt i;
1706       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1707         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1708       }
1709     }
1710   }
1711 
1712 boundary:
1713   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1714     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1715   } else if (pcbddc->DirichletBoundariesLocal) {
1716     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1717   }
1718   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1719     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1720   } else if (pcbddc->NeumannBoundariesLocal) {
1721     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1722   }
1723   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1724     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1725   }
1726   ierr = VecDestroy(&global);CHKERRQ(ierr);
1727   ierr = VecDestroy(&local);CHKERRQ(ierr);
1728   /* detect local disconnected subdomains if requested (use matis->A) */
1729   if (pcbddc->detect_disconnected) {
1730     IS       primalv = NULL;
1731     PetscInt i;
1732 
1733     for (i=0;i<pcbddc->n_local_subs;i++) {
1734       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1735     }
1736     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1737     ierr = PCBDDCDetectDisconnectedComponents(pc,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1738     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1739     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1740   }
1741   /* early stage corner detection */
1742   {
1743     DM dm;
1744 
1745     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1746     if (dm) {
1747       PetscBool isda;
1748 
1749       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1750       if (isda) {
1751         ISLocalToGlobalMapping l2l;
1752         IS                     corners;
1753         Mat                    lA;
1754 
1755         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1756         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1757         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1758         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1759         if (l2l) {
1760           const PetscInt *idx;
1761           PetscInt       bs,*idxout,n;
1762 
1763           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1764           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1765           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1766           ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1767           ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1768           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1769           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1770           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1771           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1772           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1773         } else { /* not from DMDA */
1774           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1775         }
1776       }
1777     }
1778   }
1779   PetscFunctionReturn(0);
1780 }
1781 
1782 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1783 {
1784   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1785   PetscErrorCode  ierr;
1786   IS              nis;
1787   const PetscInt  *idxs;
1788   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1789   PetscBool       *ld;
1790 
1791   PetscFunctionBegin;
1792   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1793   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1794   if (mop == MPI_LAND) {
1795     /* init rootdata with true */
1796     ld   = (PetscBool*) matis->sf_rootdata;
1797     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1798   } else {
1799     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1800   }
1801   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1802   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1803   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1804   ld   = (PetscBool*) matis->sf_leafdata;
1805   for (i=0;i<nd;i++)
1806     if (-1 < idxs[i] && idxs[i] < n)
1807       ld[idxs[i]] = PETSC_TRUE;
1808   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1809   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1810   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1811   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1812   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1813   if (mop == MPI_LAND) {
1814     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1815   } else {
1816     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1817   }
1818   for (i=0,nnd=0;i<n;i++)
1819     if (ld[i])
1820       nidxs[nnd++] = i;
1821   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1822   ierr = ISDestroy(is);CHKERRQ(ierr);
1823   *is  = nis;
1824   PetscFunctionReturn(0);
1825 }
1826 
1827 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1828 {
1829   PC_IS             *pcis = (PC_IS*)(pc->data);
1830   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1831   PetscErrorCode    ierr;
1832 
1833   PetscFunctionBegin;
1834   if (!pcbddc->benign_have_null) {
1835     PetscFunctionReturn(0);
1836   }
1837   if (pcbddc->ChangeOfBasisMatrix) {
1838     Vec swap;
1839 
1840     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1841     swap = pcbddc->work_change;
1842     pcbddc->work_change = r;
1843     r = swap;
1844   }
1845   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1846   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1847   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1848   ierr = VecSet(z,0.);CHKERRQ(ierr);
1849   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1850   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1851   if (pcbddc->ChangeOfBasisMatrix) {
1852     pcbddc->work_change = r;
1853     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1854     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1855   }
1856   PetscFunctionReturn(0);
1857 }
1858 
1859 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1860 {
1861   PCBDDCBenignMatMult_ctx ctx;
1862   PetscErrorCode          ierr;
1863   PetscBool               apply_right,apply_left,reset_x;
1864 
1865   PetscFunctionBegin;
1866   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1867   if (transpose) {
1868     apply_right = ctx->apply_left;
1869     apply_left = ctx->apply_right;
1870   } else {
1871     apply_right = ctx->apply_right;
1872     apply_left = ctx->apply_left;
1873   }
1874   reset_x = PETSC_FALSE;
1875   if (apply_right) {
1876     const PetscScalar *ax;
1877     PetscInt          nl,i;
1878 
1879     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1880     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1881     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1882     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1883     for (i=0;i<ctx->benign_n;i++) {
1884       PetscScalar    sum,val;
1885       const PetscInt *idxs;
1886       PetscInt       nz,j;
1887       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1888       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1889       sum = 0.;
1890       if (ctx->apply_p0) {
1891         val = ctx->work[idxs[nz-1]];
1892         for (j=0;j<nz-1;j++) {
1893           sum += ctx->work[idxs[j]];
1894           ctx->work[idxs[j]] += val;
1895         }
1896       } else {
1897         for (j=0;j<nz-1;j++) {
1898           sum += ctx->work[idxs[j]];
1899         }
1900       }
1901       ctx->work[idxs[nz-1]] -= sum;
1902       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1903     }
1904     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1905     reset_x = PETSC_TRUE;
1906   }
1907   if (transpose) {
1908     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1909   } else {
1910     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1911   }
1912   if (reset_x) {
1913     ierr = VecResetArray(x);CHKERRQ(ierr);
1914   }
1915   if (apply_left) {
1916     PetscScalar *ay;
1917     PetscInt    i;
1918 
1919     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1920     for (i=0;i<ctx->benign_n;i++) {
1921       PetscScalar    sum,val;
1922       const PetscInt *idxs;
1923       PetscInt       nz,j;
1924       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1925       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1926       val = -ay[idxs[nz-1]];
1927       if (ctx->apply_p0) {
1928         sum = 0.;
1929         for (j=0;j<nz-1;j++) {
1930           sum += ay[idxs[j]];
1931           ay[idxs[j]] += val;
1932         }
1933         ay[idxs[nz-1]] += sum;
1934       } else {
1935         for (j=0;j<nz-1;j++) {
1936           ay[idxs[j]] += val;
1937         }
1938         ay[idxs[nz-1]] = 0.;
1939       }
1940       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1941     }
1942     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1943   }
1944   PetscFunctionReturn(0);
1945 }
1946 
1947 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1948 {
1949   PetscErrorCode ierr;
1950 
1951   PetscFunctionBegin;
1952   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1953   PetscFunctionReturn(0);
1954 }
1955 
1956 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1957 {
1958   PetscErrorCode ierr;
1959 
1960   PetscFunctionBegin;
1961   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1962   PetscFunctionReturn(0);
1963 }
1964 
1965 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1966 {
1967   PC_IS                   *pcis = (PC_IS*)pc->data;
1968   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1969   PCBDDCBenignMatMult_ctx ctx;
1970   PetscErrorCode          ierr;
1971 
1972   PetscFunctionBegin;
1973   if (!restore) {
1974     Mat                A_IB,A_BI;
1975     PetscScalar        *work;
1976     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1977 
1978     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1979     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1980     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1981     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1982     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1983     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1984     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1985     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1986     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1987     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1988     ctx->apply_left = PETSC_TRUE;
1989     ctx->apply_right = PETSC_FALSE;
1990     ctx->apply_p0 = PETSC_FALSE;
1991     ctx->benign_n = pcbddc->benign_n;
1992     if (reuse) {
1993       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1994       ctx->free = PETSC_FALSE;
1995     } else { /* TODO: could be optimized for successive solves */
1996       ISLocalToGlobalMapping N_to_D;
1997       PetscInt               i;
1998 
1999       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2000       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2001       for (i=0;i<pcbddc->benign_n;i++) {
2002         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2003       }
2004       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2005       ctx->free = PETSC_TRUE;
2006     }
2007     ctx->A = pcis->A_IB;
2008     ctx->work = work;
2009     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2010     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2011     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2012     pcis->A_IB = A_IB;
2013 
2014     /* A_BI as A_IB^T */
2015     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2016     pcbddc->benign_original_mat = pcis->A_BI;
2017     pcis->A_BI = A_BI;
2018   } else {
2019     if (!pcbddc->benign_original_mat) {
2020       PetscFunctionReturn(0);
2021     }
2022     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2023     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2024     pcis->A_IB = ctx->A;
2025     ctx->A = NULL;
2026     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2027     pcis->A_BI = pcbddc->benign_original_mat;
2028     pcbddc->benign_original_mat = NULL;
2029     if (ctx->free) {
2030       PetscInt i;
2031       for (i=0;i<ctx->benign_n;i++) {
2032         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2033       }
2034       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2035     }
2036     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2037     ierr = PetscFree(ctx);CHKERRQ(ierr);
2038   }
2039   PetscFunctionReturn(0);
2040 }
2041 
2042 /* used just in bddc debug mode */
2043 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2044 {
2045   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2046   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2047   Mat            An;
2048   PetscErrorCode ierr;
2049 
2050   PetscFunctionBegin;
2051   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2052   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2053   if (is1) {
2054     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2055     ierr = MatDestroy(&An);CHKERRQ(ierr);
2056   } else {
2057     *B = An;
2058   }
2059   PetscFunctionReturn(0);
2060 }
2061 
2062 /* TODO: add reuse flag */
2063 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2064 {
2065   Mat            Bt;
2066   PetscScalar    *a,*bdata;
2067   const PetscInt *ii,*ij;
2068   PetscInt       m,n,i,nnz,*bii,*bij;
2069   PetscBool      flg_row;
2070   PetscErrorCode ierr;
2071 
2072   PetscFunctionBegin;
2073   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2074   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2075   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2076   nnz = n;
2077   for (i=0;i<ii[n];i++) {
2078     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2079   }
2080   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2081   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2082   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2083   nnz = 0;
2084   bii[0] = 0;
2085   for (i=0;i<n;i++) {
2086     PetscInt j;
2087     for (j=ii[i];j<ii[i+1];j++) {
2088       PetscScalar entry = a[j];
2089       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2090         bij[nnz] = ij[j];
2091         bdata[nnz] = entry;
2092         nnz++;
2093       }
2094     }
2095     bii[i+1] = nnz;
2096   }
2097   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2098   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2099   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2100   {
2101     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2102     b->free_a = PETSC_TRUE;
2103     b->free_ij = PETSC_TRUE;
2104   }
2105   if (*B == A) {
2106     ierr = MatDestroy(&A);CHKERRQ(ierr);
2107   }
2108   *B = Bt;
2109   PetscFunctionReturn(0);
2110 }
2111 
2112 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscInt *ncc, IS* cc[], IS* primalv)
2113 {
2114   Mat                    B = NULL;
2115   DM                     dm;
2116   IS                     is_dummy,*cc_n;
2117   ISLocalToGlobalMapping l2gmap_dummy;
2118   PCBDDCGraph            graph;
2119   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2120   PetscInt               i,n;
2121   PetscInt               *xadj,*adjncy;
2122   PetscBool              isplex = PETSC_FALSE;
2123   PetscErrorCode         ierr;
2124 
2125   PetscFunctionBegin;
2126   if (ncc) *ncc = 0;
2127   if (cc) *cc = NULL;
2128   if (primalv) *primalv = NULL;
2129   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2130   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2131   if (!dm) {
2132     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2133   }
2134   if (dm) {
2135     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2136   }
2137   if (isplex) { /* this code has been modified from plexpartition.c */
2138     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2139     PetscInt      *adj = NULL;
2140     IS             cellNumbering;
2141     const PetscInt *cellNum;
2142     PetscBool      useCone, useClosure;
2143     PetscSection   section;
2144     PetscSegBuffer adjBuffer;
2145     PetscSF        sfPoint;
2146     PetscErrorCode ierr;
2147 
2148     PetscFunctionBegin;
2149     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2150     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2151     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2152     /* Build adjacency graph via a section/segbuffer */
2153     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2154     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2155     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2156     /* Always use FVM adjacency to create partitioner graph */
2157     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2158     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2159     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2160     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2161     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2162     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2163     for (n = 0, p = pStart; p < pEnd; p++) {
2164       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2165       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2166       adjSize = PETSC_DETERMINE;
2167       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2168       for (a = 0; a < adjSize; ++a) {
2169         const PetscInt point = adj[a];
2170         if (pStart <= point && point < pEnd) {
2171           PetscInt *PETSC_RESTRICT pBuf;
2172           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2173           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2174           *pBuf = point;
2175         }
2176       }
2177       n++;
2178     }
2179     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2180     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2181     /* Derive CSR graph from section/segbuffer */
2182     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2183     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2184     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2185     for (idx = 0, p = pStart; p < pEnd; p++) {
2186       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2187       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2188     }
2189     xadj[n] = size;
2190     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2191     /* Clean up */
2192     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2193     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2194     ierr = PetscFree(adj);CHKERRQ(ierr);
2195     graph->xadj = xadj;
2196     graph->adjncy = adjncy;
2197   } else {
2198     Mat       A;
2199     PetscBool filter = PETSC_FALSE, isseqaij, flg_row;
2200 
2201     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2202     if (!A->rmap->N || !A->cmap->N) {
2203       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2204       PetscFunctionReturn(0);
2205     }
2206     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2207     if (!isseqaij && filter) {
2208       PetscBool isseqdense;
2209 
2210       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2211       if (!isseqdense) {
2212         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2213       } else { /* TODO: rectangular case and LDA */
2214         PetscScalar *array;
2215         PetscReal   chop=1.e-6;
2216 
2217         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2218         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2219         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2220         for (i=0;i<n;i++) {
2221           PetscInt j;
2222           for (j=i+1;j<n;j++) {
2223             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2224             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2225             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2226           }
2227         }
2228         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2229         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2230       }
2231     } else {
2232       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2233       B = A;
2234     }
2235     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2236 
2237     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2238     if (filter) {
2239       PetscScalar *data;
2240       PetscInt    j,cum;
2241 
2242       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2243       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2244       cum = 0;
2245       for (i=0;i<n;i++) {
2246         PetscInt t;
2247 
2248         for (j=xadj[i];j<xadj[i+1];j++) {
2249           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2250             continue;
2251           }
2252           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2253         }
2254         t = xadj_filtered[i];
2255         xadj_filtered[i] = cum;
2256         cum += t;
2257       }
2258       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2259       graph->xadj = xadj_filtered;
2260       graph->adjncy = adjncy_filtered;
2261     } else {
2262       graph->xadj = xadj;
2263       graph->adjncy = adjncy;
2264     }
2265   }
2266   /* compute local connected components using PCBDDCGraph */
2267   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2268   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2269   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2270   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2271   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2272   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2273   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2274 
2275   /* partial clean up */
2276   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2277   if (B) {
2278     PetscBool flg_row;
2279     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2280     ierr = MatDestroy(&B);CHKERRQ(ierr);
2281   }
2282   if (isplex) {
2283     ierr = PetscFree(xadj);CHKERRQ(ierr);
2284     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2285   }
2286 
2287   /* get back data */
2288   if (isplex) {
2289     if (ncc) *ncc = graph->ncc;
2290     if (cc || primalv) {
2291       Mat          A;
2292       PetscBT      btv,btvt;
2293       PetscSection subSection;
2294       PetscInt     *ids,cum,cump,*cids,*pids;
2295 
2296       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2297       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2298       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2299       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2300       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2301 
2302       cids[0] = 0;
2303       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2304         PetscInt j;
2305 
2306         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2307         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2308           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2309 
2310           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2311           for (k = 0; k < 2*size; k += 2) {
2312             PetscInt s, p = closure[k], off, dof, cdof;
2313 
2314             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2315             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2316             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2317             for (s = 0; s < dof-cdof; s++) {
2318               if (PetscBTLookupSet(btvt,off+s)) continue;
2319               if (!PetscBTLookup(btv,off+s)) {
2320                 ids[cum++] = off+s;
2321               } else { /* cross-vertex */
2322                 pids[cump++] = off+s;
2323               }
2324             }
2325           }
2326           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2327         }
2328         cids[i+1] = cum;
2329         /* mark dofs as already assigned */
2330         for (j = cids[i]; j < cids[i+1]; j++) {
2331           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2332         }
2333       }
2334       if (cc) {
2335         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2336         for (i = 0; i < graph->ncc; i++) {
2337           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2338         }
2339         *cc = cc_n;
2340       }
2341       if (primalv) {
2342         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2343       }
2344       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2345       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2346       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2347     }
2348   } else {
2349     if (ncc) *ncc = graph->ncc;
2350     if (cc) {
2351       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2352       for (i=0;i<graph->ncc;i++) {
2353         ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],graph->queue+graph->cptr[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2354       }
2355       *cc = cc_n;
2356     }
2357   }
2358   /* clean up graph */
2359   graph->xadj = 0;
2360   graph->adjncy = 0;
2361   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2362   PetscFunctionReturn(0);
2363 }
2364 
2365 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2366 {
2367   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2368   PC_IS*         pcis = (PC_IS*)(pc->data);
2369   IS             dirIS = NULL;
2370   PetscInt       i;
2371   PetscErrorCode ierr;
2372 
2373   PetscFunctionBegin;
2374   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2375   if (zerodiag) {
2376     Mat            A;
2377     Vec            vec3_N;
2378     PetscScalar    *vals;
2379     const PetscInt *idxs;
2380     PetscInt       nz,*count;
2381 
2382     /* p0 */
2383     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2384     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2385     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2386     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2387     for (i=0;i<nz;i++) vals[i] = 1.;
2388     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2389     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2390     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2391     /* v_I */
2392     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2393     for (i=0;i<nz;i++) vals[i] = 0.;
2394     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2395     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2396     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2397     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2398     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2399     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2400     if (dirIS) {
2401       PetscInt n;
2402 
2403       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2404       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2405       for (i=0;i<n;i++) vals[i] = 0.;
2406       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2407       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2408     }
2409     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2410     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2411     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2412     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2413     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2414     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2415     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2416     if (PetscAbsScalar(vals[0]) > 1.e-1) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! b(v_I,p_0) = %1.6e (should be numerically 0.)",PetscAbsScalar(vals[0]));
2417     ierr = PetscFree(vals);CHKERRQ(ierr);
2418     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2419 
2420     /* there should not be any pressure dofs lying on the interface */
2421     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2422     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2423     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2424     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2425     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2426     for (i=0;i<nz;i++) if (count[idxs[i]]) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Benign trick can not be applied! pressure dof %d is an interface dof",idxs[i]);
2427     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2428     ierr = PetscFree(count);CHKERRQ(ierr);
2429   }
2430   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2431 
2432   /* check PCBDDCBenignGetOrSetP0 */
2433   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2434   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2435   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2436   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2437   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2438   for (i=0;i<pcbddc->benign_n;i++) {
2439     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2440     if (val != -PetscGlobalRank-i) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error testing PCBDDCBenignGetOrSetP0! Found %g at %d instead of %g\n",PetscRealPart(pcbddc->benign_p0[i]),i,-PetscGlobalRank-i);
2441   }
2442   PetscFunctionReturn(0);
2443 }
2444 
2445 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2446 {
2447   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2448   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2449   PetscInt       nz,n;
2450   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2451   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2452   PetscErrorCode ierr;
2453 
2454   PetscFunctionBegin;
2455   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2456   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2457   for (n=0;n<pcbddc->benign_n;n++) {
2458     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2459   }
2460   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2461   pcbddc->benign_n = 0;
2462 
2463   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2464      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2465      Checks if all the pressure dofs in each subdomain have a zero diagonal
2466      If not, a change of basis on pressures is not needed
2467      since the local Schur complements are already SPD
2468   */
2469   has_null_pressures = PETSC_TRUE;
2470   have_null = PETSC_TRUE;
2471   if (pcbddc->n_ISForDofsLocal) {
2472     IS       iP = NULL;
2473     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2474 
2475     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2476     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2477     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2478     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2479     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2480     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2481     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2482     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2483     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2484     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2485     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2486     if (iP) {
2487       IS newpressures;
2488 
2489       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2490       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2491       pressures = newpressures;
2492     }
2493     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2494     if (!sorted) {
2495       ierr = ISSort(pressures);CHKERRQ(ierr);
2496     }
2497   } else {
2498     pressures = NULL;
2499   }
2500   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2501   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2502   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2503   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2504   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2505   if (!sorted) {
2506     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2507   }
2508   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2509   zerodiag_save = zerodiag;
2510   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2511   if (!nz) {
2512     if (n) have_null = PETSC_FALSE;
2513     has_null_pressures = PETSC_FALSE;
2514     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2515   }
2516   recompute_zerodiag = PETSC_FALSE;
2517   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2518   zerodiag_subs    = NULL;
2519   pcbddc->benign_n = 0;
2520   n_interior_dofs  = 0;
2521   interior_dofs    = NULL;
2522   nneu             = 0;
2523   if (pcbddc->NeumannBoundariesLocal) {
2524     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2525   }
2526   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2527   if (checkb) { /* need to compute interior nodes */
2528     PetscInt n,i,j;
2529     PetscInt n_neigh,*neigh,*n_shared,**shared;
2530     PetscInt *iwork;
2531 
2532     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2533     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2534     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2535     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2536     for (i=1;i<n_neigh;i++)
2537       for (j=0;j<n_shared[i];j++)
2538           iwork[shared[i][j]] += 1;
2539     for (i=0;i<n;i++)
2540       if (!iwork[i])
2541         interior_dofs[n_interior_dofs++] = i;
2542     ierr = PetscFree(iwork);CHKERRQ(ierr);
2543     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2544   }
2545   if (has_null_pressures) {
2546     IS             *subs;
2547     PetscInt       nsubs,i,j,nl;
2548     const PetscInt *idxs;
2549     PetscScalar    *array;
2550     Vec            *work;
2551     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2552 
2553     subs  = pcbddc->local_subs;
2554     nsubs = pcbddc->n_local_subs;
2555     /* these vectors are needed to check if the constant on pressures is in the kernel of the local operator B (i.e. B(v_I,p0) should be zero) */
2556     if (checkb) {
2557       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2558       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2559       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2560       /* work[0] = 1_p */
2561       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2562       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2563       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2564       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2565       /* work[0] = 1_v */
2566       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2567       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2568       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2569       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2570       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2571     }
2572     if (nsubs > 1) {
2573       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2574       for (i=0;i<nsubs;i++) {
2575         ISLocalToGlobalMapping l2g;
2576         IS                     t_zerodiag_subs;
2577         PetscInt               nl;
2578 
2579         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2580         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2581         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2582         if (nl) {
2583           PetscBool valid = PETSC_TRUE;
2584 
2585           if (checkb) {
2586             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2587             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2588             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2589             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2590             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2591             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2592             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2593             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2594             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2595             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2596             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2597             for (j=0;j<n_interior_dofs;j++) {
2598               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2599                 valid = PETSC_FALSE;
2600                 break;
2601               }
2602             }
2603             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2604           }
2605           if (valid && nneu) {
2606             const PetscInt *idxs;
2607             PetscInt       nzb;
2608 
2609             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2610             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2611             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2612             if (nzb) valid = PETSC_FALSE;
2613           }
2614           if (valid && pressures) {
2615             IS t_pressure_subs;
2616             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2617             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2618             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2619           }
2620           if (valid) {
2621             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2622             pcbddc->benign_n++;
2623           } else {
2624             recompute_zerodiag = PETSC_TRUE;
2625           }
2626         }
2627         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2628         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2629       }
2630     } else { /* there's just one subdomain (or zero if they have not been detected */
2631       PetscBool valid = PETSC_TRUE;
2632 
2633       if (nneu) valid = PETSC_FALSE;
2634       if (valid && pressures) {
2635         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2636       }
2637       if (valid && checkb) {
2638         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2639         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2640         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2641         for (j=0;j<n_interior_dofs;j++) {
2642           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2643             valid = PETSC_FALSE;
2644             break;
2645           }
2646         }
2647         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2648       }
2649       if (valid) {
2650         pcbddc->benign_n = 1;
2651         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2652         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2653         zerodiag_subs[0] = zerodiag;
2654       }
2655     }
2656     if (checkb) {
2657       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2658     }
2659   }
2660   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2661 
2662   if (!pcbddc->benign_n) {
2663     PetscInt n;
2664 
2665     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2666     recompute_zerodiag = PETSC_FALSE;
2667     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2668     if (n) {
2669       has_null_pressures = PETSC_FALSE;
2670       have_null = PETSC_FALSE;
2671     }
2672   }
2673 
2674   /* final check for null pressures */
2675   if (zerodiag && pressures) {
2676     PetscInt nz,np;
2677     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2678     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2679     if (nz != np) have_null = PETSC_FALSE;
2680   }
2681 
2682   if (recompute_zerodiag) {
2683     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2684     if (pcbddc->benign_n == 1) {
2685       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2686       zerodiag = zerodiag_subs[0];
2687     } else {
2688       PetscInt i,nzn,*new_idxs;
2689 
2690       nzn = 0;
2691       for (i=0;i<pcbddc->benign_n;i++) {
2692         PetscInt ns;
2693         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2694         nzn += ns;
2695       }
2696       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2697       nzn = 0;
2698       for (i=0;i<pcbddc->benign_n;i++) {
2699         PetscInt ns,*idxs;
2700         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2701         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2702         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2703         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2704         nzn += ns;
2705       }
2706       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2707       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2708     }
2709     have_null = PETSC_FALSE;
2710   }
2711 
2712   /* Prepare matrix to compute no-net-flux */
2713   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2714     Mat                    A,loc_divudotp;
2715     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2716     IS                     row,col,isused = NULL;
2717     PetscInt               M,N,n,st,n_isused;
2718 
2719     if (pressures) {
2720       isused = pressures;
2721     } else {
2722       isused = zerodiag_save;
2723     }
2724     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2725     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2726     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2727     if (!isused && n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_USER,"Don't know how to extract div u dot p! Please provide the pressure field");
2728     n_isused = 0;
2729     if (isused) {
2730       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2731     }
2732     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2733     st = st-n_isused;
2734     if (n) {
2735       const PetscInt *gidxs;
2736 
2737       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2738       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2739       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2740       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2741       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2742       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2743     } else {
2744       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2745       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2746       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2747     }
2748     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2749     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2750     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2751     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2752     ierr = ISDestroy(&row);CHKERRQ(ierr);
2753     ierr = ISDestroy(&col);CHKERRQ(ierr);
2754     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2755     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2756     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2757     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2758     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2759     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2760     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2761     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2762     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2763     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2764   }
2765   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2766 
2767   /* change of basis and p0 dofs */
2768   if (has_null_pressures) {
2769     IS             zerodiagc;
2770     const PetscInt *idxs,*idxsc;
2771     PetscInt       i,s,*nnz;
2772 
2773     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2774     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2775     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2776     /* local change of basis for pressures */
2777     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2778     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2779     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2780     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2781     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2782     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2783     for (i=0;i<pcbddc->benign_n;i++) {
2784       PetscInt nzs,j;
2785 
2786       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2787       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2788       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2789       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2790       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2791     }
2792     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2793     ierr = PetscFree(nnz);CHKERRQ(ierr);
2794     /* set identity on velocities */
2795     for (i=0;i<n-nz;i++) {
2796       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2797     }
2798     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2799     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2800     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2801     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2802     /* set change on pressures */
2803     for (s=0;s<pcbddc->benign_n;s++) {
2804       PetscScalar *array;
2805       PetscInt    nzs;
2806 
2807       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2808       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2809       for (i=0;i<nzs-1;i++) {
2810         PetscScalar vals[2];
2811         PetscInt    cols[2];
2812 
2813         cols[0] = idxs[i];
2814         cols[1] = idxs[nzs-1];
2815         vals[0] = 1.;
2816         vals[1] = 1.;
2817         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2818       }
2819       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2820       for (i=0;i<nzs-1;i++) array[i] = -1.;
2821       array[nzs-1] = 1.;
2822       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2823       /* store local idxs for p0 */
2824       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2825       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2826       ierr = PetscFree(array);CHKERRQ(ierr);
2827     }
2828     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2829     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2830     /* project if needed */
2831     if (pcbddc->benign_change_explicit) {
2832       Mat M;
2833 
2834       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2835       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2836       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2837       ierr = MatDestroy(&M);CHKERRQ(ierr);
2838     }
2839     /* store global idxs for p0 */
2840     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2841   }
2842   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2843   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2844 
2845   /* determines if the coarse solver will be singular or not */
2846   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2847   /* determines if the problem has subdomains with 0 pressure block */
2848   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2849   *zerodiaglocal = zerodiag;
2850   PetscFunctionReturn(0);
2851 }
2852 
2853 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2854 {
2855   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2856   PetscScalar    *array;
2857   PetscErrorCode ierr;
2858 
2859   PetscFunctionBegin;
2860   if (!pcbddc->benign_sf) {
2861     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2862     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2863   }
2864   if (get) {
2865     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2866     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2867     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2868     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2869   } else {
2870     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2871     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2872     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2873     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2874   }
2875   PetscFunctionReturn(0);
2876 }
2877 
2878 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2879 {
2880   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2881   PetscErrorCode ierr;
2882 
2883   PetscFunctionBegin;
2884   /* TODO: add error checking
2885     - avoid nested pop (or push) calls.
2886     - cannot push before pop.
2887     - cannot call this if pcbddc->local_mat is NULL
2888   */
2889   if (!pcbddc->benign_n) {
2890     PetscFunctionReturn(0);
2891   }
2892   if (pop) {
2893     if (pcbddc->benign_change_explicit) {
2894       IS       is_p0;
2895       MatReuse reuse;
2896 
2897       /* extract B_0 */
2898       reuse = MAT_INITIAL_MATRIX;
2899       if (pcbddc->benign_B0) {
2900         reuse = MAT_REUSE_MATRIX;
2901       }
2902       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2903       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2904       /* remove rows and cols from local problem */
2905       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2906       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2907       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2908       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2909     } else {
2910       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2911       PetscScalar *vals;
2912       PetscInt    i,n,*idxs_ins;
2913 
2914       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2915       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2916       if (!pcbddc->benign_B0) {
2917         PetscInt *nnz;
2918         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2919         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2920         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2921         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2922         for (i=0;i<pcbddc->benign_n;i++) {
2923           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2924           nnz[i] = n - nnz[i];
2925         }
2926         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2927         ierr = PetscFree(nnz);CHKERRQ(ierr);
2928       }
2929 
2930       for (i=0;i<pcbddc->benign_n;i++) {
2931         PetscScalar *array;
2932         PetscInt    *idxs,j,nz,cum;
2933 
2934         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2935         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2936         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2937         for (j=0;j<nz;j++) vals[j] = 1.;
2938         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2939         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2940         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2941         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2942         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2943         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2944         cum = 0;
2945         for (j=0;j<n;j++) {
2946           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2947             vals[cum] = array[j];
2948             idxs_ins[cum] = j;
2949             cum++;
2950           }
2951         }
2952         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2953         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2954         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2955       }
2956       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2957       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2958       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2959     }
2960   } else { /* push */
2961     if (pcbddc->benign_change_explicit) {
2962       PetscInt i;
2963 
2964       for (i=0;i<pcbddc->benign_n;i++) {
2965         PetscScalar *B0_vals;
2966         PetscInt    *B0_cols,B0_ncol;
2967 
2968         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2969         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2970         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2971         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2972         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2973       }
2974       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2975       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2976     } else {
2977       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2978     }
2979   }
2980   PetscFunctionReturn(0);
2981 }
2982 
2983 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2984 {
2985   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2986   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2987   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2988   PetscBLASInt    *B_iwork,*B_ifail;
2989   PetscScalar     *work,lwork;
2990   PetscScalar     *St,*S,*eigv;
2991   PetscScalar     *Sarray,*Starray;
2992   PetscReal       *eigs,thresh,lthresh,uthresh;
2993   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2994   PetscBool       allocated_S_St;
2995 #if defined(PETSC_USE_COMPLEX)
2996   PetscReal       *rwork;
2997 #endif
2998   PetscErrorCode  ierr;
2999 
3000   PetscFunctionBegin;
3001   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3002   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3003   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3004 
3005   if (pcbddc->dbg_flag) {
3006     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3007     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3008     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3009     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3010   }
3011 
3012   if (pcbddc->dbg_flag) {
3013     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
3014   }
3015 
3016   /* max size of subsets */
3017   mss = 0;
3018   for (i=0;i<sub_schurs->n_subs;i++) {
3019     PetscInt subset_size;
3020 
3021     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3022     mss = PetscMax(mss,subset_size);
3023   }
3024 
3025   /* min/max and threshold */
3026   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3027   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3028   nmax = PetscMax(nmin,nmax);
3029   allocated_S_St = PETSC_FALSE;
3030   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3031     allocated_S_St = PETSC_TRUE;
3032   }
3033 
3034   /* allocate lapack workspace */
3035   cum = cum2 = 0;
3036   maxneigs = 0;
3037   for (i=0;i<sub_schurs->n_subs;i++) {
3038     PetscInt n,subset_size;
3039 
3040     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3041     n = PetscMin(subset_size,nmax);
3042     cum += subset_size;
3043     cum2 += subset_size*n;
3044     maxneigs = PetscMax(maxneigs,n);
3045   }
3046   if (mss) {
3047     if (sub_schurs->is_symmetric) {
3048       PetscBLASInt B_itype = 1;
3049       PetscBLASInt B_N = mss;
3050       PetscReal    zero = 0.0;
3051       PetscReal    eps = 0.0; /* dlamch? */
3052 
3053       B_lwork = -1;
3054       S = NULL;
3055       St = NULL;
3056       eigs = NULL;
3057       eigv = NULL;
3058       B_iwork = NULL;
3059       B_ifail = NULL;
3060 #if defined(PETSC_USE_COMPLEX)
3061       rwork = NULL;
3062 #endif
3063       thresh = 1.0;
3064       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3065 #if defined(PETSC_USE_COMPLEX)
3066       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3067 #else
3068       PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&zero,&thresh,&B_dummyint,&B_dummyint,&eps,&B_neigs,eigs,eigv,&B_N,&lwork,&B_lwork,B_iwork,B_ifail,&B_ierr));
3069 #endif
3070       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3071       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3072     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3073   } else {
3074     lwork = 0;
3075   }
3076 
3077   nv = 0;
3078   if (sub_schurs->is_vertices && pcbddc->use_vertices) { /* complement set of active subsets, each entry is a vertex (boundary made by active subsets, vertices and dirichlet dofs) */
3079     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3080   }
3081   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3082   if (allocated_S_St) {
3083     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3084   }
3085   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3086 #if defined(PETSC_USE_COMPLEX)
3087   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3088 #endif
3089   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3090                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3091                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3092                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3093                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3094   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3095 
3096   maxneigs = 0;
3097   cum = cumarray = 0;
3098   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3099   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3100   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3101     const PetscInt *idxs;
3102 
3103     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3104     for (cum=0;cum<nv;cum++) {
3105       pcbddc->adaptive_constraints_n[cum] = 1;
3106       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3107       pcbddc->adaptive_constraints_data[cum] = 1.0;
3108       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3109       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3110     }
3111     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3112   }
3113 
3114   if (mss) { /* multilevel */
3115     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3116     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3117   }
3118 
3119   lthresh = pcbddc->adaptive_threshold[0];
3120   uthresh = pcbddc->adaptive_threshold[1];
3121   for (i=0;i<sub_schurs->n_subs;i++) {
3122     const PetscInt *idxs;
3123     PetscReal      upper,lower;
3124     PetscInt       j,subset_size,eigs_start = 0;
3125     PetscBLASInt   B_N;
3126     PetscBool      same_data = PETSC_FALSE;
3127     PetscBool      scal = PETSC_FALSE;
3128 
3129     if (pcbddc->use_deluxe_scaling) {
3130       upper = PETSC_MAX_REAL;
3131       lower = uthresh;
3132     } else {
3133       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3134       upper = 1./uthresh;
3135       lower = 0.;
3136     }
3137     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3138     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3139     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3140     /* this is experimental: we assume the dofs have been properly grouped to have
3141        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3142     if (!sub_schurs->is_posdef) {
3143       Mat T;
3144 
3145       for (j=0;j<subset_size;j++) {
3146         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3147           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3148           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3149           ierr = MatDestroy(&T);CHKERRQ(ierr);
3150           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3151           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3152           ierr = MatDestroy(&T);CHKERRQ(ierr);
3153           if (sub_schurs->change_primal_sub) {
3154             PetscInt       nz,k;
3155             const PetscInt *idxs;
3156 
3157             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3158             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3159             for (k=0;k<nz;k++) {
3160               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3161               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3162             }
3163             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3164           }
3165           scal = PETSC_TRUE;
3166           break;
3167         }
3168       }
3169     }
3170 
3171     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3172       if (sub_schurs->is_symmetric) {
3173         PetscInt j,k;
3174         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3175           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3176           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3177         }
3178         for (j=0;j<subset_size;j++) {
3179           for (k=j;k<subset_size;k++) {
3180             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3181             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3182           }
3183         }
3184       } else {
3185         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3186         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3187       }
3188     } else {
3189       S = Sarray + cumarray;
3190       St = Starray + cumarray;
3191     }
3192     /* see if we can save some work */
3193     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3194       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3195     }
3196 
3197     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3198       B_neigs = 0;
3199     } else {
3200       if (sub_schurs->is_symmetric) {
3201         PetscBLASInt B_itype = 1;
3202         PetscBLASInt B_IL, B_IU;
3203         PetscReal    eps = -1.0; /* dlamch? */
3204         PetscInt     nmin_s;
3205         PetscBool    compute_range;
3206 
3207         compute_range = (PetscBool)!same_data;
3208         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3209 
3210         if (pcbddc->dbg_flag) {
3211           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d (range %d).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range);CHKERRQ(ierr);
3212         }
3213 
3214         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3215         if (compute_range) {
3216 
3217           /* ask for eigenvalues larger than thresh */
3218           if (sub_schurs->is_posdef) {
3219 #if defined(PETSC_USE_COMPLEX)
3220             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3221 #else
3222             PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3223 #endif
3224           } else { /* no theory so far, but it works nicely */
3225             PetscInt  recipe = 0;
3226             PetscReal bb[2];
3227 
3228             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3229             switch (recipe) {
3230             case 0:
3231               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3232               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3233 #if defined(PETSC_USE_COMPLEX)
3234               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3235 #else
3236               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3237 #endif
3238               break;
3239             case 1:
3240               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3241 #if defined(PETSC_USE_COMPLEX)
3242               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3243 #else
3244               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3245 #endif
3246               if (!scal) {
3247                 PetscBLASInt B_neigs2;
3248 
3249                 bb[0] = uthresh; bb[1] = PETSC_MAX_REAL;
3250                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3251                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3252 #if defined(PETSC_USE_COMPLEX)
3253                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3254 #else
3255                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3256 #endif
3257                 B_neigs += B_neigs2;
3258               }
3259               break;
3260             default:
3261               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3262               break;
3263             }
3264           }
3265         } else if (!same_data) { /* this is just to see all the eigenvalues */
3266           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3267           B_IL = 1;
3268 #if defined(PETSC_USE_COMPLEX)
3269           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3270 #else
3271           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3272 #endif
3273         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3274           PetscInt k;
3275           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3276           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3277           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3278           nmin = nmax;
3279           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3280           for (k=0;k<nmax;k++) {
3281             eigs[k] = 1./PETSC_SMALL;
3282             eigv[k*(subset_size+1)] = 1.0;
3283           }
3284         }
3285         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3286         if (B_ierr) {
3287           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3288           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3289           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3290         }
3291 
3292         if (B_neigs > nmax) {
3293           if (pcbddc->dbg_flag) {
3294             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);CHKERRQ(ierr);
3295           }
3296           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3297           B_neigs = nmax;
3298         }
3299 
3300         nmin_s = PetscMin(nmin,B_N);
3301         if (B_neigs < nmin_s) {
3302           PetscBLASInt B_neigs2;
3303 
3304           if (pcbddc->use_deluxe_scaling) {
3305             if (scal) {
3306               B_IU = nmin_s;
3307               B_IL = B_neigs + 1;
3308             } else {
3309               B_IL = B_N - nmin_s + 1;
3310               B_IU = B_N - B_neigs;
3311             }
3312           } else {
3313             B_IL = B_neigs + 1;
3314             B_IU = nmin_s;
3315           }
3316           if (pcbddc->dbg_flag) {
3317             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, less than minimum required %d. Asking for %d to %d incl (fortran like)\n",B_neigs,nmin,B_IL,B_IU);
3318           }
3319           if (sub_schurs->is_symmetric) {
3320             PetscInt j,k;
3321             for (j=0;j<subset_size;j++) {
3322               for (k=j;k<subset_size;k++) {
3323                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3324                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3325               }
3326             }
3327           } else {
3328             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3329             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3330           }
3331           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3332 #if defined(PETSC_USE_COMPLEX)
3333           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3334 #else
3335           PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*subset_size,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3336 #endif
3337           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3338           B_neigs += B_neigs2;
3339         }
3340         if (B_ierr) {
3341           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3342           else if (B_ierr <= B_N) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: %d eigenvalues failed to converge",(int)B_ierr);
3343           else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: leading minor of order %d is not positive definite",(int)B_ierr-B_N-1);
3344         }
3345         if (pcbddc->dbg_flag) {
3346           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3347           for (j=0;j<B_neigs;j++) {
3348             if (eigs[j] == 0.0) {
3349               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3350             } else {
3351               if (pcbddc->use_deluxe_scaling) {
3352                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3353               } else {
3354                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3355               }
3356             }
3357           }
3358         }
3359       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3360     }
3361     /* change the basis back to the original one */
3362     if (sub_schurs->change) {
3363       Mat change,phi,phit;
3364 
3365       if (pcbddc->dbg_flag > 2) {
3366         PetscInt ii;
3367         for (ii=0;ii<B_neigs;ii++) {
3368           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3369           for (j=0;j<B_N;j++) {
3370 #if defined(PETSC_USE_COMPLEX)
3371             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3372             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3373             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3374 #else
3375             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3376 #endif
3377           }
3378         }
3379       }
3380       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3381       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3382       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3383       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3384       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3385       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3386     }
3387     maxneigs = PetscMax(B_neigs,maxneigs);
3388     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3389     if (B_neigs) {
3390       ierr = PetscMemcpy(pcbddc->adaptive_constraints_data+pcbddc->adaptive_constraints_data_ptr[cum],eigv+eigs_start*subset_size,B_neigs*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3391 
3392       if (pcbddc->dbg_flag > 1) {
3393         PetscInt ii;
3394         for (ii=0;ii<B_neigs;ii++) {
3395           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3396           for (j=0;j<B_N;j++) {
3397 #if defined(PETSC_USE_COMPLEX)
3398             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3399             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3400             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3401 #else
3402             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3403 #endif
3404           }
3405         }
3406       }
3407       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3408       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3409       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3410       cum++;
3411     }
3412     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3413     /* shift for next computation */
3414     cumarray += subset_size*subset_size;
3415   }
3416   if (pcbddc->dbg_flag) {
3417     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3418   }
3419 
3420   if (mss) {
3421     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3422     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3423     /* destroy matrices (junk) */
3424     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3425     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3426   }
3427   if (allocated_S_St) {
3428     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3429   }
3430   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3431 #if defined(PETSC_USE_COMPLEX)
3432   ierr = PetscFree(rwork);CHKERRQ(ierr);
3433 #endif
3434   if (pcbddc->dbg_flag) {
3435     PetscInt maxneigs_r;
3436     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3437     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3438   }
3439   PetscFunctionReturn(0);
3440 }
3441 
3442 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3443 {
3444   PetscScalar    *coarse_submat_vals;
3445   PetscErrorCode ierr;
3446 
3447   PetscFunctionBegin;
3448   /* Setup local scatters R_to_B and (optionally) R_to_D */
3449   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3450   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3451 
3452   /* Setup local neumann solver ksp_R */
3453   /* PCBDDCSetUpLocalScatters should be called first! */
3454   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3455 
3456   /*
3457      Setup local correction and local part of coarse basis.
3458      Gives back the dense local part of the coarse matrix in column major ordering
3459   */
3460   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3461 
3462   /* Compute total number of coarse nodes and setup coarse solver */
3463   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3464 
3465   /* free */
3466   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3467   PetscFunctionReturn(0);
3468 }
3469 
3470 PetscErrorCode PCBDDCResetCustomization(PC pc)
3471 {
3472   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3473   PetscErrorCode ierr;
3474 
3475   PetscFunctionBegin;
3476   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3477   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3478   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3479   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3480   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3481   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3482   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3483   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3484   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3485   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3486   PetscFunctionReturn(0);
3487 }
3488 
3489 PetscErrorCode PCBDDCResetTopography(PC pc)
3490 {
3491   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3492   PetscInt       i;
3493   PetscErrorCode ierr;
3494 
3495   PetscFunctionBegin;
3496   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3497   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3498   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3499   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3500   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3501   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3502   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3503   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3504   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3505   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3506   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3507   for (i=0;i<pcbddc->n_local_subs;i++) {
3508     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3509   }
3510   pcbddc->n_local_subs = 0;
3511   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3512   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3513   pcbddc->graphanalyzed        = PETSC_FALSE;
3514   pcbddc->recompute_topography = PETSC_TRUE;
3515   PetscFunctionReturn(0);
3516 }
3517 
3518 PetscErrorCode PCBDDCResetSolvers(PC pc)
3519 {
3520   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3521   PetscErrorCode ierr;
3522 
3523   PetscFunctionBegin;
3524   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3525   if (pcbddc->coarse_phi_B) {
3526     PetscScalar *array;
3527     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3528     ierr = PetscFree(array);CHKERRQ(ierr);
3529   }
3530   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3531   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3532   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3533   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3534   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3535   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3536   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3537   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3538   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3539   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3540   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3541   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3542   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3543   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3544   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3545   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3546   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3547   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3548   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3549   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3550   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3551   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3552   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3553   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3554   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3555   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3556   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3557   if (pcbddc->benign_zerodiag_subs) {
3558     PetscInt i;
3559     for (i=0;i<pcbddc->benign_n;i++) {
3560       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3561     }
3562     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3563   }
3564   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3565   PetscFunctionReturn(0);
3566 }
3567 
3568 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3569 {
3570   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3571   PC_IS          *pcis = (PC_IS*)pc->data;
3572   VecType        impVecType;
3573   PetscInt       n_constraints,n_R,old_size;
3574   PetscErrorCode ierr;
3575 
3576   PetscFunctionBegin;
3577   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3578   n_R = pcis->n - pcbddc->n_vertices;
3579   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3580   /* local work vectors (try to avoid unneeded work)*/
3581   /* R nodes */
3582   old_size = -1;
3583   if (pcbddc->vec1_R) {
3584     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3585   }
3586   if (n_R != old_size) {
3587     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3588     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3589     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3590     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3591     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3592     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3593   }
3594   /* local primal dofs */
3595   old_size = -1;
3596   if (pcbddc->vec1_P) {
3597     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3598   }
3599   if (pcbddc->local_primal_size != old_size) {
3600     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3601     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3602     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3603     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3604   }
3605   /* local explicit constraints */
3606   old_size = -1;
3607   if (pcbddc->vec1_C) {
3608     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3609   }
3610   if (n_constraints && n_constraints != old_size) {
3611     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3612     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3613     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3614     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3615   }
3616   PetscFunctionReturn(0);
3617 }
3618 
3619 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3620 {
3621   PetscErrorCode  ierr;
3622   /* pointers to pcis and pcbddc */
3623   PC_IS*          pcis = (PC_IS*)pc->data;
3624   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3625   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3626   /* submatrices of local problem */
3627   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3628   /* submatrices of local coarse problem */
3629   Mat             S_VV,S_CV,S_VC,S_CC;
3630   /* working matrices */
3631   Mat             C_CR;
3632   /* additional working stuff */
3633   PC              pc_R;
3634   Mat             F,Brhs = NULL;
3635   Vec             dummy_vec;
3636   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3637   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3638   PetscScalar     *work;
3639   PetscInt        *idx_V_B;
3640   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3641   PetscInt        i,n_R,n_D,n_B;
3642 
3643   /* some shortcuts to scalars */
3644   PetscScalar     one=1.0,m_one=-1.0;
3645 
3646   PetscFunctionBegin;
3647   if (!pcbddc->symmetric_primal && pcbddc->benign_n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Non-symmetric primal basis computation with benign trick not yet implemented");
3648 
3649   /* Set Non-overlapping dimensions */
3650   n_vertices = pcbddc->n_vertices;
3651   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3652   n_B = pcis->n_B;
3653   n_D = pcis->n - n_B;
3654   n_R = pcis->n - n_vertices;
3655 
3656   /* vertices in boundary numbering */
3657   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3658   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3659   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3660 
3661   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3662   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3663   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3664   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3665   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3666   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3667   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3668   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3669   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3670   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3671 
3672   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3673   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3674   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3675   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3676   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3677   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3678   lda_rhs = n_R;
3679   need_benign_correction = PETSC_FALSE;
3680   if (isLU || isILU || isCHOL) {
3681     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3682   } else if (sub_schurs && sub_schurs->reuse_solver) {
3683     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3684     MatFactorType      type;
3685 
3686     F = reuse_solver->F;
3687     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3688     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3689     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3690     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3691   } else {
3692     F = NULL;
3693   }
3694 
3695   /* determine if we can use a sparse right-hand side */
3696   sparserhs = PETSC_FALSE;
3697   if (F) {
3698     MatSolverType solver;
3699 
3700     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3701     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3702   }
3703 
3704   /* allocate workspace */
3705   n = 0;
3706   if (n_constraints) {
3707     n += lda_rhs*n_constraints;
3708   }
3709   if (n_vertices) {
3710     n = PetscMax(2*lda_rhs*n_vertices,n);
3711     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3712   }
3713   if (!pcbddc->symmetric_primal) {
3714     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3715   }
3716   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3717 
3718   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3719   dummy_vec = NULL;
3720   if (need_benign_correction && lda_rhs != n_R && F) {
3721     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3722   }
3723 
3724   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3725   if (n_constraints) {
3726     Mat         M3,C_B;
3727     IS          is_aux;
3728     PetscScalar *array,*array2;
3729 
3730     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3731     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3732 
3733     /* Extract constraints on R nodes: C_{CR}  */
3734     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3735     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3736     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3737 
3738     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3739     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3740     if (!sparserhs) {
3741       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3742       for (i=0;i<n_constraints;i++) {
3743         const PetscScalar *row_cmat_values;
3744         const PetscInt    *row_cmat_indices;
3745         PetscInt          size_of_constraint,j;
3746 
3747         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3748         for (j=0;j<size_of_constraint;j++) {
3749           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3750         }
3751         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3752       }
3753       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3754     } else {
3755       Mat tC_CR;
3756 
3757       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3758       if (lda_rhs != n_R) {
3759         PetscScalar *aa;
3760         PetscInt    r,*ii,*jj;
3761         PetscBool   done;
3762 
3763         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3764         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3765         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3766         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3767         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3768         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3769       } else {
3770         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3771         tC_CR = C_CR;
3772       }
3773       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3774       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3775     }
3776     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3777     if (F) {
3778       if (need_benign_correction) {
3779         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3780 
3781         /* rhs is already zero on interior dofs, no need to change the rhs */
3782         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3783       }
3784       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3785       if (need_benign_correction) {
3786         PetscScalar        *marr;
3787         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3788 
3789         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3790         if (lda_rhs != n_R) {
3791           for (i=0;i<n_constraints;i++) {
3792             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3793             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3794             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3795           }
3796         } else {
3797           for (i=0;i<n_constraints;i++) {
3798             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3799             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3800             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3801           }
3802         }
3803         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3804       }
3805     } else {
3806       PetscScalar *marr;
3807 
3808       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3809       for (i=0;i<n_constraints;i++) {
3810         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3811         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3812         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3813         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3814         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3815       }
3816       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3817     }
3818     if (sparserhs) {
3819       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3820     }
3821     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3822     if (!pcbddc->switch_static) {
3823       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3824       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3825       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3826       for (i=0;i<n_constraints;i++) {
3827         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3828         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3829         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3830         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3831         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3832         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3833       }
3834       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3835       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3836       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3837     } else {
3838       if (lda_rhs != n_R) {
3839         IS dummy;
3840 
3841         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3842         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3843         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3844       } else {
3845         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3846         pcbddc->local_auxmat2 = local_auxmat2_R;
3847       }
3848       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3849     }
3850     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3851     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3852     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3853     if (isCHOL) {
3854       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3855     } else {
3856       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3857     }
3858     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
3859     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3860     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3861     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3862     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3863     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3864   }
3865 
3866   /* Get submatrices from subdomain matrix */
3867   if (n_vertices) {
3868     IS        is_aux;
3869     PetscBool isseqaij;
3870 
3871     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3872       IS tis;
3873 
3874       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3875       ierr = ISSort(tis);CHKERRQ(ierr);
3876       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3877       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3878     } else {
3879       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3880     }
3881     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3882     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3883     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3884     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
3885       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3886     }
3887     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3888     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3889   }
3890 
3891   /* Matrix of coarse basis functions (local) */
3892   if (pcbddc->coarse_phi_B) {
3893     PetscInt on_B,on_primal,on_D=n_D;
3894     if (pcbddc->coarse_phi_D) {
3895       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3896     }
3897     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3898     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3899       PetscScalar *marray;
3900 
3901       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3902       ierr = PetscFree(marray);CHKERRQ(ierr);
3903       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3904       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3905       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3906       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3907     }
3908   }
3909 
3910   if (!pcbddc->coarse_phi_B) {
3911     PetscScalar *marr;
3912 
3913     /* memory size */
3914     n = n_B*pcbddc->local_primal_size;
3915     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
3916     if (!pcbddc->symmetric_primal) n *= 2;
3917     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
3918     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3919     marr += n_B*pcbddc->local_primal_size;
3920     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3921       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3922       marr += n_D*pcbddc->local_primal_size;
3923     }
3924     if (!pcbddc->symmetric_primal) {
3925       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3926       marr += n_B*pcbddc->local_primal_size;
3927       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3928         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3929       }
3930     } else {
3931       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3932       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3933       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3934         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3935         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3936       }
3937     }
3938   }
3939 
3940   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3941   p0_lidx_I = NULL;
3942   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3943     const PetscInt *idxs;
3944 
3945     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3946     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3947     for (i=0;i<pcbddc->benign_n;i++) {
3948       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3949     }
3950     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3951   }
3952 
3953   /* vertices */
3954   if (n_vertices) {
3955     PetscBool restoreavr = PETSC_FALSE;
3956 
3957     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3958 
3959     if (n_R) {
3960       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3961       PetscBLASInt B_N,B_one = 1;
3962       PetscScalar  *x,*y;
3963 
3964       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3965       if (need_benign_correction) {
3966         ISLocalToGlobalMapping RtoN;
3967         IS                     is_p0;
3968         PetscInt               *idxs_p0,n;
3969 
3970         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3971         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3972         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3973         if (n != pcbddc->benign_n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in R numbering for benign p0! %d != %d\n",n,pcbddc->benign_n);
3974         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3975         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3976         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3977         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3978       }
3979 
3980       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3981       if (!sparserhs || need_benign_correction) {
3982         if (lda_rhs == n_R) {
3983           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3984         } else {
3985           PetscScalar    *av,*array;
3986           const PetscInt *xadj,*adjncy;
3987           PetscInt       n;
3988           PetscBool      flg_row;
3989 
3990           array = work+lda_rhs*n_vertices;
3991           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3992           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3993           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3994           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3995           for (i=0;i<n;i++) {
3996             PetscInt j;
3997             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3998           }
3999           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4000           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4001           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4002         }
4003         if (need_benign_correction) {
4004           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4005           PetscScalar        *marr;
4006 
4007           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4008           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4009 
4010                  | 0 0  0 | (V)
4011              L = | 0 0 -1 | (P-p0)
4012                  | 0 0 -1 | (p0)
4013 
4014           */
4015           for (i=0;i<reuse_solver->benign_n;i++) {
4016             const PetscScalar *vals;
4017             const PetscInt    *idxs,*idxs_zero;
4018             PetscInt          n,j,nz;
4019 
4020             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4021             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4022             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4023             for (j=0;j<n;j++) {
4024               PetscScalar val = vals[j];
4025               PetscInt    k,col = idxs[j];
4026               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4027             }
4028             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4029             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4030           }
4031           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4032         }
4033         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4034         Brhs = A_RV;
4035       } else {
4036         Mat tA_RVT,A_RVT;
4037 
4038         if (!pcbddc->symmetric_primal) {
4039           /* A_RV already scaled by -1 */
4040           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4041         } else {
4042           restoreavr = PETSC_TRUE;
4043           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4044           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4045           A_RVT = A_VR;
4046         }
4047         if (lda_rhs != n_R) {
4048           PetscScalar *aa;
4049           PetscInt    r,*ii,*jj;
4050           PetscBool   done;
4051 
4052           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4053           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4054           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4055           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4056           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4057           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4058         } else {
4059           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4060           tA_RVT = A_RVT;
4061         }
4062         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4063         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4064         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4065       }
4066       if (F) {
4067         /* need to correct the rhs */
4068         if (need_benign_correction) {
4069           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4070           PetscScalar        *marr;
4071 
4072           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4073           if (lda_rhs != n_R) {
4074             for (i=0;i<n_vertices;i++) {
4075               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4076               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4077               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4078             }
4079           } else {
4080             for (i=0;i<n_vertices;i++) {
4081               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4082               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4083               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4084             }
4085           }
4086           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4087         }
4088         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4089         if (restoreavr) {
4090           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4091         }
4092         /* need to correct the solution */
4093         if (need_benign_correction) {
4094           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4095           PetscScalar        *marr;
4096 
4097           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4098           if (lda_rhs != n_R) {
4099             for (i=0;i<n_vertices;i++) {
4100               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4101               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4102               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4103             }
4104           } else {
4105             for (i=0;i<n_vertices;i++) {
4106               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4107               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4108               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4109             }
4110           }
4111           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4112         }
4113       } else {
4114         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4115         for (i=0;i<n_vertices;i++) {
4116           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4117           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4118           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4119           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4120           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4121         }
4122         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4123       }
4124       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4125       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4126       /* S_VV and S_CV */
4127       if (n_constraints) {
4128         Mat B;
4129 
4130         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4131         for (i=0;i<n_vertices;i++) {
4132           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4133           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4134           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4135           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4136           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4137           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4138         }
4139         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4140         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4141         ierr = MatDestroy(&B);CHKERRQ(ierr);
4142         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4143         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4144         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4145         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4146         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4147         ierr = MatDestroy(&B);CHKERRQ(ierr);
4148       }
4149       if (lda_rhs != n_R) {
4150         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4151         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4152         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4153       }
4154       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4155       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4156       if (need_benign_correction) {
4157         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4158         PetscScalar      *marr,*sums;
4159 
4160         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4161         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4162         for (i=0;i<reuse_solver->benign_n;i++) {
4163           const PetscScalar *vals;
4164           const PetscInt    *idxs,*idxs_zero;
4165           PetscInt          n,j,nz;
4166 
4167           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4168           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4169           for (j=0;j<n_vertices;j++) {
4170             PetscInt k;
4171             sums[j] = 0.;
4172             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4173           }
4174           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4175           for (j=0;j<n;j++) {
4176             PetscScalar val = vals[j];
4177             PetscInt k;
4178             for (k=0;k<n_vertices;k++) {
4179               marr[idxs[j]+k*n_vertices] += val*sums[k];
4180             }
4181           }
4182           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4183           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4184         }
4185         ierr = PetscFree(sums);CHKERRQ(ierr);
4186         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4187         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4188       }
4189       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4190       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4191       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4192       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4193       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4194       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4195       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4196       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4197       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4198     } else {
4199       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4200     }
4201     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4202 
4203     /* coarse basis functions */
4204     for (i=0;i<n_vertices;i++) {
4205       PetscScalar *y;
4206 
4207       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4208       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4209       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4210       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4211       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4212       y[n_B*i+idx_V_B[i]] = 1.0;
4213       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4214       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4215 
4216       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4217         PetscInt j;
4218 
4219         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4220         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4221         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4222         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4223         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4224         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4225         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4226       }
4227       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4228     }
4229     /* if n_R == 0 the object is not destroyed */
4230     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4231   }
4232   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4233 
4234   if (n_constraints) {
4235     Mat B;
4236 
4237     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4238     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4239     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4240     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4241     if (n_vertices) {
4242       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4243         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4244       } else {
4245         Mat S_VCt;
4246 
4247         if (lda_rhs != n_R) {
4248           ierr = MatDestroy(&B);CHKERRQ(ierr);
4249           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4250           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4251         }
4252         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4253         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4254         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4255       }
4256     }
4257     ierr = MatDestroy(&B);CHKERRQ(ierr);
4258     /* coarse basis functions */
4259     for (i=0;i<n_constraints;i++) {
4260       PetscScalar *y;
4261 
4262       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4263       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4264       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4265       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4266       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4267       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4268       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4269       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4270         PetscInt j;
4271 
4272         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4273         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4274         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4275         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4276         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4277         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4278         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4279       }
4280       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4281     }
4282   }
4283   if (n_constraints) {
4284     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4285   }
4286   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4287 
4288   /* coarse matrix entries relative to B_0 */
4289   if (pcbddc->benign_n) {
4290     Mat         B0_B,B0_BPHI;
4291     IS          is_dummy;
4292     PetscScalar *data;
4293     PetscInt    j;
4294 
4295     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4296     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4297     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4298     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4299     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4300     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4301     for (j=0;j<pcbddc->benign_n;j++) {
4302       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4303       for (i=0;i<pcbddc->local_primal_size;i++) {
4304         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4305         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4306       }
4307     }
4308     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4309     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4310     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4311   }
4312 
4313   /* compute other basis functions for non-symmetric problems */
4314   if (!pcbddc->symmetric_primal) {
4315     Mat         B_V=NULL,B_C=NULL;
4316     PetscScalar *marray;
4317 
4318     if (n_constraints) {
4319       Mat S_CCT,C_CRT;
4320 
4321       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4322       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4323       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4324       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4325       if (n_vertices) {
4326         Mat S_VCT;
4327 
4328         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4329         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4330         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4331       }
4332       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4333     } else {
4334       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4335     }
4336     if (n_vertices && n_R) {
4337       PetscScalar    *av,*marray;
4338       const PetscInt *xadj,*adjncy;
4339       PetscInt       n;
4340       PetscBool      flg_row;
4341 
4342       /* B_V = B_V - A_VR^T */
4343       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4344       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4345       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4346       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4347       for (i=0;i<n;i++) {
4348         PetscInt j;
4349         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4350       }
4351       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4352       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4353       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4354     }
4355 
4356     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4357     if (n_vertices) {
4358       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4359       for (i=0;i<n_vertices;i++) {
4360         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4361         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4362         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4363         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4364         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4365       }
4366       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4367     }
4368     if (B_C) {
4369       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4370       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4371         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4372         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4373         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4374         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4375         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4376       }
4377       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4378     }
4379     /* coarse basis functions */
4380     for (i=0;i<pcbddc->local_primal_size;i++) {
4381       PetscScalar *y;
4382 
4383       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4384       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4385       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4386       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4387       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4388       if (i<n_vertices) {
4389         y[n_B*i+idx_V_B[i]] = 1.0;
4390       }
4391       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4392       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4393 
4394       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4395         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4396         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4397         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4398         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4399         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4400         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4401       }
4402       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4403     }
4404     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4405     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4406   }
4407 
4408   /* free memory */
4409   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4410   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4411   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4412   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4413   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4414   ierr = PetscFree(work);CHKERRQ(ierr);
4415   if (n_vertices) {
4416     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4417   }
4418   if (n_constraints) {
4419     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4420   }
4421   /* Checking coarse_sub_mat and coarse basis functios */
4422   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4423   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4424   if (pcbddc->dbg_flag) {
4425     Mat         coarse_sub_mat;
4426     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4427     Mat         coarse_phi_D,coarse_phi_B;
4428     Mat         coarse_psi_D,coarse_psi_B;
4429     Mat         A_II,A_BB,A_IB,A_BI;
4430     Mat         C_B,CPHI;
4431     IS          is_dummy;
4432     Vec         mones;
4433     MatType     checkmattype=MATSEQAIJ;
4434     PetscReal   real_value;
4435 
4436     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4437       Mat A;
4438       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4439       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4440       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4441       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4442       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4443       ierr = MatDestroy(&A);CHKERRQ(ierr);
4444     } else {
4445       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4446       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4447       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4448       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4449     }
4450     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4451     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4452     if (!pcbddc->symmetric_primal) {
4453       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4454       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4455     }
4456     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4457 
4458     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4459     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4460     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4461     if (!pcbddc->symmetric_primal) {
4462       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4463       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4464       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4465       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4466       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4467       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4468       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4469       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4470       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4471       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4472       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4473       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4474     } else {
4475       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4476       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4477       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4478       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4479       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4480       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4481       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4482       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4483     }
4484     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4485     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4486     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4487     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4488     if (pcbddc->benign_n) {
4489       Mat         B0_B,B0_BPHI;
4490       PetscScalar *data,*data2;
4491       PetscInt    j;
4492 
4493       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4494       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4495       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4496       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4497       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4498       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4499       for (j=0;j<pcbddc->benign_n;j++) {
4500         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4501         for (i=0;i<pcbddc->local_primal_size;i++) {
4502           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4503           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4504         }
4505       }
4506       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4507       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4508       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4509       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4510       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4511     }
4512 #if 0
4513   {
4514     PetscViewer viewer;
4515     char filename[256];
4516     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4517     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4518     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4519     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4520     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4521     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4522     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4523     if (pcbddc->coarse_phi_B) {
4524       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4525       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4526     }
4527     if (pcbddc->coarse_phi_D) {
4528       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4529       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4530     }
4531     if (pcbddc->coarse_psi_B) {
4532       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4533       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4534     }
4535     if (pcbddc->coarse_psi_D) {
4536       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4537       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4538     }
4539     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4540     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4541     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4542     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4543     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4544     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4545     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4546     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4547     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4548     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4549     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4550   }
4551 #endif
4552     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4553     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4554     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4555     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4556 
4557     /* check constraints */
4558     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4559     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4560     if (!pcbddc->benign_n) { /* TODO: add benign case */
4561       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4562     } else {
4563       PetscScalar *data;
4564       Mat         tmat;
4565       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4566       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4567       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4568       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4569       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4570     }
4571     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4572     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4573     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4574     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4575     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4576     if (!pcbddc->symmetric_primal) {
4577       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4578       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4579       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4580       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4581       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4582     }
4583     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4584     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4585     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4586     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4587     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4588     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4589     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4590     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4591     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4592     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4593     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4594     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4595     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4596     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4597     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4598     if (!pcbddc->symmetric_primal) {
4599       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4600       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4601     }
4602     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4603   }
4604   /* get back data */
4605   *coarse_submat_vals_n = coarse_submat_vals;
4606   PetscFunctionReturn(0);
4607 }
4608 
4609 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4610 {
4611   Mat            *work_mat;
4612   IS             isrow_s,iscol_s;
4613   PetscBool      rsorted,csorted;
4614   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4615   PetscErrorCode ierr;
4616 
4617   PetscFunctionBegin;
4618   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4619   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4620   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4621   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4622 
4623   if (!rsorted) {
4624     const PetscInt *idxs;
4625     PetscInt *idxs_sorted,i;
4626 
4627     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4628     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4629     for (i=0;i<rsize;i++) {
4630       idxs_perm_r[i] = i;
4631     }
4632     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4633     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4634     for (i=0;i<rsize;i++) {
4635       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4636     }
4637     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4638     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4639   } else {
4640     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4641     isrow_s = isrow;
4642   }
4643 
4644   if (!csorted) {
4645     if (isrow == iscol) {
4646       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4647       iscol_s = isrow_s;
4648     } else {
4649       const PetscInt *idxs;
4650       PetscInt       *idxs_sorted,i;
4651 
4652       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4653       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4654       for (i=0;i<csize;i++) {
4655         idxs_perm_c[i] = i;
4656       }
4657       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4658       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4659       for (i=0;i<csize;i++) {
4660         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4661       }
4662       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4663       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4664     }
4665   } else {
4666     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4667     iscol_s = iscol;
4668   }
4669 
4670   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4671 
4672   if (!rsorted || !csorted) {
4673     Mat      new_mat;
4674     IS       is_perm_r,is_perm_c;
4675 
4676     if (!rsorted) {
4677       PetscInt *idxs_r,i;
4678       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4679       for (i=0;i<rsize;i++) {
4680         idxs_r[idxs_perm_r[i]] = i;
4681       }
4682       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4683       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4684     } else {
4685       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4686     }
4687     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4688 
4689     if (!csorted) {
4690       if (isrow_s == iscol_s) {
4691         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4692         is_perm_c = is_perm_r;
4693       } else {
4694         PetscInt *idxs_c,i;
4695         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4696         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4697         for (i=0;i<csize;i++) {
4698           idxs_c[idxs_perm_c[i]] = i;
4699         }
4700         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4701         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4702       }
4703     } else {
4704       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4705     }
4706     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4707 
4708     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4709     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4710     work_mat[0] = new_mat;
4711     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4712     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4713   }
4714 
4715   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4716   *B = work_mat[0];
4717   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4718   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4719   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4720   PetscFunctionReturn(0);
4721 }
4722 
4723 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4724 {
4725   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4726   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4727   Mat            new_mat,lA;
4728   IS             is_local,is_global;
4729   PetscInt       local_size;
4730   PetscBool      isseqaij;
4731   PetscErrorCode ierr;
4732 
4733   PetscFunctionBegin;
4734   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4735   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4736   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4737   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4738   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4739   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4740   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4741 
4742   /* check */
4743   if (pcbddc->dbg_flag) {
4744     Vec       x,x_change;
4745     PetscReal error;
4746 
4747     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4748     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4749     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4750     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4751     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4752     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4753     if (!pcbddc->change_interior) {
4754       const PetscScalar *x,*y,*v;
4755       PetscReal         lerror = 0.;
4756       PetscInt          i;
4757 
4758       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4759       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4760       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4761       for (i=0;i<local_size;i++)
4762         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4763           lerror = PetscAbsScalar(x[i]-y[i]);
4764       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4765       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4766       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4767       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4768       if (error > PETSC_SMALL) {
4769         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4770           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4771         } else {
4772           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4773         }
4774       }
4775     }
4776     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4777     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4778     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4779     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4780     if (error > PETSC_SMALL) {
4781       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4782         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4783       } else {
4784         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4785       }
4786     }
4787     ierr = VecDestroy(&x);CHKERRQ(ierr);
4788     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4789   }
4790 
4791   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4792   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4793 
4794   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4795   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4796   if (isseqaij) {
4797     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4798     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4799     if (lA) {
4800       Mat work;
4801       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4802       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4803       ierr = MatDestroy(&work);CHKERRQ(ierr);
4804     }
4805   } else {
4806     Mat work_mat;
4807 
4808     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4809     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4810     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4811     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4812     if (lA) {
4813       Mat work;
4814       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4815       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4816       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4817       ierr = MatDestroy(&work);CHKERRQ(ierr);
4818     }
4819   }
4820   if (matis->A->symmetric_set) {
4821     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4822 #if !defined(PETSC_USE_COMPLEX)
4823     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4824 #endif
4825   }
4826   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4827   PetscFunctionReturn(0);
4828 }
4829 
4830 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4831 {
4832   PC_IS*          pcis = (PC_IS*)(pc->data);
4833   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4834   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4835   PetscInt        *idx_R_local=NULL;
4836   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4837   PetscInt        vbs,bs;
4838   PetscBT         bitmask=NULL;
4839   PetscErrorCode  ierr;
4840 
4841   PetscFunctionBegin;
4842   /*
4843     No need to setup local scatters if
4844       - primal space is unchanged
4845         AND
4846       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4847         AND
4848       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4849   */
4850   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4851     PetscFunctionReturn(0);
4852   }
4853   /* destroy old objects */
4854   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4855   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4856   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4857   /* Set Non-overlapping dimensions */
4858   n_B = pcis->n_B;
4859   n_D = pcis->n - n_B;
4860   n_vertices = pcbddc->n_vertices;
4861 
4862   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4863 
4864   /* create auxiliary bitmask and allocate workspace */
4865   if (!sub_schurs || !sub_schurs->reuse_solver) {
4866     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4867     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4868     for (i=0;i<n_vertices;i++) {
4869       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4870     }
4871 
4872     for (i=0, n_R=0; i<pcis->n; i++) {
4873       if (!PetscBTLookup(bitmask,i)) {
4874         idx_R_local[n_R++] = i;
4875       }
4876     }
4877   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4878     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4879 
4880     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4881     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4882   }
4883 
4884   /* Block code */
4885   vbs = 1;
4886   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4887   if (bs>1 && !(n_vertices%bs)) {
4888     PetscBool is_blocked = PETSC_TRUE;
4889     PetscInt  *vary;
4890     if (!sub_schurs || !sub_schurs->reuse_solver) {
4891       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4892       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4893       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4894       /* 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 */
4895       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4896       for (i=0; i<pcis->n/bs; i++) {
4897         if (vary[i]!=0 && vary[i]!=bs) {
4898           is_blocked = PETSC_FALSE;
4899           break;
4900         }
4901       }
4902       ierr = PetscFree(vary);CHKERRQ(ierr);
4903     } else {
4904       /* Verify directly the R set */
4905       for (i=0; i<n_R/bs; i++) {
4906         PetscInt j,node=idx_R_local[bs*i];
4907         for (j=1; j<bs; j++) {
4908           if (node != idx_R_local[bs*i+j]-j) {
4909             is_blocked = PETSC_FALSE;
4910             break;
4911           }
4912         }
4913       }
4914     }
4915     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4916       vbs = bs;
4917       for (i=0;i<n_R/vbs;i++) {
4918         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4919       }
4920     }
4921   }
4922   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4923   if (sub_schurs && sub_schurs->reuse_solver) {
4924     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4925 
4926     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4927     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4928     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4929     reuse_solver->is_R = pcbddc->is_R_local;
4930   } else {
4931     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4932   }
4933 
4934   /* print some info if requested */
4935   if (pcbddc->dbg_flag) {
4936     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4937     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4938     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4939     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4940     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4941     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);
4942     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4943   }
4944 
4945   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4946   if (!sub_schurs || !sub_schurs->reuse_solver) {
4947     IS       is_aux1,is_aux2;
4948     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4949 
4950     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4951     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4952     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4953     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4954     for (i=0; i<n_D; i++) {
4955       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4956     }
4957     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4958     for (i=0, j=0; i<n_R; i++) {
4959       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4960         aux_array1[j++] = i;
4961       }
4962     }
4963     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4964     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4965     for (i=0, j=0; i<n_B; i++) {
4966       if (!PetscBTLookup(bitmask,is_indices[i])) {
4967         aux_array2[j++] = i;
4968       }
4969     }
4970     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4971     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4972     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4973     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4974     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4975 
4976     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4977       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4978       for (i=0, j=0; i<n_R; i++) {
4979         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4980           aux_array1[j++] = i;
4981         }
4982       }
4983       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4984       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4985       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4986     }
4987     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4988     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4989   } else {
4990     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4991     IS                 tis;
4992     PetscInt           schur_size;
4993 
4994     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4995     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4996     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4997     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4998     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4999       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5000       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5001       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5002     }
5003   }
5004   PetscFunctionReturn(0);
5005 }
5006 
5007 
5008 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5009 {
5010   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5011   PC_IS          *pcis = (PC_IS*)pc->data;
5012   PC             pc_temp;
5013   Mat            A_RR;
5014   MatReuse       reuse;
5015   PetscScalar    m_one = -1.0;
5016   PetscReal      value;
5017   PetscInt       n_D,n_R;
5018   PetscBool      check_corr,issbaij;
5019   PetscErrorCode ierr;
5020   /* prefixes stuff */
5021   char           dir_prefix[256],neu_prefix[256],str_level[16];
5022   size_t         len;
5023 
5024   PetscFunctionBegin;
5025 
5026   /* compute prefixes */
5027   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5028   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5029   if (!pcbddc->current_level) {
5030     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
5031     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
5032     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
5033     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
5034   } else {
5035     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5036     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5037     len -= 15; /* remove "pc_bddc_coarse_" */
5038     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5039     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5040     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5041     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5042     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
5043     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
5044     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
5045     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
5046   }
5047 
5048   /* DIRICHLET PROBLEM */
5049   if (dirichlet) {
5050     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5051     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5052       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
5053       if (pcbddc->dbg_flag) {
5054         Mat    A_IIn;
5055 
5056         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5057         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5058         pcis->A_II = A_IIn;
5059       }
5060     }
5061     if (pcbddc->local_mat->symmetric_set) {
5062       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5063     }
5064     /* Matrix for Dirichlet problem is pcis->A_II */
5065     n_D = pcis->n - pcis->n_B;
5066     if (!pcbddc->ksp_D) { /* create object if not yet build */
5067       void (*f)(void) = 0;
5068 
5069       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5070       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5071       /* default */
5072       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5073       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5074       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5075       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5076       if (issbaij) {
5077         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5078       } else {
5079         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5080       }
5081       /* Allow user's customization */
5082       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5083       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5084       if (f && pcbddc->mat_graph->cloc) {
5085         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5086         const PetscInt *idxs;
5087         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5088 
5089         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5090         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5091         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5092         for (i=0;i<nl;i++) {
5093           for (d=0;d<cdim;d++) {
5094             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5095           }
5096         }
5097         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5098         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5099         ierr = PetscFree(scoords);CHKERRQ(ierr);
5100       }
5101     }
5102     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5103     if (sub_schurs && sub_schurs->reuse_solver) {
5104       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5105 
5106       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5107     }
5108     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5109     if (!n_D) {
5110       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5111       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5112     }
5113     /* set ksp_D into pcis data */
5114     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5115     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5116     pcis->ksp_D = pcbddc->ksp_D;
5117   }
5118 
5119   /* NEUMANN PROBLEM */
5120   A_RR = 0;
5121   if (neumann) {
5122     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5123     PetscInt        ibs,mbs;
5124     PetscBool       issbaij, reuse_neumann_solver;
5125     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5126 
5127     reuse_neumann_solver = PETSC_FALSE;
5128     if (sub_schurs && sub_schurs->reuse_solver) {
5129       IS iP;
5130 
5131       reuse_neumann_solver = PETSC_TRUE;
5132       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5133       if (iP) reuse_neumann_solver = PETSC_FALSE;
5134     }
5135     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5136     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5137     if (pcbddc->ksp_R) { /* already created ksp */
5138       PetscInt nn_R;
5139       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5140       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5141       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5142       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5143         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5144         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5145         reuse = MAT_INITIAL_MATRIX;
5146       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5147         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5148           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5149           reuse = MAT_INITIAL_MATRIX;
5150         } else { /* safe to reuse the matrix */
5151           reuse = MAT_REUSE_MATRIX;
5152         }
5153       }
5154       /* last check */
5155       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5156         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5157         reuse = MAT_INITIAL_MATRIX;
5158       }
5159     } else { /* first time, so we need to create the matrix */
5160       reuse = MAT_INITIAL_MATRIX;
5161     }
5162     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5163     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5164     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5165     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5166     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5167       if (matis->A == pcbddc->local_mat) {
5168         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5169         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5170       } else {
5171         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5172       }
5173     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5174       if (matis->A == pcbddc->local_mat) {
5175         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5176         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5177       } else {
5178         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5179       }
5180     }
5181     /* extract A_RR */
5182     if (reuse_neumann_solver) {
5183       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5184 
5185       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5186         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5187         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5188           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5189         } else {
5190           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5191         }
5192       } else {
5193         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5194         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5195         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5196       }
5197     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5198       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5199     }
5200     if (pcbddc->local_mat->symmetric_set) {
5201       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5202     }
5203     if (!pcbddc->ksp_R) { /* create object if not present */
5204       void (*f)(void) = 0;
5205 
5206       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5207       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5208       /* default */
5209       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5210       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5211       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5212       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5213       if (issbaij) {
5214         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5215       } else {
5216         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5217       }
5218       /* Allow user's customization */
5219       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5220       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5221       if (f && pcbddc->mat_graph->cloc) {
5222         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5223         const PetscInt *idxs;
5224         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5225 
5226         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5227         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5228         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5229         for (i=0;i<nl;i++) {
5230           for (d=0;d<cdim;d++) {
5231             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5232           }
5233         }
5234         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5235         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5236         ierr = PetscFree(scoords);CHKERRQ(ierr);
5237       }
5238     }
5239     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5240     if (!n_R) {
5241       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5242       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5243     }
5244     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5245     /* Reuse solver if it is present */
5246     if (reuse_neumann_solver) {
5247       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5248 
5249       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5250     }
5251   }
5252 
5253   if (pcbddc->dbg_flag) {
5254     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5255     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5256     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5257   }
5258 
5259   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5260   check_corr = PETSC_FALSE;
5261   if (pcbddc->NullSpace_corr[0]) {
5262     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5263   }
5264   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5265     check_corr = PETSC_TRUE;
5266     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5267   }
5268   if (neumann && pcbddc->NullSpace_corr[2]) {
5269     check_corr = PETSC_TRUE;
5270     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5271   }
5272   /* check Dirichlet and Neumann solvers */
5273   if (pcbddc->dbg_flag) {
5274     if (dirichlet) { /* Dirichlet */
5275       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5276       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5277       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5278       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5279       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5280       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);
5281       if (check_corr) {
5282         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5283       }
5284       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5285     }
5286     if (neumann) { /* Neumann */
5287       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5288       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5289       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5290       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5291       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5292       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);
5293       if (check_corr) {
5294         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5295       }
5296       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5297     }
5298   }
5299   /* free Neumann problem's matrix */
5300   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5301   PetscFunctionReturn(0);
5302 }
5303 
5304 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5305 {
5306   PetscErrorCode  ierr;
5307   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5308   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5309   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5310 
5311   PetscFunctionBegin;
5312   if (!reuse_solver) {
5313     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5314   }
5315   if (!pcbddc->switch_static) {
5316     if (applytranspose && pcbddc->local_auxmat1) {
5317       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5318       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5319     }
5320     if (!reuse_solver) {
5321       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5322       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5323     } else {
5324       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5325 
5326       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5327       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5328     }
5329   } else {
5330     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5331     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5332     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5333     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5334     if (applytranspose && pcbddc->local_auxmat1) {
5335       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5336       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5337       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5338       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5339     }
5340   }
5341   if (!reuse_solver || pcbddc->switch_static) {
5342     if (applytranspose) {
5343       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5344     } else {
5345       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5346     }
5347   } else {
5348     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5349 
5350     if (applytranspose) {
5351       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5352     } else {
5353       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5354     }
5355   }
5356   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5357   if (!pcbddc->switch_static) {
5358     if (!reuse_solver) {
5359       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5360       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5361     } else {
5362       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5363 
5364       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5365       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5366     }
5367     if (!applytranspose && pcbddc->local_auxmat1) {
5368       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5369       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5370     }
5371   } else {
5372     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5373     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5374     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5375     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5376     if (!applytranspose && pcbddc->local_auxmat1) {
5377       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5378       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5379     }
5380     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5381     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5382     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5383     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5384   }
5385   PetscFunctionReturn(0);
5386 }
5387 
5388 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5389 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5390 {
5391   PetscErrorCode ierr;
5392   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5393   PC_IS*            pcis = (PC_IS*)  (pc->data);
5394   const PetscScalar zero = 0.0;
5395 
5396   PetscFunctionBegin;
5397   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5398   if (!pcbddc->benign_apply_coarse_only) {
5399     if (applytranspose) {
5400       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5401       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5402     } else {
5403       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5404       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5405     }
5406   } else {
5407     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5408   }
5409 
5410   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5411   if (pcbddc->benign_n) {
5412     PetscScalar *array;
5413     PetscInt    j;
5414 
5415     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5416     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5417     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5418   }
5419 
5420   /* start communications from local primal nodes to rhs of coarse solver */
5421   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5422   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5423   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5424 
5425   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5426   if (pcbddc->coarse_ksp) {
5427     Mat          coarse_mat;
5428     Vec          rhs,sol;
5429     MatNullSpace nullsp;
5430     PetscBool    isbddc = PETSC_FALSE;
5431 
5432     if (pcbddc->benign_have_null) {
5433       PC        coarse_pc;
5434 
5435       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5436       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5437       /* we need to propagate to coarser levels the need for a possible benign correction */
5438       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5439         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5440         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5441         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5442       }
5443     }
5444     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5445     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5446     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5447     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5448     if (nullsp) {
5449       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5450     }
5451     if (applytranspose) {
5452       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5453       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5454     } else {
5455       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5456         PC        coarse_pc;
5457 
5458         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5459         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5460         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5461         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5462       } else {
5463         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5464       }
5465     }
5466     /* we don't need the benign correction at coarser levels anymore */
5467     if (pcbddc->benign_have_null && isbddc) {
5468       PC        coarse_pc;
5469       PC_BDDC*  coarsepcbddc;
5470 
5471       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5472       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5473       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5474       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5475     }
5476     if (nullsp) {
5477       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5478     }
5479   }
5480 
5481   /* Local solution on R nodes */
5482   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5483     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5484   }
5485   /* communications from coarse sol to local primal nodes */
5486   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5487   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5488 
5489   /* Sum contributions from the two levels */
5490   if (!pcbddc->benign_apply_coarse_only) {
5491     if (applytranspose) {
5492       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5493       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5494     } else {
5495       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5496       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5497     }
5498     /* store p0 */
5499     if (pcbddc->benign_n) {
5500       PetscScalar *array;
5501       PetscInt    j;
5502 
5503       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5504       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5505       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5506     }
5507   } else { /* expand the coarse solution */
5508     if (applytranspose) {
5509       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5510     } else {
5511       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5512     }
5513   }
5514   PetscFunctionReturn(0);
5515 }
5516 
5517 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5518 {
5519   PetscErrorCode ierr;
5520   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5521   PetscScalar    *array;
5522   Vec            from,to;
5523 
5524   PetscFunctionBegin;
5525   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5526     from = pcbddc->coarse_vec;
5527     to = pcbddc->vec1_P;
5528     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5529       Vec tvec;
5530 
5531       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5532       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5533       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5534       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5535       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5536       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5537     }
5538   } else { /* from local to global -> put data in coarse right hand side */
5539     from = pcbddc->vec1_P;
5540     to = pcbddc->coarse_vec;
5541   }
5542   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5543   PetscFunctionReturn(0);
5544 }
5545 
5546 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5547 {
5548   PetscErrorCode ierr;
5549   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5550   PetscScalar    *array;
5551   Vec            from,to;
5552 
5553   PetscFunctionBegin;
5554   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5555     from = pcbddc->coarse_vec;
5556     to = pcbddc->vec1_P;
5557   } else { /* from local to global -> put data in coarse right hand side */
5558     from = pcbddc->vec1_P;
5559     to = pcbddc->coarse_vec;
5560   }
5561   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5562   if (smode == SCATTER_FORWARD) {
5563     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5564       Vec tvec;
5565 
5566       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5567       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5568       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5569       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5570     }
5571   } else {
5572     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5573      ierr = VecResetArray(from);CHKERRQ(ierr);
5574     }
5575   }
5576   PetscFunctionReturn(0);
5577 }
5578 
5579 /* uncomment for testing purposes */
5580 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5581 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5582 {
5583   PetscErrorCode    ierr;
5584   PC_IS*            pcis = (PC_IS*)(pc->data);
5585   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5586   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5587   /* one and zero */
5588   PetscScalar       one=1.0,zero=0.0;
5589   /* space to store constraints and their local indices */
5590   PetscScalar       *constraints_data;
5591   PetscInt          *constraints_idxs,*constraints_idxs_B;
5592   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5593   PetscInt          *constraints_n;
5594   /* iterators */
5595   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5596   /* BLAS integers */
5597   PetscBLASInt      lwork,lierr;
5598   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5599   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5600   /* reuse */
5601   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5602   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5603   /* change of basis */
5604   PetscBool         qr_needed;
5605   PetscBT           change_basis,qr_needed_idx;
5606   /* auxiliary stuff */
5607   PetscInt          *nnz,*is_indices;
5608   PetscInt          ncc;
5609   /* some quantities */
5610   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5611   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5612   PetscReal         tol; /* tolerance for retaining eigenmodes */
5613 
5614   PetscFunctionBegin;
5615   tol  = PetscSqrtReal(PETSC_SMALL);
5616   /* Destroy Mat objects computed previously */
5617   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5618   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5619   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5620   /* save info on constraints from previous setup (if any) */
5621   olocal_primal_size = pcbddc->local_primal_size;
5622   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5623   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5624   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5625   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5626   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5627   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5628 
5629   if (!pcbddc->adaptive_selection) {
5630     IS           ISForVertices,*ISForFaces,*ISForEdges;
5631     MatNullSpace nearnullsp;
5632     const Vec    *nearnullvecs;
5633     Vec          *localnearnullsp;
5634     PetscScalar  *array;
5635     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5636     PetscBool    nnsp_has_cnst;
5637     /* LAPACK working arrays for SVD or POD */
5638     PetscBool    skip_lapack,boolforchange;
5639     PetscScalar  *work;
5640     PetscReal    *singular_vals;
5641 #if defined(PETSC_USE_COMPLEX)
5642     PetscReal    *rwork;
5643 #endif
5644 #if defined(PETSC_MISSING_LAPACK_GESVD)
5645     PetscScalar  *temp_basis,*correlation_mat;
5646 #else
5647     PetscBLASInt dummy_int=1;
5648     PetscScalar  dummy_scalar=1.;
5649 #endif
5650 
5651     /* Get index sets for faces, edges and vertices from graph */
5652     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5653     /* print some info */
5654     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5655       PetscInt nv;
5656 
5657       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5658       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5659       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5660       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5661       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5662       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5663       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5664       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5665       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5666     }
5667 
5668     /* free unneeded index sets */
5669     if (!pcbddc->use_vertices) {
5670       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5671     }
5672     if (!pcbddc->use_edges) {
5673       for (i=0;i<n_ISForEdges;i++) {
5674         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5675       }
5676       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5677       n_ISForEdges = 0;
5678     }
5679     if (!pcbddc->use_faces) {
5680       for (i=0;i<n_ISForFaces;i++) {
5681         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5682       }
5683       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5684       n_ISForFaces = 0;
5685     }
5686 
5687     /* check if near null space is attached to global mat */
5688     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5689     if (nearnullsp) {
5690       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5691       /* remove any stored info */
5692       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5693       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5694       /* store information for BDDC solver reuse */
5695       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5696       pcbddc->onearnullspace = nearnullsp;
5697       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5698       for (i=0;i<nnsp_size;i++) {
5699         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5700       }
5701     } else { /* if near null space is not provided BDDC uses constants by default */
5702       nnsp_size = 0;
5703       nnsp_has_cnst = PETSC_TRUE;
5704     }
5705     /* get max number of constraints on a single cc */
5706     max_constraints = nnsp_size;
5707     if (nnsp_has_cnst) max_constraints++;
5708 
5709     /*
5710          Evaluate maximum storage size needed by the procedure
5711          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5712          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5713          There can be multiple constraints per connected component
5714                                                                                                                                                            */
5715     n_vertices = 0;
5716     if (ISForVertices) {
5717       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5718     }
5719     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5720     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5721 
5722     total_counts = n_ISForFaces+n_ISForEdges;
5723     total_counts *= max_constraints;
5724     total_counts += n_vertices;
5725     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5726 
5727     total_counts = 0;
5728     max_size_of_constraint = 0;
5729     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5730       IS used_is;
5731       if (i<n_ISForEdges) {
5732         used_is = ISForEdges[i];
5733       } else {
5734         used_is = ISForFaces[i-n_ISForEdges];
5735       }
5736       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5737       total_counts += j;
5738       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5739     }
5740     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);
5741 
5742     /* get local part of global near null space vectors */
5743     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5744     for (k=0;k<nnsp_size;k++) {
5745       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5746       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5747       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5748     }
5749 
5750     /* whether or not to skip lapack calls */
5751     skip_lapack = PETSC_TRUE;
5752     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5753 
5754     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5755     if (!skip_lapack) {
5756       PetscScalar temp_work;
5757 
5758 #if defined(PETSC_MISSING_LAPACK_GESVD)
5759       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5760       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5761       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5762       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5763 #if defined(PETSC_USE_COMPLEX)
5764       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5765 #endif
5766       /* now we evaluate the optimal workspace using query with lwork=-1 */
5767       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5768       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5769       lwork = -1;
5770       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5771 #if !defined(PETSC_USE_COMPLEX)
5772       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5773 #else
5774       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5775 #endif
5776       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5777       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5778 #else /* on missing GESVD */
5779       /* SVD */
5780       PetscInt max_n,min_n;
5781       max_n = max_size_of_constraint;
5782       min_n = max_constraints;
5783       if (max_size_of_constraint < max_constraints) {
5784         min_n = max_size_of_constraint;
5785         max_n = max_constraints;
5786       }
5787       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5788 #if defined(PETSC_USE_COMPLEX)
5789       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5790 #endif
5791       /* now we evaluate the optimal workspace using query with lwork=-1 */
5792       lwork = -1;
5793       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5794       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5795       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5796       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5797 #if !defined(PETSC_USE_COMPLEX)
5798       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));
5799 #else
5800       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));
5801 #endif
5802       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5803       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5804 #endif /* on missing GESVD */
5805       /* Allocate optimal workspace */
5806       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5807       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5808     }
5809     /* Now we can loop on constraining sets */
5810     total_counts = 0;
5811     constraints_idxs_ptr[0] = 0;
5812     constraints_data_ptr[0] = 0;
5813     /* vertices */
5814     if (n_vertices) {
5815       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5816       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5817       for (i=0;i<n_vertices;i++) {
5818         constraints_n[total_counts] = 1;
5819         constraints_data[total_counts] = 1.0;
5820         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5821         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5822         total_counts++;
5823       }
5824       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5825       n_vertices = total_counts;
5826     }
5827 
5828     /* edges and faces */
5829     total_counts_cc = total_counts;
5830     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5831       IS        used_is;
5832       PetscBool idxs_copied = PETSC_FALSE;
5833 
5834       if (ncc<n_ISForEdges) {
5835         used_is = ISForEdges[ncc];
5836         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5837       } else {
5838         used_is = ISForFaces[ncc-n_ISForEdges];
5839         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5840       }
5841       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5842 
5843       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5844       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5845       /* change of basis should not be performed on local periodic nodes */
5846       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5847       if (nnsp_has_cnst) {
5848         PetscScalar quad_value;
5849 
5850         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5851         idxs_copied = PETSC_TRUE;
5852 
5853         if (!pcbddc->use_nnsp_true) {
5854           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5855         } else {
5856           quad_value = 1.0;
5857         }
5858         for (j=0;j<size_of_constraint;j++) {
5859           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5860         }
5861         temp_constraints++;
5862         total_counts++;
5863       }
5864       for (k=0;k<nnsp_size;k++) {
5865         PetscReal real_value;
5866         PetscScalar *ptr_to_data;
5867 
5868         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5869         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5870         for (j=0;j<size_of_constraint;j++) {
5871           ptr_to_data[j] = array[is_indices[j]];
5872         }
5873         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5874         /* check if array is null on the connected component */
5875         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5876         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5877         if (real_value > tol*size_of_constraint) { /* keep indices and values */
5878           temp_constraints++;
5879           total_counts++;
5880           if (!idxs_copied) {
5881             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5882             idxs_copied = PETSC_TRUE;
5883           }
5884         }
5885       }
5886       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5887       valid_constraints = temp_constraints;
5888       if (!pcbddc->use_nnsp_true && temp_constraints) {
5889         if (temp_constraints == 1) { /* just normalize the constraint */
5890           PetscScalar norm,*ptr_to_data;
5891 
5892           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5893           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5894           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5895           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5896           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5897         } else { /* perform SVD */
5898           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5899 
5900 #if defined(PETSC_MISSING_LAPACK_GESVD)
5901           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5902              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5903              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5904                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5905                 from that computed using LAPACKgesvd
5906              -> This is due to a different computation of eigenvectors in LAPACKheev
5907              -> The quality of the POD-computed basis will be the same */
5908           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5909           /* Store upper triangular part of correlation matrix */
5910           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5911           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5912           for (j=0;j<temp_constraints;j++) {
5913             for (k=0;k<j+1;k++) {
5914               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));
5915             }
5916           }
5917           /* compute eigenvalues and eigenvectors of correlation matrix */
5918           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5919           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5920 #if !defined(PETSC_USE_COMPLEX)
5921           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5922 #else
5923           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5924 #endif
5925           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5926           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5927           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5928           j = 0;
5929           while (j < temp_constraints && singular_vals[j] < tol) j++;
5930           total_counts = total_counts-j;
5931           valid_constraints = temp_constraints-j;
5932           /* scale and copy POD basis into used quadrature memory */
5933           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5934           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5935           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5936           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5937           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5938           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5939           if (j<temp_constraints) {
5940             PetscInt ii;
5941             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5942             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5943             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));
5944             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5945             for (k=0;k<temp_constraints-j;k++) {
5946               for (ii=0;ii<size_of_constraint;ii++) {
5947                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5948               }
5949             }
5950           }
5951 #else  /* on missing GESVD */
5952           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5953           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5954           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5955           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5956 #if !defined(PETSC_USE_COMPLEX)
5957           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));
5958 #else
5959           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));
5960 #endif
5961           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5962           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5963           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5964           k = temp_constraints;
5965           if (k > size_of_constraint) k = size_of_constraint;
5966           j = 0;
5967           while (j < k && singular_vals[k-j-1] < tol) j++;
5968           valid_constraints = k-j;
5969           total_counts = total_counts-temp_constraints+valid_constraints;
5970 #endif /* on missing GESVD */
5971         }
5972       }
5973       /* update pointers information */
5974       if (valid_constraints) {
5975         constraints_n[total_counts_cc] = valid_constraints;
5976         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5977         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5978         /* set change_of_basis flag */
5979         if (boolforchange) {
5980           PetscBTSet(change_basis,total_counts_cc);
5981         }
5982         total_counts_cc++;
5983       }
5984     }
5985     /* free workspace */
5986     if (!skip_lapack) {
5987       ierr = PetscFree(work);CHKERRQ(ierr);
5988 #if defined(PETSC_USE_COMPLEX)
5989       ierr = PetscFree(rwork);CHKERRQ(ierr);
5990 #endif
5991       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5992 #if defined(PETSC_MISSING_LAPACK_GESVD)
5993       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5994       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5995 #endif
5996     }
5997     for (k=0;k<nnsp_size;k++) {
5998       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5999     }
6000     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6001     /* free index sets of faces, edges and vertices */
6002     for (i=0;i<n_ISForFaces;i++) {
6003       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6004     }
6005     if (n_ISForFaces) {
6006       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6007     }
6008     for (i=0;i<n_ISForEdges;i++) {
6009       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6010     }
6011     if (n_ISForEdges) {
6012       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6013     }
6014     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6015   } else {
6016     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6017 
6018     total_counts = 0;
6019     n_vertices = 0;
6020     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6021       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6022     }
6023     max_constraints = 0;
6024     total_counts_cc = 0;
6025     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6026       total_counts += pcbddc->adaptive_constraints_n[i];
6027       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6028       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6029     }
6030     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6031     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6032     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6033     constraints_data = pcbddc->adaptive_constraints_data;
6034     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6035     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6036     total_counts_cc = 0;
6037     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6038       if (pcbddc->adaptive_constraints_n[i]) {
6039         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6040       }
6041     }
6042 #if 0
6043     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
6044     for (i=0;i<total_counts_cc;i++) {
6045       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
6046       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
6047       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
6048         printf(" %d",constraints_idxs[j]);
6049       }
6050       printf("\n");
6051       printf("number of cc: %d\n",constraints_n[i]);
6052     }
6053     for (i=0;i<n_vertices;i++) {
6054       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
6055     }
6056     for (i=0;i<sub_schurs->n_subs;i++) {
6057       PetscPrintf(PETSC_COMM_SELF,"[%d] sub %d, edge %d, n %d\n",PetscGlobalRank,i,(PetscBool)PetscBTLookup(sub_schurs->is_edge,i),pcbddc->adaptive_constraints_n[i+n_vertices]);
6058     }
6059 #endif
6060 
6061     max_size_of_constraint = 0;
6062     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]);
6063     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6064     /* Change of basis */
6065     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6066     if (pcbddc->use_change_of_basis) {
6067       for (i=0;i<sub_schurs->n_subs;i++) {
6068         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6069           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6070         }
6071       }
6072     }
6073   }
6074   pcbddc->local_primal_size = total_counts;
6075   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6076 
6077   /* map constraints_idxs in boundary numbering */
6078   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6079   if (i != constraints_idxs_ptr[total_counts_cc]) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for constraints indices %D != %D\n",constraints_idxs_ptr[total_counts_cc],i);
6080 
6081   /* Create constraint matrix */
6082   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6083   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6084   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6085 
6086   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6087   /* determine if a QR strategy is needed for change of basis */
6088   qr_needed = PETSC_FALSE;
6089   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6090   total_primal_vertices=0;
6091   pcbddc->local_primal_size_cc = 0;
6092   for (i=0;i<total_counts_cc;i++) {
6093     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6094     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6095       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6096       pcbddc->local_primal_size_cc += 1;
6097     } else if (PetscBTLookup(change_basis,i)) {
6098       for (k=0;k<constraints_n[i];k++) {
6099         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6100       }
6101       pcbddc->local_primal_size_cc += constraints_n[i];
6102       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6103         PetscBTSet(qr_needed_idx,i);
6104         qr_needed = PETSC_TRUE;
6105       }
6106     } else {
6107       pcbddc->local_primal_size_cc += 1;
6108     }
6109   }
6110   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6111   pcbddc->n_vertices = total_primal_vertices;
6112   /* permute indices in order to have a sorted set of vertices */
6113   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6114   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);
6115   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6116   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6117 
6118   /* nonzero structure of constraint matrix */
6119   /* and get reference dof for local constraints */
6120   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6121   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6122 
6123   j = total_primal_vertices;
6124   total_counts = total_primal_vertices;
6125   cum = total_primal_vertices;
6126   for (i=n_vertices;i<total_counts_cc;i++) {
6127     if (!PetscBTLookup(change_basis,i)) {
6128       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6129       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6130       cum++;
6131       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6132       for (k=0;k<constraints_n[i];k++) {
6133         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6134         nnz[j+k] = size_of_constraint;
6135       }
6136       j += constraints_n[i];
6137     }
6138   }
6139   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6140   ierr = PetscFree(nnz);CHKERRQ(ierr);
6141 
6142   /* set values in constraint matrix */
6143   for (i=0;i<total_primal_vertices;i++) {
6144     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6145   }
6146   total_counts = total_primal_vertices;
6147   for (i=n_vertices;i<total_counts_cc;i++) {
6148     if (!PetscBTLookup(change_basis,i)) {
6149       PetscInt *cols;
6150 
6151       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6152       cols = constraints_idxs+constraints_idxs_ptr[i];
6153       for (k=0;k<constraints_n[i];k++) {
6154         PetscInt    row = total_counts+k;
6155         PetscScalar *vals;
6156 
6157         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6158         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6159       }
6160       total_counts += constraints_n[i];
6161     }
6162   }
6163   /* assembling */
6164   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6165   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6166   ierr = MatChop(pcbddc->ConstraintMatrix,PETSC_SMALL);CHKERRQ(ierr);
6167   ierr = MatSeqAIJCompress(pcbddc->ConstraintMatrix,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6168   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6169 
6170   /*
6171   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6172   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6173   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6174   */
6175   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6176   if (pcbddc->use_change_of_basis) {
6177     /* dual and primal dofs on a single cc */
6178     PetscInt     dual_dofs,primal_dofs;
6179     /* working stuff for GEQRF */
6180     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6181     PetscBLASInt lqr_work;
6182     /* working stuff for UNGQR */
6183     PetscScalar  *gqr_work,lgqr_work_t;
6184     PetscBLASInt lgqr_work;
6185     /* working stuff for TRTRS */
6186     PetscScalar  *trs_rhs;
6187     PetscBLASInt Blas_NRHS;
6188     /* pointers for values insertion into change of basis matrix */
6189     PetscInt     *start_rows,*start_cols;
6190     PetscScalar  *start_vals;
6191     /* working stuff for values insertion */
6192     PetscBT      is_primal;
6193     PetscInt     *aux_primal_numbering_B;
6194     /* matrix sizes */
6195     PetscInt     global_size,local_size;
6196     /* temporary change of basis */
6197     Mat          localChangeOfBasisMatrix;
6198     /* extra space for debugging */
6199     PetscScalar  *dbg_work;
6200 
6201     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6202     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6203     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6204     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6205     /* nonzeros for local mat */
6206     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6207     if (!pcbddc->benign_change || pcbddc->fake_change) {
6208       for (i=0;i<pcis->n;i++) nnz[i]=1;
6209     } else {
6210       const PetscInt *ii;
6211       PetscInt       n;
6212       PetscBool      flg_row;
6213       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6214       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6215       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6216     }
6217     for (i=n_vertices;i<total_counts_cc;i++) {
6218       if (PetscBTLookup(change_basis,i)) {
6219         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6220         if (PetscBTLookup(qr_needed_idx,i)) {
6221           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6222         } else {
6223           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6224           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6225         }
6226       }
6227     }
6228     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6229     ierr = PetscFree(nnz);CHKERRQ(ierr);
6230     /* Set interior change in the matrix */
6231     if (!pcbddc->benign_change || pcbddc->fake_change) {
6232       for (i=0;i<pcis->n;i++) {
6233         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6234       }
6235     } else {
6236       const PetscInt *ii,*jj;
6237       PetscScalar    *aa;
6238       PetscInt       n;
6239       PetscBool      flg_row;
6240       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6241       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6242       for (i=0;i<n;i++) {
6243         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6244       }
6245       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6246       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6247     }
6248 
6249     if (pcbddc->dbg_flag) {
6250       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6251       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6252     }
6253 
6254 
6255     /* Now we loop on the constraints which need a change of basis */
6256     /*
6257        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6258        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6259 
6260        Basic blocks of change of basis matrix T computed by
6261 
6262           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6263 
6264             | 1        0   ...        0         s_1/S |
6265             | 0        1   ...        0         s_2/S |
6266             |              ...                        |
6267             | 0        ...            1     s_{n-1}/S |
6268             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6269 
6270             with S = \sum_{i=1}^n s_i^2
6271             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6272                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6273 
6274           - QR decomposition of constraints otherwise
6275     */
6276     if (qr_needed) {
6277       /* space to store Q */
6278       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6279       /* array to store scaling factors for reflectors */
6280       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6281       /* first we issue queries for optimal work */
6282       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6283       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6284       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6285       lqr_work = -1;
6286       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6287       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6288       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6289       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6290       lgqr_work = -1;
6291       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6292       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6293       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6294       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6295       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6296       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6297       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6298       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6299       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6300       /* array to store rhs and solution of triangular solver */
6301       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6302       /* allocating workspace for check */
6303       if (pcbddc->dbg_flag) {
6304         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6305       }
6306     }
6307     /* array to store whether a node is primal or not */
6308     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6309     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6310     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6311     if (i != total_primal_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",total_primal_vertices,i);
6312     for (i=0;i<total_primal_vertices;i++) {
6313       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6314     }
6315     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6316 
6317     /* loop on constraints and see whether or not they need a change of basis and compute it */
6318     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6319       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6320       if (PetscBTLookup(change_basis,total_counts)) {
6321         /* get constraint info */
6322         primal_dofs = constraints_n[total_counts];
6323         dual_dofs = size_of_constraint-primal_dofs;
6324 
6325         if (pcbddc->dbg_flag) {
6326           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);
6327         }
6328 
6329         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6330 
6331           /* copy quadrature constraints for change of basis check */
6332           if (pcbddc->dbg_flag) {
6333             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6334           }
6335           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6336           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6337 
6338           /* compute QR decomposition of constraints */
6339           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6340           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6341           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6342           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6343           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6344           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6345           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6346 
6347           /* explictly compute R^-T */
6348           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6349           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6350           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6351           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6352           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6353           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6354           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6355           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6356           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6357           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6358 
6359           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6360           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6361           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6362           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6363           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6364           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6365           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6366           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6367           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6368 
6369           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6370              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6371              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6372           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6373           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6374           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6375           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6376           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6377           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6378           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6379           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));
6380           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6381           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6382 
6383           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6384           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6385           /* insert cols for primal dofs */
6386           for (j=0;j<primal_dofs;j++) {
6387             start_vals = &qr_basis[j*size_of_constraint];
6388             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6389             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6390           }
6391           /* insert cols for dual dofs */
6392           for (j=0,k=0;j<dual_dofs;k++) {
6393             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6394               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6395               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6396               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6397               j++;
6398             }
6399           }
6400 
6401           /* check change of basis */
6402           if (pcbddc->dbg_flag) {
6403             PetscInt   ii,jj;
6404             PetscBool valid_qr=PETSC_TRUE;
6405             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6406             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6407             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6408             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6409             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6410             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6411             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6412             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));
6413             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6414             for (jj=0;jj<size_of_constraint;jj++) {
6415               for (ii=0;ii<primal_dofs;ii++) {
6416                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6417                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6418               }
6419             }
6420             if (!valid_qr) {
6421               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6422               for (jj=0;jj<size_of_constraint;jj++) {
6423                 for (ii=0;ii<primal_dofs;ii++) {
6424                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6425                     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]));
6426                   }
6427                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6428                     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]));
6429                   }
6430                 }
6431               }
6432             } else {
6433               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6434             }
6435           }
6436         } else { /* simple transformation block */
6437           PetscInt    row,col;
6438           PetscScalar val,norm;
6439 
6440           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6441           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6442           for (j=0;j<size_of_constraint;j++) {
6443             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6444             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6445             if (!PetscBTLookup(is_primal,row_B)) {
6446               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6447               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6448               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6449             } else {
6450               for (k=0;k<size_of_constraint;k++) {
6451                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6452                 if (row != col) {
6453                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6454                 } else {
6455                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6456                 }
6457                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6458               }
6459             }
6460           }
6461           if (pcbddc->dbg_flag) {
6462             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6463           }
6464         }
6465       } else {
6466         if (pcbddc->dbg_flag) {
6467           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6468         }
6469       }
6470     }
6471 
6472     /* free workspace */
6473     if (qr_needed) {
6474       if (pcbddc->dbg_flag) {
6475         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6476       }
6477       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6478       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6479       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6480       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6481       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6482     }
6483     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6484     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6485     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6486 
6487     /* assembling of global change of variable */
6488     if (!pcbddc->fake_change) {
6489       Mat      tmat;
6490       PetscInt bs;
6491 
6492       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6493       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6494       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6495       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6496       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6497       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6498       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6499       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6500       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6501       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6502       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6503       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6504       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6505       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6506       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6507       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6508       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6509       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6510 
6511       /* check */
6512       if (pcbddc->dbg_flag) {
6513         PetscReal error;
6514         Vec       x,x_change;
6515 
6516         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6517         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6518         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6519         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6520         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6521         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6522         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6523         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6524         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6525         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6526         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6527         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6528         if (error > PETSC_SMALL) {
6529           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6530         }
6531         ierr = VecDestroy(&x);CHKERRQ(ierr);
6532         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6533       }
6534       /* adapt sub_schurs computed (if any) */
6535       if (pcbddc->use_deluxe_scaling) {
6536         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6537 
6538         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");
6539         if (sub_schurs && sub_schurs->S_Ej_all) {
6540           Mat                    S_new,tmat;
6541           IS                     is_all_N,is_V_Sall = NULL;
6542 
6543           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6544           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6545           if (pcbddc->deluxe_zerorows) {
6546             ISLocalToGlobalMapping NtoSall;
6547             IS                     is_V;
6548             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6549             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6550             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6551             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6552             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6553           }
6554           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6555           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6556           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6557           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6558           if (pcbddc->deluxe_zerorows) {
6559             const PetscScalar *array;
6560             const PetscInt    *idxs_V,*idxs_all;
6561             PetscInt          i,n_V;
6562 
6563             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6564             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6565             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6566             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6567             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6568             for (i=0;i<n_V;i++) {
6569               PetscScalar val;
6570               PetscInt    idx;
6571 
6572               idx = idxs_V[i];
6573               val = array[idxs_all[idxs_V[i]]];
6574               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6575             }
6576             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6577             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6578             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6579             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6580             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6581           }
6582           sub_schurs->S_Ej_all = S_new;
6583           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6584           if (sub_schurs->sum_S_Ej_all) {
6585             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6586             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6587             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6588             if (pcbddc->deluxe_zerorows) {
6589               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6590             }
6591             sub_schurs->sum_S_Ej_all = S_new;
6592             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6593           }
6594           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6595           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6596         }
6597         /* destroy any change of basis context in sub_schurs */
6598         if (sub_schurs && sub_schurs->change) {
6599           PetscInt i;
6600 
6601           for (i=0;i<sub_schurs->n_subs;i++) {
6602             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6603           }
6604           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6605         }
6606       }
6607       if (pcbddc->switch_static) { /* need to save the local change */
6608         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6609       } else {
6610         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6611       }
6612       /* determine if any process has changed the pressures locally */
6613       pcbddc->change_interior = pcbddc->benign_have_null;
6614     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6615       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6616       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6617       pcbddc->use_qr_single = qr_needed;
6618     }
6619   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6620     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6621       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6622       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6623     } else {
6624       Mat benign_global = NULL;
6625       if (pcbddc->benign_have_null) {
6626         Mat tmat;
6627 
6628         pcbddc->change_interior = PETSC_TRUE;
6629         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6630         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6631         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6632         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6633         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6634         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6635         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6636         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6637         if (pcbddc->benign_change) {
6638           Mat M;
6639 
6640           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6641           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6642           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6643           ierr = MatDestroy(&M);CHKERRQ(ierr);
6644         } else {
6645           Mat         eye;
6646           PetscScalar *array;
6647 
6648           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6649           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6650           for (i=0;i<pcis->n;i++) {
6651             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6652           }
6653           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6654           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6655           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6656           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6657           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6658         }
6659         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6660         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6661       }
6662       if (pcbddc->user_ChangeOfBasisMatrix) {
6663         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6664         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6665       } else if (pcbddc->benign_have_null) {
6666         pcbddc->ChangeOfBasisMatrix = benign_global;
6667       }
6668     }
6669     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6670       IS             is_global;
6671       const PetscInt *gidxs;
6672 
6673       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6674       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6675       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6676       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6677       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6678     }
6679   }
6680   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6681     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6682   }
6683 
6684   if (!pcbddc->fake_change) {
6685     /* add pressure dofs to set of primal nodes for numbering purposes */
6686     for (i=0;i<pcbddc->benign_n;i++) {
6687       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6688       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6689       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6690       pcbddc->local_primal_size_cc++;
6691       pcbddc->local_primal_size++;
6692     }
6693 
6694     /* check if a new primal space has been introduced (also take into account benign trick) */
6695     pcbddc->new_primal_space_local = PETSC_TRUE;
6696     if (olocal_primal_size == pcbddc->local_primal_size) {
6697       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6698       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6699       if (!pcbddc->new_primal_space_local) {
6700         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6701         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6702       }
6703     }
6704     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6705     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6706   }
6707   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6708 
6709   /* flush dbg viewer */
6710   if (pcbddc->dbg_flag) {
6711     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6712   }
6713 
6714   /* free workspace */
6715   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6716   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6717   if (!pcbddc->adaptive_selection) {
6718     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6719     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6720   } else {
6721     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6722                       pcbddc->adaptive_constraints_idxs_ptr,
6723                       pcbddc->adaptive_constraints_data_ptr,
6724                       pcbddc->adaptive_constraints_idxs,
6725                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6726     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6727     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6728   }
6729   PetscFunctionReturn(0);
6730 }
6731 /* #undef PETSC_MISSING_LAPACK_GESVD */
6732 
6733 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6734 {
6735   ISLocalToGlobalMapping map;
6736   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6737   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6738   PetscInt               i,N;
6739   PetscBool              rcsr = PETSC_FALSE;
6740   PetscErrorCode         ierr;
6741 
6742   PetscFunctionBegin;
6743   if (pcbddc->recompute_topography) {
6744     pcbddc->graphanalyzed = PETSC_FALSE;
6745     /* Reset previously computed graph */
6746     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6747     /* Init local Graph struct */
6748     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6749     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6750     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6751 
6752     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6753       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6754     }
6755     /* Check validity of the csr graph passed in by the user */
6756     if (pcbddc->mat_graph->nvtxs_csr && pcbddc->mat_graph->nvtxs_csr != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Invalid size of local CSR graph! Found %D, expected %D\n",pcbddc->mat_graph->nvtxs_csr,pcbddc->mat_graph->nvtxs);
6757 
6758     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6759     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6760       PetscInt  *xadj,*adjncy;
6761       PetscInt  nvtxs;
6762       PetscBool flg_row=PETSC_FALSE;
6763 
6764       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6765       if (flg_row) {
6766         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6767         pcbddc->computed_rowadj = PETSC_TRUE;
6768       }
6769       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6770       rcsr = PETSC_TRUE;
6771     }
6772     if (pcbddc->dbg_flag) {
6773       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6774     }
6775 
6776     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6777       PetscReal    *lcoords;
6778       PetscInt     n;
6779       MPI_Datatype dimrealtype;
6780 
6781       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);
6782       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6783       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
6784       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6785       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6786       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6787       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6788       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6789       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6790       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6791 
6792       pcbddc->mat_graph->coords = lcoords;
6793       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6794       pcbddc->mat_graph->cnloc  = n;
6795     }
6796     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);
6797 
6798     /* Setup of Graph */
6799     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6800     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6801 
6802     /* attach info on disconnected subdomains if present */
6803     if (pcbddc->n_local_subs) {
6804       PetscInt *local_subs;
6805 
6806       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6807       for (i=0;i<pcbddc->n_local_subs;i++) {
6808         const PetscInt *idxs;
6809         PetscInt       nl,j;
6810 
6811         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6812         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6813         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6814         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6815       }
6816       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6817       pcbddc->mat_graph->local_subs = local_subs;
6818     }
6819   }
6820 
6821   if (!pcbddc->graphanalyzed) {
6822     /* Graph's connected components analysis */
6823     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6824     pcbddc->graphanalyzed = PETSC_TRUE;
6825   }
6826   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6827   PetscFunctionReturn(0);
6828 }
6829 
6830 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6831 {
6832   PetscInt       i,j;
6833   PetscScalar    *alphas;
6834   PetscErrorCode ierr;
6835 
6836   PetscFunctionBegin;
6837   if (!n) PetscFunctionReturn(0);
6838   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6839   ierr = VecNormalize(vecs[0],NULL);CHKERRQ(ierr);
6840   for (i=1;i<n;i++) {
6841     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
6842     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
6843     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
6844     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6845   }
6846   ierr = PetscFree(alphas);CHKERRQ(ierr);
6847   PetscFunctionReturn(0);
6848 }
6849 
6850 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6851 {
6852   Mat            A;
6853   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6854   PetscMPIInt    size,rank,color;
6855   PetscInt       *xadj,*adjncy;
6856   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6857   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6858   PetscInt       void_procs,*procs_candidates = NULL;
6859   PetscInt       xadj_count,*count;
6860   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6861   PetscSubcomm   psubcomm;
6862   MPI_Comm       subcomm;
6863   PetscErrorCode ierr;
6864 
6865   PetscFunctionBegin;
6866   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6867   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6868   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);
6869   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6870   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6871   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6872 
6873   if (have_void) *have_void = PETSC_FALSE;
6874   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6875   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6876   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6877   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6878   im_active = !!n;
6879   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6880   void_procs = size - active_procs;
6881   /* get ranks of of non-active processes in mat communicator */
6882   if (void_procs) {
6883     PetscInt ncand;
6884 
6885     if (have_void) *have_void = PETSC_TRUE;
6886     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6887     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6888     for (i=0,ncand=0;i<size;i++) {
6889       if (!procs_candidates[i]) {
6890         procs_candidates[ncand++] = i;
6891       }
6892     }
6893     /* force n_subdomains to be not greater that the number of non-active processes */
6894     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6895   }
6896 
6897   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6898      number of subdomains requested 1 -> send to master or first candidate in voids  */
6899   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6900   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6901     PetscInt issize,isidx,dest;
6902     if (*n_subdomains == 1) dest = 0;
6903     else dest = rank;
6904     if (im_active) {
6905       issize = 1;
6906       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6907         isidx = procs_candidates[dest];
6908       } else {
6909         isidx = dest;
6910       }
6911     } else {
6912       issize = 0;
6913       isidx = -1;
6914     }
6915     if (*n_subdomains != 1) *n_subdomains = active_procs;
6916     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6917     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6918     PetscFunctionReturn(0);
6919   }
6920   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6921   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6922   threshold = PetscMax(threshold,2);
6923 
6924   /* Get info on mapping */
6925   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6926 
6927   /* build local CSR graph of subdomains' connectivity */
6928   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6929   xadj[0] = 0;
6930   xadj[1] = PetscMax(n_neighs-1,0);
6931   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6932   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6933   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6934   for (i=1;i<n_neighs;i++)
6935     for (j=0;j<n_shared[i];j++)
6936       count[shared[i][j]] += 1;
6937 
6938   xadj_count = 0;
6939   for (i=1;i<n_neighs;i++) {
6940     for (j=0;j<n_shared[i];j++) {
6941       if (count[shared[i][j]] < threshold) {
6942         adjncy[xadj_count] = neighs[i];
6943         adjncy_wgt[xadj_count] = n_shared[i];
6944         xadj_count++;
6945         break;
6946       }
6947     }
6948   }
6949   xadj[1] = xadj_count;
6950   ierr = PetscFree(count);CHKERRQ(ierr);
6951   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6952   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6953 
6954   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6955 
6956   /* Restrict work on active processes only */
6957   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6958   if (void_procs) {
6959     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6960     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6961     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6962     subcomm = PetscSubcommChild(psubcomm);
6963   } else {
6964     psubcomm = NULL;
6965     subcomm = PetscObjectComm((PetscObject)mat);
6966   }
6967 
6968   v_wgt = NULL;
6969   if (!color) {
6970     ierr = PetscFree(xadj);CHKERRQ(ierr);
6971     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6972     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6973   } else {
6974     Mat             subdomain_adj;
6975     IS              new_ranks,new_ranks_contig;
6976     MatPartitioning partitioner;
6977     PetscInt        rstart=0,rend=0;
6978     PetscInt        *is_indices,*oldranks;
6979     PetscMPIInt     size;
6980     PetscBool       aggregate;
6981 
6982     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6983     if (void_procs) {
6984       PetscInt prank = rank;
6985       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6986       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6987       for (i=0;i<xadj[1];i++) {
6988         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6989       }
6990       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6991     } else {
6992       oldranks = NULL;
6993     }
6994     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6995     if (aggregate) { /* TODO: all this part could be made more efficient */
6996       PetscInt    lrows,row,ncols,*cols;
6997       PetscMPIInt nrank;
6998       PetscScalar *vals;
6999 
7000       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7001       lrows = 0;
7002       if (nrank<redprocs) {
7003         lrows = size/redprocs;
7004         if (nrank<size%redprocs) lrows++;
7005       }
7006       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7007       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7008       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7009       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7010       row = nrank;
7011       ncols = xadj[1]-xadj[0];
7012       cols = adjncy;
7013       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7014       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7015       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7016       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7017       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7018       ierr = PetscFree(xadj);CHKERRQ(ierr);
7019       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7020       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7021       ierr = PetscFree(vals);CHKERRQ(ierr);
7022       if (use_vwgt) {
7023         Vec               v;
7024         const PetscScalar *array;
7025         PetscInt          nl;
7026 
7027         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7028         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7029         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7030         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7031         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7032         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7033         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7034         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7035         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7036         ierr = VecDestroy(&v);CHKERRQ(ierr);
7037       }
7038     } else {
7039       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7040       if (use_vwgt) {
7041         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7042         v_wgt[0] = n;
7043       }
7044     }
7045     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7046 
7047     /* Partition */
7048     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7049     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7050     if (v_wgt) {
7051       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7052     }
7053     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7054     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7055     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7056     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7057     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7058 
7059     /* renumber new_ranks to avoid "holes" in new set of processors */
7060     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7061     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7062     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7063     if (!aggregate) {
7064       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7065 #if defined(PETSC_USE_DEBUG)
7066         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7067 #endif
7068         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7069       } else if (oldranks) {
7070         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7071       } else {
7072         ranks_send_to_idx[0] = is_indices[0];
7073       }
7074     } else {
7075       PetscInt    idx = 0;
7076       PetscMPIInt tag;
7077       MPI_Request *reqs;
7078 
7079       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7080       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7081       for (i=rstart;i<rend;i++) {
7082         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7083       }
7084       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7085       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7086       ierr = PetscFree(reqs);CHKERRQ(ierr);
7087       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7088 #if defined(PETSC_USE_DEBUG)
7089         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7090 #endif
7091         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7092       } else if (oldranks) {
7093         ranks_send_to_idx[0] = oldranks[idx];
7094       } else {
7095         ranks_send_to_idx[0] = idx;
7096       }
7097     }
7098     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7099     /* clean up */
7100     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7101     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7102     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7103     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7104   }
7105   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7106   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7107 
7108   /* assemble parallel IS for sends */
7109   i = 1;
7110   if (!color) i=0;
7111   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7112   PetscFunctionReturn(0);
7113 }
7114 
7115 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7116 
7117 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[])
7118 {
7119   Mat                    local_mat;
7120   IS                     is_sends_internal;
7121   PetscInt               rows,cols,new_local_rows;
7122   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7123   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7124   ISLocalToGlobalMapping l2gmap;
7125   PetscInt*              l2gmap_indices;
7126   const PetscInt*        is_indices;
7127   MatType                new_local_type;
7128   /* buffers */
7129   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7130   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7131   PetscInt               *recv_buffer_idxs_local;
7132   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7133   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7134   /* MPI */
7135   MPI_Comm               comm,comm_n;
7136   PetscSubcomm           subcomm;
7137   PetscMPIInt            n_sends,n_recvs,commsize;
7138   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7139   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7140   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7141   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7142   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7143   PetscErrorCode         ierr;
7144 
7145   PetscFunctionBegin;
7146   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7147   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7148   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);
7149   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7150   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7151   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7152   PetscValidLogicalCollectiveBool(mat,reuse,6);
7153   PetscValidLogicalCollectiveInt(mat,nis,8);
7154   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7155   if (nvecs) {
7156     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7157     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7158   }
7159   /* further checks */
7160   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7161   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7162   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7163   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7164   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7165   if (reuse && *mat_n) {
7166     PetscInt mrows,mcols,mnrows,mncols;
7167     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7168     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7169     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7170     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7171     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7172     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7173     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7174   }
7175   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7176   PetscValidLogicalCollectiveInt(mat,bs,0);
7177 
7178   /* prepare IS for sending if not provided */
7179   if (!is_sends) {
7180     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7181     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7182   } else {
7183     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7184     is_sends_internal = is_sends;
7185   }
7186 
7187   /* get comm */
7188   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7189 
7190   /* compute number of sends */
7191   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7192   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7193 
7194   /* compute number of receives */
7195   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7196   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7197   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7198   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7199   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7200   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7201   ierr = PetscFree(iflags);CHKERRQ(ierr);
7202 
7203   /* restrict comm if requested */
7204   subcomm = 0;
7205   destroy_mat = PETSC_FALSE;
7206   if (restrict_comm) {
7207     PetscMPIInt color,subcommsize;
7208 
7209     color = 0;
7210     if (restrict_full) {
7211       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7212     } else {
7213       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7214     }
7215     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7216     subcommsize = commsize - subcommsize;
7217     /* check if reuse has been requested */
7218     if (reuse) {
7219       if (*mat_n) {
7220         PetscMPIInt subcommsize2;
7221         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7222         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7223         comm_n = PetscObjectComm((PetscObject)*mat_n);
7224       } else {
7225         comm_n = PETSC_COMM_SELF;
7226       }
7227     } else { /* MAT_INITIAL_MATRIX */
7228       PetscMPIInt rank;
7229 
7230       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7231       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7232       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7233       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7234       comm_n = PetscSubcommChild(subcomm);
7235     }
7236     /* flag to destroy *mat_n if not significative */
7237     if (color) destroy_mat = PETSC_TRUE;
7238   } else {
7239     comm_n = comm;
7240   }
7241 
7242   /* prepare send/receive buffers */
7243   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7244   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7245   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7246   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7247   if (nis) {
7248     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7249   }
7250 
7251   /* Get data from local matrices */
7252   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7253     /* TODO: See below some guidelines on how to prepare the local buffers */
7254     /*
7255        send_buffer_vals should contain the raw values of the local matrix
7256        send_buffer_idxs should contain:
7257        - MatType_PRIVATE type
7258        - PetscInt        size_of_l2gmap
7259        - PetscInt        global_row_indices[size_of_l2gmap]
7260        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7261     */
7262   else {
7263     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7264     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7265     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7266     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7267     send_buffer_idxs[1] = i;
7268     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7269     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7270     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7271     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7272     for (i=0;i<n_sends;i++) {
7273       ilengths_vals[is_indices[i]] = len*len;
7274       ilengths_idxs[is_indices[i]] = len+2;
7275     }
7276   }
7277   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7278   /* additional is (if any) */
7279   if (nis) {
7280     PetscMPIInt psum;
7281     PetscInt j;
7282     for (j=0,psum=0;j<nis;j++) {
7283       PetscInt plen;
7284       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7285       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7286       psum += len+1; /* indices + lenght */
7287     }
7288     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7289     for (j=0,psum=0;j<nis;j++) {
7290       PetscInt plen;
7291       const PetscInt *is_array_idxs;
7292       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7293       send_buffer_idxs_is[psum] = plen;
7294       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7295       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7296       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7297       psum += plen+1; /* indices + lenght */
7298     }
7299     for (i=0;i<n_sends;i++) {
7300       ilengths_idxs_is[is_indices[i]] = psum;
7301     }
7302     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7303   }
7304   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7305 
7306   buf_size_idxs = 0;
7307   buf_size_vals = 0;
7308   buf_size_idxs_is = 0;
7309   buf_size_vecs = 0;
7310   for (i=0;i<n_recvs;i++) {
7311     buf_size_idxs += (PetscInt)olengths_idxs[i];
7312     buf_size_vals += (PetscInt)olengths_vals[i];
7313     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7314     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7315   }
7316   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7317   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7318   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7319   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7320 
7321   /* get new tags for clean communications */
7322   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7323   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7324   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7325   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7326 
7327   /* allocate for requests */
7328   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7329   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7330   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7331   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7332   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7333   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7334   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7335   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7336 
7337   /* communications */
7338   ptr_idxs = recv_buffer_idxs;
7339   ptr_vals = recv_buffer_vals;
7340   ptr_idxs_is = recv_buffer_idxs_is;
7341   ptr_vecs = recv_buffer_vecs;
7342   for (i=0;i<n_recvs;i++) {
7343     source_dest = onodes[i];
7344     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7345     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7346     ptr_idxs += olengths_idxs[i];
7347     ptr_vals += olengths_vals[i];
7348     if (nis) {
7349       source_dest = onodes_is[i];
7350       ierr = MPI_Irecv(ptr_idxs_is,olengths_idxs_is[i],MPIU_INT,source_dest,tag_idxs_is,comm,&recv_req_idxs_is[i]);CHKERRQ(ierr);
7351       ptr_idxs_is += olengths_idxs_is[i];
7352     }
7353     if (nvecs) {
7354       source_dest = onodes[i];
7355       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7356       ptr_vecs += olengths_idxs[i]-2;
7357     }
7358   }
7359   for (i=0;i<n_sends;i++) {
7360     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7361     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7362     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7363     if (nis) {
7364       ierr = MPI_Isend(send_buffer_idxs_is,ilengths_idxs_is[source_dest],MPIU_INT,source_dest,tag_idxs_is,comm,&send_req_idxs_is[i]);CHKERRQ(ierr);
7365     }
7366     if (nvecs) {
7367       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7368       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7369     }
7370   }
7371   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7372   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7373 
7374   /* assemble new l2g map */
7375   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7376   ptr_idxs = recv_buffer_idxs;
7377   new_local_rows = 0;
7378   for (i=0;i<n_recvs;i++) {
7379     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7380     ptr_idxs += olengths_idxs[i];
7381   }
7382   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7383   ptr_idxs = recv_buffer_idxs;
7384   new_local_rows = 0;
7385   for (i=0;i<n_recvs;i++) {
7386     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7387     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7388     ptr_idxs += olengths_idxs[i];
7389   }
7390   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7391   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7392   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7393 
7394   /* infer new local matrix type from received local matrices type */
7395   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7396   /* 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) */
7397   if (n_recvs) {
7398     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7399     ptr_idxs = recv_buffer_idxs;
7400     for (i=0;i<n_recvs;i++) {
7401       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7402         new_local_type_private = MATAIJ_PRIVATE;
7403         break;
7404       }
7405       ptr_idxs += olengths_idxs[i];
7406     }
7407     switch (new_local_type_private) {
7408       case MATDENSE_PRIVATE:
7409         new_local_type = MATSEQAIJ;
7410         bs = 1;
7411         break;
7412       case MATAIJ_PRIVATE:
7413         new_local_type = MATSEQAIJ;
7414         bs = 1;
7415         break;
7416       case MATBAIJ_PRIVATE:
7417         new_local_type = MATSEQBAIJ;
7418         break;
7419       case MATSBAIJ_PRIVATE:
7420         new_local_type = MATSEQSBAIJ;
7421         break;
7422       default:
7423         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7424         break;
7425     }
7426   } else { /* by default, new_local_type is seqaij */
7427     new_local_type = MATSEQAIJ;
7428     bs = 1;
7429   }
7430 
7431   /* create MATIS object if needed */
7432   if (!reuse) {
7433     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7434     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7435   } else {
7436     /* it also destroys the local matrices */
7437     if (*mat_n) {
7438       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7439     } else { /* this is a fake object */
7440       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7441     }
7442   }
7443   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7444   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7445 
7446   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7447 
7448   /* Global to local map of received indices */
7449   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7450   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7451   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7452 
7453   /* restore attributes -> type of incoming data and its size */
7454   buf_size_idxs = 0;
7455   for (i=0;i<n_recvs;i++) {
7456     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7457     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7458     buf_size_idxs += (PetscInt)olengths_idxs[i];
7459   }
7460   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7461 
7462   /* set preallocation */
7463   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7464   if (!newisdense) {
7465     PetscInt *new_local_nnz=0;
7466 
7467     ptr_idxs = recv_buffer_idxs_local;
7468     if (n_recvs) {
7469       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7470     }
7471     for (i=0;i<n_recvs;i++) {
7472       PetscInt j;
7473       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7474         for (j=0;j<*(ptr_idxs+1);j++) {
7475           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7476         }
7477       } else {
7478         /* TODO */
7479       }
7480       ptr_idxs += olengths_idxs[i];
7481     }
7482     if (new_local_nnz) {
7483       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7484       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7485       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7486       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7487       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7488       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7489     } else {
7490       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7491     }
7492     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7493   } else {
7494     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7495   }
7496 
7497   /* set values */
7498   ptr_vals = recv_buffer_vals;
7499   ptr_idxs = recv_buffer_idxs_local;
7500   for (i=0;i<n_recvs;i++) {
7501     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7502       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7503       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7504       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7505       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7506       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7507     } else {
7508       /* TODO */
7509     }
7510     ptr_idxs += olengths_idxs[i];
7511     ptr_vals += olengths_vals[i];
7512   }
7513   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7514   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7515   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7516   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7517   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7518   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7519 
7520 #if 0
7521   if (!restrict_comm) { /* check */
7522     Vec       lvec,rvec;
7523     PetscReal infty_error;
7524 
7525     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7526     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7527     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7528     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7529     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7530     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7531     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7532     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7533     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7534   }
7535 #endif
7536 
7537   /* assemble new additional is (if any) */
7538   if (nis) {
7539     PetscInt **temp_idxs,*count_is,j,psum;
7540 
7541     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7542     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7543     ptr_idxs = recv_buffer_idxs_is;
7544     psum = 0;
7545     for (i=0;i<n_recvs;i++) {
7546       for (j=0;j<nis;j++) {
7547         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7548         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7549         psum += plen;
7550         ptr_idxs += plen+1; /* shift pointer to received data */
7551       }
7552     }
7553     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7554     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7555     for (i=1;i<nis;i++) {
7556       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7557     }
7558     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7559     ptr_idxs = recv_buffer_idxs_is;
7560     for (i=0;i<n_recvs;i++) {
7561       for (j=0;j<nis;j++) {
7562         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7563         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7564         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7565         ptr_idxs += plen+1; /* shift pointer to received data */
7566       }
7567     }
7568     for (i=0;i<nis;i++) {
7569       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7570       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7571       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7572     }
7573     ierr = PetscFree(count_is);CHKERRQ(ierr);
7574     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7575     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7576   }
7577   /* free workspace */
7578   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7579   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7580   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7581   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7582   if (isdense) {
7583     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7584     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7585     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7586   } else {
7587     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7588   }
7589   if (nis) {
7590     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7591     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7592   }
7593 
7594   if (nvecs) {
7595     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7596     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7597     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7598     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7599     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7600     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7601     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7602     /* set values */
7603     ptr_vals = recv_buffer_vecs;
7604     ptr_idxs = recv_buffer_idxs_local;
7605     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7606     for (i=0;i<n_recvs;i++) {
7607       PetscInt j;
7608       for (j=0;j<*(ptr_idxs+1);j++) {
7609         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7610       }
7611       ptr_idxs += olengths_idxs[i];
7612       ptr_vals += olengths_idxs[i]-2;
7613     }
7614     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7615     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7616     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7617   }
7618 
7619   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7620   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7621   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7622   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7623   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7624   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7625   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7626   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7627   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7628   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7629   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7630   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7631   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7632   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7633   ierr = PetscFree(onodes);CHKERRQ(ierr);
7634   if (nis) {
7635     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7636     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7637     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7638   }
7639   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7640   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7641     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7642     for (i=0;i<nis;i++) {
7643       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7644     }
7645     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7646       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7647     }
7648     *mat_n = NULL;
7649   }
7650   PetscFunctionReturn(0);
7651 }
7652 
7653 /* temporary hack into ksp private data structure */
7654 #include <petsc/private/kspimpl.h>
7655 
7656 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7657 {
7658   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7659   PC_IS                  *pcis = (PC_IS*)pc->data;
7660   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7661   Mat                    coarsedivudotp = NULL;
7662   Mat                    coarseG,t_coarse_mat_is;
7663   MatNullSpace           CoarseNullSpace = NULL;
7664   ISLocalToGlobalMapping coarse_islg;
7665   IS                     coarse_is,*isarray;
7666   PetscInt               i,im_active=-1,active_procs=-1;
7667   PetscInt               nis,nisdofs,nisneu,nisvert;
7668   PC                     pc_temp;
7669   PCType                 coarse_pc_type;
7670   KSPType                coarse_ksp_type;
7671   PetscBool              multilevel_requested,multilevel_allowed;
7672   PetscBool              coarse_reuse;
7673   PetscInt               ncoarse,nedcfield;
7674   PetscBool              compute_vecs = PETSC_FALSE;
7675   PetscScalar            *array;
7676   MatReuse               coarse_mat_reuse;
7677   PetscBool              restr, full_restr, have_void;
7678   PetscMPIInt            commsize;
7679   PetscErrorCode         ierr;
7680 
7681   PetscFunctionBegin;
7682   /* Assign global numbering to coarse dofs */
7683   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 */
7684     PetscInt ocoarse_size;
7685     compute_vecs = PETSC_TRUE;
7686 
7687     pcbddc->new_primal_space = PETSC_TRUE;
7688     ocoarse_size = pcbddc->coarse_size;
7689     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7690     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7691     /* see if we can avoid some work */
7692     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7693       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7694       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7695         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7696         coarse_reuse = PETSC_FALSE;
7697       } else { /* we can safely reuse already computed coarse matrix */
7698         coarse_reuse = PETSC_TRUE;
7699       }
7700     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7701       coarse_reuse = PETSC_FALSE;
7702     }
7703     /* reset any subassembling information */
7704     if (!coarse_reuse || pcbddc->recompute_topography) {
7705       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7706     }
7707   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7708     coarse_reuse = PETSC_TRUE;
7709   }
7710   /* assemble coarse matrix */
7711   if (coarse_reuse && pcbddc->coarse_ksp) {
7712     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7713     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7714     coarse_mat_reuse = MAT_REUSE_MATRIX;
7715   } else {
7716     coarse_mat = NULL;
7717     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7718   }
7719 
7720   /* creates temporary l2gmap and IS for coarse indexes */
7721   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7722   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7723 
7724   /* creates temporary MATIS object for coarse matrix */
7725   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7726   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7727   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7728   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7729   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);
7730   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7731   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7732   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7733   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7734 
7735   /* count "active" (i.e. with positive local size) and "void" processes */
7736   im_active = !!(pcis->n);
7737   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7738 
7739   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7740   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7741   /* full_restr : just use the receivers from the subassembling pattern */
7742   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7743   coarse_mat_is = NULL;
7744   multilevel_allowed = PETSC_FALSE;
7745   multilevel_requested = PETSC_FALSE;
7746   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7747   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7748   if (multilevel_requested) {
7749     ncoarse = active_procs/pcbddc->coarsening_ratio;
7750     restr = PETSC_FALSE;
7751     full_restr = PETSC_FALSE;
7752   } else {
7753     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7754     restr = PETSC_TRUE;
7755     full_restr = PETSC_TRUE;
7756   }
7757   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7758   ncoarse = PetscMax(1,ncoarse);
7759   if (!pcbddc->coarse_subassembling) {
7760     if (pcbddc->coarsening_ratio > 1) {
7761       if (multilevel_requested) {
7762         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7763       } else {
7764         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7765       }
7766     } else {
7767       PetscMPIInt rank;
7768       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7769       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7770       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7771     }
7772   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7773     PetscInt    psum;
7774     if (pcbddc->coarse_ksp) psum = 1;
7775     else psum = 0;
7776     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7777     if (ncoarse < commsize) have_void = PETSC_TRUE;
7778   }
7779   /* determine if we can go multilevel */
7780   if (multilevel_requested) {
7781     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7782     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7783   }
7784   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7785 
7786   /* dump subassembling pattern */
7787   if (pcbddc->dbg_flag && multilevel_allowed) {
7788     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7789   }
7790 
7791   /* compute dofs splitting and neumann boundaries for coarse dofs */
7792   nedcfield = -1;
7793   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7794     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7795     const PetscInt         *idxs;
7796     ISLocalToGlobalMapping tmap;
7797 
7798     /* create map between primal indices (in local representative ordering) and local primal numbering */
7799     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7800     /* allocate space for temporary storage */
7801     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7802     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7803     /* allocate for IS array */
7804     nisdofs = pcbddc->n_ISForDofsLocal;
7805     if (pcbddc->nedclocal) {
7806       if (pcbddc->nedfield > -1) {
7807         nedcfield = pcbddc->nedfield;
7808       } else {
7809         nedcfield = 0;
7810         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7811         nisdofs = 1;
7812       }
7813     }
7814     nisneu = !!pcbddc->NeumannBoundariesLocal;
7815     nisvert = 0; /* nisvert is not used */
7816     nis = nisdofs + nisneu + nisvert;
7817     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7818     /* dofs splitting */
7819     for (i=0;i<nisdofs;i++) {
7820       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7821       if (nedcfield != i) {
7822         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7823         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7824         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7825         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7826       } else {
7827         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7828         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7829         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7830         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7831         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7832       }
7833       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7834       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7835       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7836     }
7837     /* neumann boundaries */
7838     if (pcbddc->NeumannBoundariesLocal) {
7839       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7840       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7841       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7842       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7843       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7844       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7845       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7846       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7847     }
7848     /* free memory */
7849     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7850     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7851     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7852   } else {
7853     nis = 0;
7854     nisdofs = 0;
7855     nisneu = 0;
7856     nisvert = 0;
7857     isarray = NULL;
7858   }
7859   /* destroy no longer needed map */
7860   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7861 
7862   /* subassemble */
7863   if (multilevel_allowed) {
7864     Vec       vp[1];
7865     PetscInt  nvecs = 0;
7866     PetscBool reuse,reuser;
7867 
7868     if (coarse_mat) reuse = PETSC_TRUE;
7869     else reuse = PETSC_FALSE;
7870     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7871     vp[0] = NULL;
7872     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7873       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7874       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7875       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7876       nvecs = 1;
7877 
7878       if (pcbddc->divudotp) {
7879         Mat      B,loc_divudotp;
7880         Vec      v,p;
7881         IS       dummy;
7882         PetscInt np;
7883 
7884         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7885         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7886         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7887         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7888         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7889         ierr = VecSet(p,1.);CHKERRQ(ierr);
7890         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7891         ierr = VecDestroy(&p);CHKERRQ(ierr);
7892         ierr = MatDestroy(&B);CHKERRQ(ierr);
7893         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7894         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7895         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7896         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7897         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7898         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7899         ierr = VecDestroy(&v);CHKERRQ(ierr);
7900       }
7901     }
7902     if (reuser) {
7903       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7904     } else {
7905       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7906     }
7907     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7908       PetscScalar *arraym,*arrayv;
7909       PetscInt    nl;
7910       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7911       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7912       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7913       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7914       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7915       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7916       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7917       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7918     } else {
7919       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7920     }
7921   } else {
7922     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7923   }
7924   if (coarse_mat_is || coarse_mat) {
7925     PetscMPIInt size;
7926     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7927     if (!multilevel_allowed) {
7928       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7929     } else {
7930       Mat A;
7931 
7932       /* if this matrix is present, it means we are not reusing the coarse matrix */
7933       if (coarse_mat_is) {
7934         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7935         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7936         coarse_mat = coarse_mat_is;
7937       }
7938       /* be sure we don't have MatSeqDENSE as local mat */
7939       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7940       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7941     }
7942   }
7943   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7944   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7945 
7946   /* create local to global scatters for coarse problem */
7947   if (compute_vecs) {
7948     PetscInt lrows;
7949     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7950     if (coarse_mat) {
7951       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7952     } else {
7953       lrows = 0;
7954     }
7955     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7956     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7957     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7958     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7959     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7960   }
7961   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7962 
7963   /* set defaults for coarse KSP and PC */
7964   if (multilevel_allowed) {
7965     coarse_ksp_type = KSPRICHARDSON;
7966     coarse_pc_type = PCBDDC;
7967   } else {
7968     coarse_ksp_type = KSPPREONLY;
7969     coarse_pc_type = PCREDUNDANT;
7970   }
7971 
7972   /* print some info if requested */
7973   if (pcbddc->dbg_flag) {
7974     if (!multilevel_allowed) {
7975       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7976       if (multilevel_requested) {
7977         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);
7978       } else if (pcbddc->max_levels) {
7979         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7980       }
7981       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7982     }
7983   }
7984 
7985   /* communicate coarse discrete gradient */
7986   coarseG = NULL;
7987   if (pcbddc->nedcG && multilevel_allowed) {
7988     MPI_Comm ccomm;
7989     if (coarse_mat) {
7990       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7991     } else {
7992       ccomm = MPI_COMM_NULL;
7993     }
7994     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7995   }
7996 
7997   /* create the coarse KSP object only once with defaults */
7998   if (coarse_mat) {
7999     PetscBool   isredundant,isnn,isbddc;
8000     PetscViewer dbg_viewer = NULL;
8001 
8002     if (pcbddc->dbg_flag) {
8003       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8004       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8005     }
8006     if (!pcbddc->coarse_ksp) {
8007       char prefix[256],str_level[16];
8008       size_t len;
8009 
8010       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8011       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8012       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8013       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8014       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8015       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8016       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8017       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8018       /* TODO is this logic correct? should check for coarse_mat type */
8019       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8020       /* prefix */
8021       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8022       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8023       if (!pcbddc->current_level) {
8024         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
8025         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
8026       } else {
8027         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8028         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8029         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8030         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8031         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8032         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
8033       }
8034       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8035       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8036       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8037       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8038       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8039       /* allow user customization */
8040       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8041     }
8042     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8043     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8044     if (nisdofs) {
8045       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8046       for (i=0;i<nisdofs;i++) {
8047         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8048       }
8049     }
8050     if (nisneu) {
8051       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8052       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8053     }
8054     if (nisvert) {
8055       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8056       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8057     }
8058     if (coarseG) {
8059       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8060     }
8061 
8062     /* get some info after set from options */
8063     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8064     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8065     if (isbddc && !multilevel_allowed) {
8066       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8067       isbddc = PETSC_FALSE;
8068     }
8069     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8070     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8071     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8072       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8073       isbddc = PETSC_TRUE;
8074     }
8075     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8076     if (isredundant) {
8077       KSP inner_ksp;
8078       PC  inner_pc;
8079 
8080       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8081       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8082     }
8083 
8084     /* parameters which miss an API */
8085     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8086     if (isbddc) {
8087       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8088 
8089       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8090       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8091       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8092       if (pcbddc_coarse->benign_saddle_point) {
8093         Mat                    coarsedivudotp_is;
8094         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8095         IS                     row,col;
8096         const PetscInt         *gidxs;
8097         PetscInt               n,st,M,N;
8098 
8099         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8100         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8101         st   = st-n;
8102         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8103         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8104         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8105         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8106         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8107         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8108         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8109         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8110         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8111         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8112         ierr = ISDestroy(&row);CHKERRQ(ierr);
8113         ierr = ISDestroy(&col);CHKERRQ(ierr);
8114         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8115         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8116         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8117         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8118         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8119         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8120         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8121         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8122         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8123         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8124         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8125         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8126       }
8127     }
8128 
8129     /* propagate symmetry info of coarse matrix */
8130     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8131     if (pc->pmat->symmetric_set) {
8132       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8133     }
8134     if (pc->pmat->hermitian_set) {
8135       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8136     }
8137     if (pc->pmat->spd_set) {
8138       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8139     }
8140     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8141       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8142     }
8143     /* set operators */
8144     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8145     if (pcbddc->dbg_flag) {
8146       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8147     }
8148   }
8149   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8150   ierr = PetscFree(isarray);CHKERRQ(ierr);
8151 #if 0
8152   {
8153     PetscViewer viewer;
8154     char filename[256];
8155     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8156     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8157     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8158     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8159     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8160     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8161   }
8162 #endif
8163 
8164   if (pcbddc->coarse_ksp) {
8165     Vec crhs,csol;
8166 
8167     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8168     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8169     if (!csol) {
8170       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8171     }
8172     if (!crhs) {
8173       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8174     }
8175   }
8176   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8177 
8178   /* compute null space for coarse solver if the benign trick has been requested */
8179   if (pcbddc->benign_null) {
8180 
8181     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8182     for (i=0;i<pcbddc->benign_n;i++) {
8183       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8184     }
8185     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8186     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8187     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8188     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8189     if (coarse_mat) {
8190       Vec         nullv;
8191       PetscScalar *array,*array2;
8192       PetscInt    nl;
8193 
8194       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8195       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8196       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8197       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8198       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8199       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8200       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8201       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8202       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8203       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8204     }
8205   }
8206 
8207   if (pcbddc->coarse_ksp) {
8208     PetscBool ispreonly;
8209 
8210     if (CoarseNullSpace) {
8211       PetscBool isnull;
8212       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8213       if (isnull) {
8214         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8215       }
8216       /* TODO: add local nullspaces (if any) */
8217     }
8218     /* setup coarse ksp */
8219     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8220     /* Check coarse problem if in debug mode or if solving with an iterative method */
8221     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8222     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8223       KSP       check_ksp;
8224       KSPType   check_ksp_type;
8225       PC        check_pc;
8226       Vec       check_vec,coarse_vec;
8227       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8228       PetscInt  its;
8229       PetscBool compute_eigs;
8230       PetscReal *eigs_r,*eigs_c;
8231       PetscInt  neigs;
8232       const char *prefix;
8233 
8234       /* Create ksp object suitable for estimation of extreme eigenvalues */
8235       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8236       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8237       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8238       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8239       /* prevent from setup unneeded object */
8240       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8241       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8242       if (ispreonly) {
8243         check_ksp_type = KSPPREONLY;
8244         compute_eigs = PETSC_FALSE;
8245       } else {
8246         check_ksp_type = KSPGMRES;
8247         compute_eigs = PETSC_TRUE;
8248       }
8249       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8250       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8251       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8252       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8253       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8254       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8255       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8256       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8257       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8258       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8259       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8260       /* create random vec */
8261       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8262       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8263       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8264       /* solve coarse problem */
8265       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8266       /* set eigenvalue estimation if preonly has not been requested */
8267       if (compute_eigs) {
8268         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8269         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8270         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8271         if (neigs) {
8272           lambda_max = eigs_r[neigs-1];
8273           lambda_min = eigs_r[0];
8274           if (pcbddc->use_coarse_estimates) {
8275             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8276               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8277               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8278             }
8279           }
8280         }
8281       }
8282 
8283       /* check coarse problem residual error */
8284       if (pcbddc->dbg_flag) {
8285         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8286         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8287         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8288         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8289         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8290         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8291         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8292         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8293         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8294         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8295         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8296         if (CoarseNullSpace) {
8297           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8298         }
8299         if (compute_eigs) {
8300           PetscReal          lambda_max_s,lambda_min_s;
8301           KSPConvergedReason reason;
8302           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8303           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8304           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8305           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8306           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);
8307           for (i=0;i<neigs;i++) {
8308             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8309           }
8310         }
8311         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8312         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8313       }
8314       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8315       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8316       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8317       if (compute_eigs) {
8318         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8319         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8320       }
8321     }
8322   }
8323   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8324   /* print additional info */
8325   if (pcbddc->dbg_flag) {
8326     /* waits until all processes reaches this point */
8327     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8328     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8329     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8330   }
8331 
8332   /* free memory */
8333   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8334   PetscFunctionReturn(0);
8335 }
8336 
8337 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8338 {
8339   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8340   PC_IS*         pcis = (PC_IS*)pc->data;
8341   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8342   IS             subset,subset_mult,subset_n;
8343   PetscInt       local_size,coarse_size=0;
8344   PetscInt       *local_primal_indices=NULL;
8345   const PetscInt *t_local_primal_indices;
8346   PetscErrorCode ierr;
8347 
8348   PetscFunctionBegin;
8349   /* Compute global number of coarse dofs */
8350   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8351   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8352   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8353   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8354   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8355   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8356   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8357   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8358   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8359   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);
8360   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8361   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8362   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8363   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8364   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8365 
8366   /* check numbering */
8367   if (pcbddc->dbg_flag) {
8368     PetscScalar coarsesum,*array,*array2;
8369     PetscInt    i;
8370     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8371 
8372     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8373     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8374     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8375     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8376     /* counter */
8377     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8378     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8379     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8380     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8381     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8382     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8383     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8384     for (i=0;i<pcbddc->local_primal_size;i++) {
8385       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8386     }
8387     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8388     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8389     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8390     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8391     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8392     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8393     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8394     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8395     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8396     for (i=0;i<pcis->n;i++) {
8397       if (array[i] != 0.0 && array[i] != array2[i]) {
8398         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8399         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8400         set_error = PETSC_TRUE;
8401         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8402         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);
8403       }
8404     }
8405     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8406     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8407     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8408     for (i=0;i<pcis->n;i++) {
8409       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8410     }
8411     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8412     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8413     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8414     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8415     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8416     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8417     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8418       PetscInt *gidxs;
8419 
8420       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8421       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8422       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8423       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8424       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8425       for (i=0;i<pcbddc->local_primal_size;i++) {
8426         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);
8427       }
8428       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8429       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8430     }
8431     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8432     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8433     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8434   }
8435   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8436   /* get back data */
8437   *coarse_size_n = coarse_size;
8438   *local_primal_indices_n = local_primal_indices;
8439   PetscFunctionReturn(0);
8440 }
8441 
8442 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8443 {
8444   IS             localis_t;
8445   PetscInt       i,lsize,*idxs,n;
8446   PetscScalar    *vals;
8447   PetscErrorCode ierr;
8448 
8449   PetscFunctionBegin;
8450   /* get indices in local ordering exploiting local to global map */
8451   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8452   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8453   for (i=0;i<lsize;i++) vals[i] = 1.0;
8454   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8455   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8456   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8457   if (idxs) { /* multilevel guard */
8458     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8459     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8460   }
8461   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8462   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8463   ierr = PetscFree(vals);CHKERRQ(ierr);
8464   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8465   /* now compute set in local ordering */
8466   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8467   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8468   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8469   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8470   for (i=0,lsize=0;i<n;i++) {
8471     if (PetscRealPart(vals[i]) > 0.5) {
8472       lsize++;
8473     }
8474   }
8475   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8476   for (i=0,lsize=0;i<n;i++) {
8477     if (PetscRealPart(vals[i]) > 0.5) {
8478       idxs[lsize++] = i;
8479     }
8480   }
8481   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8482   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8483   *localis = localis_t;
8484   PetscFunctionReturn(0);
8485 }
8486 
8487 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8488 {
8489   PC_IS               *pcis=(PC_IS*)pc->data;
8490   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8491   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8492   Mat                 S_j;
8493   PetscInt            *used_xadj,*used_adjncy;
8494   PetscBool           free_used_adj;
8495   PetscErrorCode      ierr;
8496 
8497   PetscFunctionBegin;
8498   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8499   free_used_adj = PETSC_FALSE;
8500   if (pcbddc->sub_schurs_layers == -1) {
8501     used_xadj = NULL;
8502     used_adjncy = NULL;
8503   } else {
8504     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8505       used_xadj = pcbddc->mat_graph->xadj;
8506       used_adjncy = pcbddc->mat_graph->adjncy;
8507     } else if (pcbddc->computed_rowadj) {
8508       used_xadj = pcbddc->mat_graph->xadj;
8509       used_adjncy = pcbddc->mat_graph->adjncy;
8510     } else {
8511       PetscBool      flg_row=PETSC_FALSE;
8512       const PetscInt *xadj,*adjncy;
8513       PetscInt       nvtxs;
8514 
8515       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8516       if (flg_row) {
8517         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8518         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8519         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8520         free_used_adj = PETSC_TRUE;
8521       } else {
8522         pcbddc->sub_schurs_layers = -1;
8523         used_xadj = NULL;
8524         used_adjncy = NULL;
8525       }
8526       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8527     }
8528   }
8529 
8530   /* setup sub_schurs data */
8531   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8532   if (!sub_schurs->schur_explicit) {
8533     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8534     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8535     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);
8536   } else {
8537     Mat       change = NULL;
8538     Vec       scaling = NULL;
8539     IS        change_primal = NULL, iP;
8540     PetscInt  benign_n;
8541     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8542     PetscBool isseqaij,need_change = PETSC_FALSE;
8543     PetscBool discrete_harmonic = PETSC_FALSE;
8544 
8545     if (!pcbddc->use_vertices && reuse_solvers) {
8546       PetscInt n_vertices;
8547 
8548       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8549       reuse_solvers = (PetscBool)!n_vertices;
8550     }
8551     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8552     if (!isseqaij) {
8553       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8554       if (matis->A == pcbddc->local_mat) {
8555         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8556         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8557       } else {
8558         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8559       }
8560     }
8561     if (!pcbddc->benign_change_explicit) {
8562       benign_n = pcbddc->benign_n;
8563     } else {
8564       benign_n = 0;
8565     }
8566     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8567        We need a global reduction to avoid possible deadlocks.
8568        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8569     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8570       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8571       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8572       need_change = (PetscBool)(!need_change);
8573     }
8574     /* If the user defines additional constraints, we import them here.
8575        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 */
8576     if (need_change) {
8577       PC_IS   *pcisf;
8578       PC_BDDC *pcbddcf;
8579       PC      pcf;
8580 
8581       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8582       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8583       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8584       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8585 
8586       /* hacks */
8587       pcisf                        = (PC_IS*)pcf->data;
8588       pcisf->is_B_local            = pcis->is_B_local;
8589       pcisf->vec1_N                = pcis->vec1_N;
8590       pcisf->BtoNmap               = pcis->BtoNmap;
8591       pcisf->n                     = pcis->n;
8592       pcisf->n_B                   = pcis->n_B;
8593       pcbddcf                      = (PC_BDDC*)pcf->data;
8594       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8595       pcbddcf->mat_graph           = pcbddc->mat_graph;
8596       pcbddcf->use_faces           = PETSC_TRUE;
8597       pcbddcf->use_change_of_basis = PETSC_TRUE;
8598       pcbddcf->use_change_on_faces = PETSC_TRUE;
8599       pcbddcf->use_qr_single       = PETSC_TRUE;
8600       pcbddcf->fake_change         = PETSC_TRUE;
8601 
8602       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8603       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8604       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8605       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8606       change = pcbddcf->ConstraintMatrix;
8607       pcbddcf->ConstraintMatrix = NULL;
8608 
8609       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8610       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8611       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8612       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8613       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8614       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8615       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8616       pcf->ops->destroy = NULL;
8617       pcf->ops->reset   = NULL;
8618       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8619     }
8620     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8621 
8622     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8623     if (iP) {
8624       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8625       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8626       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8627     }
8628     if (discrete_harmonic) {
8629       Mat A;
8630       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8631       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8632       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8633       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);
8634       ierr = MatDestroy(&A);CHKERRQ(ierr);
8635     } else {
8636       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);
8637     }
8638     ierr = MatDestroy(&change);CHKERRQ(ierr);
8639     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8640   }
8641   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8642 
8643   /* free adjacency */
8644   if (free_used_adj) {
8645     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8646   }
8647   PetscFunctionReturn(0);
8648 }
8649 
8650 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8651 {
8652   PC_IS               *pcis=(PC_IS*)pc->data;
8653   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8654   PCBDDCGraph         graph;
8655   PetscErrorCode      ierr;
8656 
8657   PetscFunctionBegin;
8658   /* attach interface graph for determining subsets */
8659   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8660     IS       verticesIS,verticescomm;
8661     PetscInt vsize,*idxs;
8662 
8663     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8664     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8665     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8666     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8667     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8668     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8669     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8670     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8671     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8672     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8673     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8674   } else {
8675     graph = pcbddc->mat_graph;
8676   }
8677   /* print some info */
8678   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8679     IS       vertices;
8680     PetscInt nv,nedges,nfaces;
8681     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8682     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8683     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8684     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8685     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8686     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8687     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8688     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8689     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8690     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8691     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8692   }
8693 
8694   /* sub_schurs init */
8695   if (!pcbddc->sub_schurs) {
8696     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8697   }
8698   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);
8699 
8700   /* free graph struct */
8701   if (pcbddc->sub_schurs_rebuild) {
8702     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8703   }
8704   PetscFunctionReturn(0);
8705 }
8706 
8707 PetscErrorCode PCBDDCCheckOperator(PC pc)
8708 {
8709   PC_IS               *pcis=(PC_IS*)pc->data;
8710   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8711   PetscErrorCode      ierr;
8712 
8713   PetscFunctionBegin;
8714   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8715     IS             zerodiag = NULL;
8716     Mat            S_j,B0_B=NULL;
8717     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8718     PetscScalar    *p0_check,*array,*array2;
8719     PetscReal      norm;
8720     PetscInt       i;
8721 
8722     /* B0 and B0_B */
8723     if (zerodiag) {
8724       IS       dummy;
8725 
8726       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8727       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8728       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8729       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8730     }
8731     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8732     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8733     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8734     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8735     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8736     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8737     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8738     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8739     /* S_j */
8740     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8741     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8742 
8743     /* mimic vector in \widetilde{W}_\Gamma */
8744     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8745     /* continuous in primal space */
8746     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8747     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8748     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8749     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8750     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8751     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8752     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8753     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8754     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8755     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8756     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8757     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8758     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8759     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8760 
8761     /* assemble rhs for coarse problem */
8762     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8763     /* local with Schur */
8764     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8765     if (zerodiag) {
8766       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8767       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8768       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8769       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8770     }
8771     /* sum on primal nodes the local contributions */
8772     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8773     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8774     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8775     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8776     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8777     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8778     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8779     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8780     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8781     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8782     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8783     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8784     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8785     /* scale primal nodes (BDDC sums contibutions) */
8786     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8787     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8788     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8789     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8790     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8791     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8792     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8793     /* global: \widetilde{B0}_B w_\Gamma */
8794     if (zerodiag) {
8795       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8796       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8797       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8798       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8799     }
8800     /* BDDC */
8801     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8802     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8803 
8804     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8805     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8806     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8807     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8808     for (i=0;i<pcbddc->benign_n;i++) {
8809       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8810     }
8811     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8812     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8813     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8814     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8815     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8816     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8817   }
8818   PetscFunctionReturn(0);
8819 }
8820 
8821 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8822 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8823 {
8824   Mat            At;
8825   IS             rows;
8826   PetscInt       rst,ren;
8827   PetscErrorCode ierr;
8828   PetscLayout    rmap;
8829 
8830   PetscFunctionBegin;
8831   rst = ren = 0;
8832   if (ccomm != MPI_COMM_NULL) {
8833     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8834     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8835     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8836     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8837     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8838   }
8839   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8840   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8841   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8842 
8843   if (ccomm != MPI_COMM_NULL) {
8844     Mat_MPIAIJ *a,*b;
8845     IS         from,to;
8846     Vec        gvec;
8847     PetscInt   lsize;
8848 
8849     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8850     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8851     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8852     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8853     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8854     a    = (Mat_MPIAIJ*)At->data;
8855     b    = (Mat_MPIAIJ*)(*B)->data;
8856     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8857     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8858     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8859     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8860     b->A = a->A;
8861     b->B = a->B;
8862 
8863     b->donotstash      = a->donotstash;
8864     b->roworiented     = a->roworiented;
8865     b->rowindices      = 0;
8866     b->rowvalues       = 0;
8867     b->getrowactive    = PETSC_FALSE;
8868 
8869     (*B)->rmap         = rmap;
8870     (*B)->factortype   = A->factortype;
8871     (*B)->assembled    = PETSC_TRUE;
8872     (*B)->insertmode   = NOT_SET_VALUES;
8873     (*B)->preallocated = PETSC_TRUE;
8874 
8875     if (a->colmap) {
8876 #if defined(PETSC_USE_CTABLE)
8877       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8878 #else
8879       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8880       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8881       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8882 #endif
8883     } else b->colmap = 0;
8884     if (a->garray) {
8885       PetscInt len;
8886       len  = a->B->cmap->n;
8887       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8888       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8889       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8890     } else b->garray = 0;
8891 
8892     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8893     b->lvec = a->lvec;
8894     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8895 
8896     /* cannot use VecScatterCopy */
8897     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8898     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8899     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8900     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8901     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8902     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8903     ierr = ISDestroy(&from);CHKERRQ(ierr);
8904     ierr = ISDestroy(&to);CHKERRQ(ierr);
8905     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8906   }
8907   ierr = MatDestroy(&At);CHKERRQ(ierr);
8908   PetscFunctionReturn(0);
8909 }
8910