xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 2a3a664151bd835e8b9008ee1f7c337083f97a55)
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 <petscblaslapack.h>
5 #include <petsc/private/sfimpl.h>
6 
7 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
8 
9 /* if range is true,  it returns B s.t. span{B} = range(A)
10    if range is false, it returns B s.t. range(B) _|_ range(A) */
11 #undef __FUNCT__
12 #define __FUNCT__ "MatDenseOrthogonalRangeOrComplement"
13 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
14 {
15 #if !defined(PETSC_USE_COMPLEX)
16   PetscScalar    *uwork,*data,*U, ds = 0.;
17   PetscReal      *sing;
18   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
19   PetscInt       ulw,i,nr,nc,n;
20   PetscErrorCode ierr;
21 
22   PetscFunctionBegin;
23 #if defined(PETSC_MISSING_LAPACK_GESVD)
24   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
25 #else
26   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
27   if (!nr || !nc) PetscFunctionReturn(0);
28 
29   /* workspace */
30   if (!work) {
31     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
32     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
33   } else {
34     ulw   = lw;
35     uwork = work;
36   }
37   n = PetscMin(nr,nc);
38   if (!rwork) {
39     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
40   } else {
41     sing = rwork;
42   }
43 
44   /* SVD */
45   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
49   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
50   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
51   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
52   ierr = PetscFPTrapPop();CHKERRQ(ierr);
53   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
54   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
55   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
56   if (!rwork) {
57     ierr = PetscFree(sing);CHKERRQ(ierr);
58   }
59   if (!work) {
60     ierr = PetscFree(uwork);CHKERRQ(ierr);
61   }
62   /* create B */
63   if (!range) {
64     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
65     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
66     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
67   } else {
68     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
69     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
70     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
71   }
72   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
73   ierr = PetscFree(U);CHKERRQ(ierr);
74 #endif
75 #else /* PETSC_USE_COMPLEX */
76   PetscFunctionBegin;
77   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
78 #endif
79   PetscFunctionReturn(0);
80 }
81 
82 /* TODO REMOVE */
83 #if defined(PRINT_GDET)
84 static int inc = 0;
85 static int lev = 0;
86 #endif
87 
88 #undef __FUNCT__
89 #define __FUNCT__ "PCBDDCComputeNedelecChangeEdge"
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 = MatGetSubMatrix(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 = MatGetSubMatrix(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 = MatGetSubMatrix(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 #undef __FUNCT__
156 #define __FUNCT__ "PCBDDCNedelecSupport"
157 PetscErrorCode PCBDDCNedelecSupport(PC pc)
158 {
159   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
160   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
161   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
162   Vec                    tvec;
163   PetscSF                sfv;
164   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
165   MPI_Comm               comm;
166   IS                     lned,primals,allprimals,nedfieldlocal;
167   IS                     *eedges,*extrows,*extcols,*alleedges;
168   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
169   PetscScalar            *vals,*work;
170   PetscReal              *rwork;
171   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
172   PetscInt               ne,nv,Lv,order,n,field;
173   PetscInt               n_neigh,*neigh,*n_shared,**shared;
174   PetscInt               i,j,extmem,cum,maxsize,nee;
175   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
176   PetscInt               *sfvleaves,*sfvroots;
177   PetscInt               *corners,*cedges;
178   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
179 #if defined(PETSC_USE_DEBUG)
180   PetscInt               *emarks;
181 #endif
182   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
183   PetscErrorCode         ierr;
184 
185   PetscFunctionBegin;
186   /* If the discrete gradient is defined for a subset of dofs and global is true,
187      it assumes G is given in global ordering for all the dofs.
188      Otherwise, the ordering is global for the Nedelec field */
189   order      = pcbddc->nedorder;
190   conforming = pcbddc->conforming;
191   field      = pcbddc->nedfield;
192   global     = pcbddc->nedglobal;
193   setprimal  = PETSC_FALSE;
194   print      = PETSC_FALSE;
195   singular   = PETSC_FALSE;
196 
197   /* Command line customization */
198   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
199   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
200   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
201   ierr = PetscOptionsInt ("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
202   /* print debug info TODO: to be removed */
203   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
204   ierr = PetscOptionsEnd();CHKERRQ(ierr);
205 
206   /* Return if there are no edges in the decomposition and the problem is not singular */
207   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
208   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
209   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
210   if (!singular) {
211     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
212     lrc[0] = PETSC_FALSE;
213     for (i=0;i<n;i++) {
214       if (PetscRealPart(vals[i]) > 2.) {
215         lrc[0] = PETSC_TRUE;
216         break;
217       }
218     }
219     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
220     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
221     if (!lrc[1]) PetscFunctionReturn(0);
222   }
223 
224   /* Get Nedelec field */
225   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
226   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);
227   if (pcbddc->n_ISForDofsLocal && field >= 0) {
228     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
229     nedfieldlocal = pcbddc->ISForDofsLocal[field];
230     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
231   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
232     ne            = n;
233     nedfieldlocal = NULL;
234     global        = PETSC_TRUE;
235   } else if (field == PETSC_DECIDE) {
236     PetscInt rst,ren,*idx;
237 
238     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
239     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
240     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
241     for (i=rst;i<ren;i++) {
242       PetscInt nc;
243 
244       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
246       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
247     }
248     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
249     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
250     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
251     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
252     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
253   } else {
254     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
255   }
256 
257   /* Sanity checks */
258   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
259   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
260   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);
261 
262   /* Just set primal dofs and return */
263   if (setprimal) {
264     IS       enedfieldlocal;
265     PetscInt *eidxs;
266 
267     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
268     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
269     if (nedfieldlocal) {
270       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
271       for (i=0,cum=0;i<ne;i++) {
272         if (PetscRealPart(vals[idxs[i]]) > 2.) {
273           eidxs[cum++] = idxs[i];
274         }
275       }
276       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
277     } else {
278       for (i=0,cum=0;i<ne;i++) {
279         if (PetscRealPart(vals[i]) > 2.) {
280           eidxs[cum++] = i;
281         }
282       }
283     }
284     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
285     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
286     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
287     ierr = PetscFree(eidxs);CHKERRQ(ierr);
288     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
289     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
290     PetscFunctionReturn(0);
291   }
292 
293   /* Compute some l2g maps */
294   if (nedfieldlocal) {
295     IS is;
296 
297     /* need to map from the local Nedelec field to local numbering */
298     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
299     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
300     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
301     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
302     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
303     if (global) {
304       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
305       el2g = al2g;
306     } else {
307       IS gis;
308 
309       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
310       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
311       ierr = ISDestroy(&gis);CHKERRQ(ierr);
312     }
313     ierr = ISDestroy(&is);CHKERRQ(ierr);
314   } else {
315     /* restore default */
316     pcbddc->nedfield = -1;
317     /* one ref for the destruction of al2g, one for el2g */
318     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
319     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
320     el2g = al2g;
321     fl2g = NULL;
322   }
323 
324   /* Start communication to drop connections for interior edges (for cc analysis only) */
325   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
326   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
327   if (nedfieldlocal) {
328     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
330     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
331   } else {
332     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
333   }
334   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
335   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
336 
337   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
338     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
339     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
340     if (global) {
341       PetscInt rst;
342 
343       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
344       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
345         if (matis->sf_rootdata[i] < 2) {
346           matis->sf_rootdata[cum++] = i + rst;
347         }
348       }
349       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
350       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
351     } else {
352       PetscInt *tbz;
353 
354       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
355       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
356       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
357       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
358       for (i=0,cum=0;i<ne;i++)
359         if (matis->sf_leafdata[idxs[i]] == 1)
360           tbz[cum++] = i;
361       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
362       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
363       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
364       ierr = PetscFree(tbz);CHKERRQ(ierr);
365     }
366   } else { /* we need the entire G to infer the nullspace */
367     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
368     G    = pcbddc->discretegradient;
369   }
370 
371   /* Extract subdomain relevant rows of G */
372   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
373   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
374   ierr = MatGetSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
375   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
376   ierr = ISDestroy(&lned);CHKERRQ(ierr);
377   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
378   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
379   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
380 
381   /* SF for nodal dofs communications */
382   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
383   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
384   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
386   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
388   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
389   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
390   i    = singular ? 2 : 1;
391   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
392 
393   /* Destroy temporary G created in MATIS format and modified G */
394   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
395   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
396   ierr = MatDestroy(&G);CHKERRQ(ierr);
397 
398   if (print) {
399     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
400     ierr = MatView(lG,NULL);CHKERRQ(ierr);
401   }
402 
403   /* Save lG for values insertion in change of basis */
404   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
405 
406   /* Analyze the edge-nodes connections (duplicate lG) */
407   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
408   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
409   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
411   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
412   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
413   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
414   /* need to import the boundary specification to ensure the
415      proper detection of coarse edges' endpoints */
416   if (pcbddc->DirichletBoundariesLocal) {
417     IS is;
418 
419     if (fl2g) {
420       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
421     } else {
422       is = pcbddc->DirichletBoundariesLocal;
423     }
424     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
425     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
426     for (i=0;i<cum;i++) {
427       if (idxs[i] >= 0) {
428         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
429         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
430       }
431     }
432     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
433     if (fl2g) {
434       ierr = ISDestroy(&is);CHKERRQ(ierr);
435     }
436   }
437   if (pcbddc->NeumannBoundariesLocal) {
438     IS is;
439 
440     if (fl2g) {
441       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
442     } else {
443       is = pcbddc->NeumannBoundariesLocal;
444     }
445     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
446     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
447     for (i=0;i<cum;i++) {
448       if (idxs[i] >= 0) {
449         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
450       }
451     }
452     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
453     if (fl2g) {
454       ierr = ISDestroy(&is);CHKERRQ(ierr);
455     }
456   }
457 
458   /* Count neighs per dof */
459   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
460   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
461   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
462   for (i=1,cum=0;i<n_neigh;i++) {
463     cum += n_shared[i];
464     for (j=0;j<n_shared[i];j++) {
465       ecount[shared[i][j]]++;
466     }
467   }
468   if (ne) {
469     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
470   }
471   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
472   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
473   for (i=1;i<n_neigh;i++) {
474     for (j=0;j<n_shared[i];j++) {
475       PetscInt k = shared[i][j];
476       eneighs[k][ecount[k]] = neigh[i];
477       ecount[k]++;
478     }
479   }
480   for (i=0;i<ne;i++) {
481     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
482   }
483   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
484   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
485   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
486   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
487   for (i=1,cum=0;i<n_neigh;i++) {
488     cum += n_shared[i];
489     for (j=0;j<n_shared[i];j++) {
490       vcount[shared[i][j]]++;
491     }
492   }
493   if (nv) {
494     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
495   }
496   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
497   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
498   for (i=1;i<n_neigh;i++) {
499     for (j=0;j<n_shared[i];j++) {
500       PetscInt k = shared[i][j];
501       vneighs[k][vcount[k]] = neigh[i];
502       vcount[k]++;
503     }
504   }
505   for (i=0;i<nv;i++) {
506     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
507   }
508   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
509 
510   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
511      for proper detection of coarse edges' endpoints */
512   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
513   for (i=0;i<ne;i++) {
514     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
515       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
516     }
517   }
518   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
519   if (!conforming) {
520     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
521     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
522   }
523   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
525   cum  = 0;
526   for (i=0;i<ne;i++) {
527     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
528     if (!PetscBTLookup(btee,i)) {
529       marks[cum++] = i;
530       continue;
531     }
532     /* set badly connected edge dofs as primal */
533     if (!conforming) {
534       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
535         marks[cum++] = i;
536         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
537         for (j=ii[i];j<ii[i+1];j++) {
538           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
539         }
540       } else {
541         /* every edge dofs should be connected trough a certain number of nodal dofs
542            to other edge dofs belonging to coarse edges
543            - at most 2 endpoints
544            - order-1 interior nodal dofs
545            - no undefined nodal dofs (nconn < order)
546         */
547         PetscInt ends = 0,ints = 0, undef = 0;
548         for (j=ii[i];j<ii[i+1];j++) {
549           PetscInt v = jj[j],k;
550           PetscInt nconn = iit[v+1]-iit[v];
551           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
552           if (nconn > order) ends++;
553           else if (nconn == order) ints++;
554           else undef++;
555         }
556         if (undef || ends > 2 || ints != order -1) {
557           marks[cum++] = i;
558           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
559           for (j=ii[i];j<ii[i+1];j++) {
560             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
561           }
562         }
563       }
564     }
565     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
566     if (!order && ii[i+1] != ii[i]) {
567       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
568       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
569     }
570   }
571   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
572   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
573   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
574   if (!conforming) {
575     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
576     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
577   }
578   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
579 
580   /* identify splitpoints and corner candidates */
581   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
582   if (print) {
583     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
584     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
585     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
586     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
587   }
588   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
589   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
590   for (i=0;i<nv;i++) {
591     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
592     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
593     if (!order) { /* variable order */
594       PetscReal vorder = 0.;
595 
596       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
597       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
598       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
599       ord  = 1;
600     }
601 #if defined(PETSC_USE_DEBUG)
602     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);
603 #endif
604     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
605       if (PetscBTLookup(btbd,jj[j])) {
606         bdir = PETSC_TRUE;
607         break;
608       }
609       if (vc != ecount[jj[j]]) {
610         sneighs = PETSC_FALSE;
611       } else {
612         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
613         for (k=0;k<vc;k++) {
614           if (vn[k] != en[k]) {
615             sneighs = PETSC_FALSE;
616             break;
617           }
618         }
619       }
620     }
621     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
622       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
623       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
624     } else if (test == ord) {
625       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
626         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
627         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
628       } else {
629         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
630         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
631       }
632     }
633   }
634   ierr = PetscFree(ecount);CHKERRQ(ierr);
635   ierr = PetscFree(vcount);CHKERRQ(ierr);
636   if (ne) {
637     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
638   }
639   if (nv) {
640     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
641   }
642   ierr = PetscFree(eneighs);CHKERRQ(ierr);
643   ierr = PetscFree(vneighs);CHKERRQ(ierr);
644   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
645 
646   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
647   if (order != 1) {
648     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
649     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
650     for (i=0;i<nv;i++) {
651       if (PetscBTLookup(btvcand,i)) {
652         PetscBool found = PETSC_FALSE;
653         for (j=ii[i];j<ii[i+1] && !found;j++) {
654           PetscInt k,e = jj[j];
655           if (PetscBTLookup(bte,e)) continue;
656           for (k=iit[e];k<iit[e+1];k++) {
657             PetscInt v = jjt[k];
658             if (v != i && PetscBTLookup(btvcand,v)) {
659               found = PETSC_TRUE;
660               break;
661             }
662           }
663         }
664         if (!found) {
665           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
666           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
667         } else {
668           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
669         }
670       }
671     }
672     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
673   }
674   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
675   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
676   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
677 
678   /* Get the local G^T explicitly */
679   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
680   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
681   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
682 
683   /* Mark interior nodal dofs */
684   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
685   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
686   for (i=1;i<n_neigh;i++) {
687     for (j=0;j<n_shared[i];j++) {
688       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
689     }
690   }
691   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
692 
693   /* communicate corners and splitpoints */
694   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
695   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
696   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
697   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
698 
699   if (print) {
700     IS tbz;
701 
702     cum = 0;
703     for (i=0;i<nv;i++)
704       if (sfvleaves[i])
705         vmarks[cum++] = i;
706 
707     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
708     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
709     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
710     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
711   }
712 
713   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
714   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
715   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
716   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
717 
718   /* Zero rows of lGt corresponding to identified corners
719      and interior nodal dofs */
720   cum = 0;
721   for (i=0;i<nv;i++) {
722     if (sfvleaves[i]) {
723       vmarks[cum++] = i;
724       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
725     }
726     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
727   }
728   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
729   if (print) {
730     IS tbz;
731 
732     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
733     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
734     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
735     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
736   }
737   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
738   ierr = PetscFree(vmarks);CHKERRQ(ierr);
739   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
740   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
741 
742   /* Recompute G */
743   ierr = MatDestroy(&lG);CHKERRQ(ierr);
744   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
745   if (print) {
746     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
747     ierr = MatView(lG,NULL);CHKERRQ(ierr);
748     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
749     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
750   }
751 
752   /* Get primal dofs (if any) */
753   cum = 0;
754   for (i=0;i<ne;i++) {
755     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
756   }
757   if (fl2g) {
758     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
759   }
760   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
761   if (print) {
762     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
763     ierr = ISView(primals,NULL);CHKERRQ(ierr);
764   }
765   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
766   /* TODO: what if the user passed in some of them ?  */
767   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
768   ierr = ISDestroy(&primals);CHKERRQ(ierr);
769 
770   /* Compute edge connectivity */
771   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
772   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
773   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
774   if (fl2g) {
775     PetscBT   btf;
776     PetscInt  *iia,*jja,*iiu,*jju;
777     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
778 
779     /* create CSR for all local dofs */
780     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
781     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
782       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);
783       iiu = pcbddc->mat_graph->xadj;
784       jju = pcbddc->mat_graph->adjncy;
785     } else if (pcbddc->use_local_adj) {
786       rest = PETSC_TRUE;
787       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
788     } else {
789       free   = PETSC_TRUE;
790       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
791       iiu[0] = 0;
792       for (i=0;i<n;i++) {
793         iiu[i+1] = i+1;
794         jju[i]   = -1;
795       }
796     }
797 
798     /* import sizes of CSR */
799     iia[0] = 0;
800     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
801 
802     /* overwrite entries corresponding to the Nedelec field */
803     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
804     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
805     for (i=0;i<ne;i++) {
806       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
807       iia[idxs[i]+1] = ii[i+1]-ii[i];
808     }
809 
810     /* iia in CSR */
811     for (i=0;i<n;i++) iia[i+1] += iia[i];
812 
813     /* jja in CSR */
814     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
815     for (i=0;i<n;i++)
816       if (!PetscBTLookup(btf,i))
817         for (j=0;j<iiu[i+1]-iiu[i];j++)
818           jja[iia[i]+j] = jju[iiu[i]+j];
819 
820     /* map edge dofs connectivity */
821     if (jj) {
822       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
823       for (i=0;i<ne;i++) {
824         PetscInt e = idxs[i];
825         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
826       }
827     }
828     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
829     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
830     if (rest) {
831       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
832     }
833     if (free) {
834       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
835     }
836     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
837   } else {
838     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
839   }
840 
841   /* Analyze interface for edge dofs */
842   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
843   pcbddc->mat_graph->twodim = PETSC_FALSE;
844 
845   /* Get coarse edges in the edge space */
846   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
847   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
848 
849   if (fl2g) {
850     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
851     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
852     for (i=0;i<nee;i++) {
853       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
854     }
855   } else {
856     eedges  = alleedges;
857     primals = allprimals;
858   }
859 
860   /* Mark fine edge dofs with their coarse edge id */
861   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
862   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
863   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
864   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
865   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
866   if (print) {
867     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
868     ierr = ISView(primals,NULL);CHKERRQ(ierr);
869   }
870 
871   maxsize = 0;
872   for (i=0;i<nee;i++) {
873     PetscInt size,mark = i+1;
874 
875     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
876     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
877     for (j=0;j<size;j++) marks[idxs[j]] = mark;
878     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
879     maxsize = PetscMax(maxsize,size);
880   }
881 
882   /* Find coarse edge endpoints */
883   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
884   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
885   for (i=0;i<nee;i++) {
886     PetscInt mark = i+1,size;
887 
888     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
889     if (!size && nedfieldlocal) continue;
890     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
891     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
892     if (print) {
893       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
894       ISView(eedges[i],NULL);
895     }
896     for (j=0;j<size;j++) {
897       PetscInt k, ee = idxs[j];
898       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
899       for (k=ii[ee];k<ii[ee+1];k++) {
900         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
901         if (PetscBTLookup(btv,jj[k])) {
902           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
903         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
904           PetscInt  k2;
905           PetscBool corner = PETSC_FALSE;
906           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
907             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]));
908             /* it's a corner if either is connected with an edge dof belonging to a different cc or
909                if the edge dof lie on the natural part of the boundary */
910             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
911               corner = PETSC_TRUE;
912               break;
913             }
914           }
915           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
916             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
917             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
918           } else {
919             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
920           }
921         }
922       }
923     }
924     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
925   }
926   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
927   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
928   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
929 
930   /* Reset marked primal dofs */
931   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
932   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
933   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
934   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
935 
936   /* Now use the initial lG */
937   ierr = MatDestroy(&lG);CHKERRQ(ierr);
938   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
939   lG   = lGinit;
940   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
941 
942   /* Compute extended cols indices */
943   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
944   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
945   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
946   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
947   i   *= maxsize;
948   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
949   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
950   eerr = PETSC_FALSE;
951   for (i=0;i<nee;i++) {
952     PetscInt size,found = 0;
953 
954     cum  = 0;
955     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
956     if (!size && nedfieldlocal) continue;
957     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
958     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
959     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
960     for (j=0;j<size;j++) {
961       PetscInt k,ee = idxs[j];
962       for (k=ii[ee];k<ii[ee+1];k++) {
963         PetscInt vv = jj[k];
964         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
965         else if (!PetscBTLookupSet(btvc,vv)) found++;
966       }
967     }
968     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
969     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
970     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
971     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
972     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
973     /* it may happen that endpoints are not defined at this point
974        if it is the case, mark this edge for a second pass */
975     if (cum != size -1 || found != 2) {
976       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
977       if (print) {
978         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
979         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
980         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
981         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
982       }
983       eerr = PETSC_TRUE;
984     }
985   }
986   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
987   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
988   if (done) {
989     PetscInt *newprimals;
990 
991     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
992     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
993     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
994     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
995     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
996     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
997     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
998     for (i=0;i<nee;i++) {
999       PetscBool has_candidates = PETSC_FALSE;
1000       if (PetscBTLookup(bter,i)) {
1001         PetscInt size,mark = i+1;
1002 
1003         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1004         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1005         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
1006         for (j=0;j<size;j++) {
1007           PetscInt k,ee = idxs[j];
1008           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
1009           for (k=ii[ee];k<ii[ee+1];k++) {
1010             /* set all candidates located on the edge as corners */
1011             if (PetscBTLookup(btvcand,jj[k])) {
1012               PetscInt k2,vv = jj[k];
1013               has_candidates = PETSC_TRUE;
1014               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
1015               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
1016               /* set all edge dofs connected to candidate as primals */
1017               for (k2=iit[vv];k2<iit[vv+1];k2++) {
1018                 if (marks[jjt[k2]] == mark) {
1019                   PetscInt k3,ee2 = jjt[k2];
1020                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
1021                   newprimals[cum++] = ee2;
1022                   /* finally set the new corners */
1023                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
1024                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
1025                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
1026                   }
1027                 }
1028               }
1029             } else {
1030               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
1031             }
1032           }
1033         }
1034         if (!has_candidates) { /* circular edge */
1035           PetscInt k, ee = idxs[0],*tmarks;
1036 
1037           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1038           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1039           for (k=ii[ee];k<ii[ee+1];k++) {
1040             PetscInt k2;
1041             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1042             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1043             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1044           }
1045           for (j=0;j<size;j++) {
1046             if (tmarks[idxs[j]] > 1) {
1047               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1048               newprimals[cum++] = idxs[j];
1049             }
1050           }
1051           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1052         }
1053         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1054       }
1055       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1056     }
1057     ierr = PetscFree(extcols);CHKERRQ(ierr);
1058     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1059     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1060     if (fl2g) {
1061       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1062       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1063       for (i=0;i<nee;i++) {
1064         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1065       }
1066       ierr = PetscFree(eedges);CHKERRQ(ierr);
1067     }
1068     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1069     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1070     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1071     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1072     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1073     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1074     pcbddc->mat_graph->twodim = PETSC_FALSE;
1075     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1076     if (fl2g) {
1077       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1078       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1079       for (i=0;i<nee;i++) {
1080         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1081       }
1082     } else {
1083       eedges  = alleedges;
1084       primals = allprimals;
1085     }
1086     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1087 
1088     /* Mark again */
1089     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1090     for (i=0;i<nee;i++) {
1091       PetscInt size,mark = i+1;
1092 
1093       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1094       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1096       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1097     }
1098     if (print) {
1099       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1100       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1101     }
1102 
1103     /* Recompute extended cols */
1104     eerr = PETSC_FALSE;
1105     for (i=0;i<nee;i++) {
1106       PetscInt size;
1107 
1108       cum  = 0;
1109       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1110       if (!size && nedfieldlocal) continue;
1111       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1112       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1113       for (j=0;j<size;j++) {
1114         PetscInt k,ee = idxs[j];
1115         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1116       }
1117       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1118       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1119       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1120       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1121       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1122       if (cum != size -1) {
1123         if (print) {
1124           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1125           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1126           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1127           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1128         }
1129         eerr = PETSC_TRUE;
1130       }
1131     }
1132   }
1133   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1134   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1135   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1136   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1137   /* an error should not occur at this point */
1138   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1139 
1140   /* Check the number of endpoints */
1141   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1142   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1143   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1144   for (i=0;i<nee;i++) {
1145     PetscInt size, found = 0, gc[2];
1146 
1147     /* init with defaults */
1148     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1149     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1150     if (!size && nedfieldlocal) continue;
1151     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1152     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1153     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1154     for (j=0;j<size;j++) {
1155       PetscInt k,ee = idxs[j];
1156       for (k=ii[ee];k<ii[ee+1];k++) {
1157         PetscInt vv = jj[k];
1158         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1159           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1160           corners[i*2+found++] = vv;
1161         }
1162       }
1163     }
1164     if (found != 2) {
1165       PetscInt e;
1166       if (fl2g) {
1167         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1168       } else {
1169         e = idxs[0];
1170       }
1171       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1172     }
1173 
1174     /* get primal dof index on this coarse edge */
1175     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1176     if (gc[0] > gc[1]) {
1177       PetscInt swap  = corners[2*i];
1178       corners[2*i]   = corners[2*i+1];
1179       corners[2*i+1] = swap;
1180     }
1181     cedges[i] = idxs[size-1];
1182     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1183     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1184   }
1185   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1186   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1187 
1188 #if defined(PETSC_USE_DEBUG)
1189   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1190      not interfere with neighbouring coarse edges */
1191   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1192   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1193   for (i=0;i<nv;i++) {
1194     PetscInt emax = 0,eemax = 0;
1195 
1196     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1197     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1198     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1199     for (j=1;j<nee+1;j++) {
1200       if (emax < emarks[j]) {
1201         emax = emarks[j];
1202         eemax = j;
1203       }
1204     }
1205     /* not relevant for edges */
1206     if (!eemax) continue;
1207 
1208     for (j=ii[i];j<ii[i+1];j++) {
1209       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1210         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]);
1211       }
1212     }
1213   }
1214   ierr = PetscFree(emarks);CHKERRQ(ierr);
1215   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1216 #endif
1217 
1218   /* Compute extended rows indices for edge blocks of the change of basis */
1219   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1220   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1221   extmem *= maxsize;
1222   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1223   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1224   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1225   for (i=0;i<nv;i++) {
1226     PetscInt mark = 0,size,start;
1227 
1228     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1229     for (j=ii[i];j<ii[i+1];j++)
1230       if (marks[jj[j]] && !mark)
1231         mark = marks[jj[j]];
1232 
1233     /* not relevant */
1234     if (!mark) continue;
1235 
1236     /* import extended row */
1237     mark--;
1238     start = mark*extmem+extrowcum[mark];
1239     size = ii[i+1]-ii[i];
1240     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1241     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1242     extrowcum[mark] += size;
1243   }
1244   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1245   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1246   ierr = PetscFree(marks);CHKERRQ(ierr);
1247 
1248   /* Compress extrows */
1249   cum  = 0;
1250   for (i=0;i<nee;i++) {
1251     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1252     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1253     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1254     cum  = PetscMax(cum,size);
1255   }
1256   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1257   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1258   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1259 
1260   /* Workspace for lapack inner calls and VecSetValues */
1261   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1262 
1263   /* Create change of basis matrix (preallocation can be improved) */
1264   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1265   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1266                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1267   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1268   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1269   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1270   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1271   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1272   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1273   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1274 
1275   /* Defaults to identity */
1276   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1277   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1278   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1279   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1280 
1281   /* Create discrete gradient for the coarser level if needed */
1282   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1283   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1284   if (pcbddc->current_level < pcbddc->max_levels) {
1285     ISLocalToGlobalMapping cel2g,cvl2g;
1286     IS                     wis,gwis;
1287     PetscInt               cnv,cne;
1288 
1289     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1290     if (fl2g) {
1291       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1292     } else {
1293       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1294       pcbddc->nedclocal = wis;
1295     }
1296     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1297     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1298     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1299     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1300     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1301     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1302 
1303     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1304     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1305     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1306     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1307     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1308     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1309     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1310 
1311     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1312     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1313     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1314     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1315     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1316     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1317     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1318     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1319   }
1320   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1321 
1322 #if defined(PRINT_GDET)
1323   inc = 0;
1324   lev = pcbddc->current_level;
1325 #endif
1326 
1327   /* Insert values in the change of basis matrix */
1328   for (i=0;i<nee;i++) {
1329     Mat         Gins = NULL, GKins = NULL;
1330     IS          cornersis = NULL;
1331     PetscScalar cvals[2];
1332 
1333     if (pcbddc->nedcG) {
1334       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1335     }
1336     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1337     if (Gins && GKins) {
1338       PetscScalar    *data;
1339       const PetscInt *rows,*cols;
1340       PetscInt       nrh,nch,nrc,ncc;
1341 
1342       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1343       /* H1 */
1344       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1345       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1346       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1347       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1348       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1349       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1350       /* complement */
1351       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1352       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1353       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);
1354       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);
1355       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1356       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1357       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1358 
1359       /* coarse discrete gradient */
1360       if (pcbddc->nedcG) {
1361         PetscInt cols[2];
1362 
1363         cols[0] = 2*i;
1364         cols[1] = 2*i+1;
1365         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1366       }
1367       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1368     }
1369     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1370     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1371     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1372     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1373     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1374   }
1375   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1376 
1377   /* Start assembling */
1378   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1379   if (pcbddc->nedcG) {
1380     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1381   }
1382 
1383   /* Free */
1384   if (fl2g) {
1385     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1386     for (i=0;i<nee;i++) {
1387       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1388     }
1389     ierr = PetscFree(eedges);CHKERRQ(ierr);
1390   }
1391 
1392   /* hack mat_graph with primal dofs on the coarse edges */
1393   {
1394     PCBDDCGraph graph   = pcbddc->mat_graph;
1395     PetscInt    *oqueue = graph->queue;
1396     PetscInt    *ocptr  = graph->cptr;
1397     PetscInt    ncc,*idxs;
1398 
1399     /* find first primal edge */
1400     if (pcbddc->nedclocal) {
1401       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1402     } else {
1403       if (fl2g) {
1404         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1405       }
1406       idxs = cedges;
1407     }
1408     cum = 0;
1409     while (cum < nee && cedges[cum] < 0) cum++;
1410 
1411     /* adapt connected components */
1412     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1413     graph->cptr[0] = 0;
1414     for (i=0,ncc=0;i<graph->ncc;i++) {
1415       PetscInt lc = ocptr[i+1]-ocptr[i];
1416       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1417         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1418         graph->queue[graph->cptr[ncc]] = cedges[cum];
1419         ncc++;
1420         lc--;
1421         cum++;
1422         while (cum < nee && cedges[cum] < 0) cum++;
1423       }
1424       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1425       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1426       ncc++;
1427     }
1428     graph->ncc = ncc;
1429     if (pcbddc->nedclocal) {
1430       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1431     }
1432     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1433   }
1434   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1435   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1436   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1437   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1438 
1439   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1440   ierr = PetscFree(extrow);CHKERRQ(ierr);
1441   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1442   ierr = PetscFree(corners);CHKERRQ(ierr);
1443   ierr = PetscFree(cedges);CHKERRQ(ierr);
1444   ierr = PetscFree(extrows);CHKERRQ(ierr);
1445   ierr = PetscFree(extcols);CHKERRQ(ierr);
1446   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1447 
1448   /* Complete assembling */
1449   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1450   if (pcbddc->nedcG) {
1451     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1452 #if 0
1453     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1454     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1455 #endif
1456   }
1457 
1458   /* set change of basis */
1459   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1460   ierr = MatDestroy(&T);CHKERRQ(ierr);
1461 
1462   PetscFunctionReturn(0);
1463 }
1464 
1465 /* the near-null space of BDDC carries information on quadrature weights,
1466    and these can be collinear -> so cheat with MatNullSpaceCreate
1467    and create a suitable set of basis vectors first */
1468 #undef __FUNCT__
1469 #define __FUNCT__ "PCBDDCNullSpaceCreate"
1470 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1471 {
1472   PetscErrorCode ierr;
1473   PetscInt       i;
1474 
1475   PetscFunctionBegin;
1476   for (i=0;i<nvecs;i++) {
1477     PetscInt first,last;
1478 
1479     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1480     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1481     if (i>=first && i < last) {
1482       PetscScalar *data;
1483       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1484       if (!has_const) {
1485         data[i-first] = 1.;
1486       } else {
1487         data[2*i-first] = 1./PetscSqrtReal(2.);
1488         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1489       }
1490       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1491     }
1492     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1493   }
1494   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1495   for (i=0;i<nvecs;i++) { /* reset vectors */
1496     PetscInt first,last;
1497     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1498     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1499     if (i>=first && i < last) {
1500       PetscScalar *data;
1501       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1502       if (!has_const) {
1503         data[i-first] = 0.;
1504       } else {
1505         data[2*i-first] = 0.;
1506         data[2*i-first+1] = 0.;
1507       }
1508       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1509     }
1510     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1511     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1512   }
1513   PetscFunctionReturn(0);
1514 }
1515 
1516 #undef __FUNCT__
1517 #define __FUNCT__ "PCBDDCComputeNoNetFlux"
1518 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1519 {
1520   Mat                    loc_divudotp;
1521   Vec                    p,v,vins,quad_vec,*quad_vecs;
1522   ISLocalToGlobalMapping map;
1523   IS                     *faces,*edges;
1524   PetscScalar            *vals;
1525   const PetscScalar      *array;
1526   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1527   PetscMPIInt            rank;
1528   PetscErrorCode         ierr;
1529 
1530   PetscFunctionBegin;
1531   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1532   if (graph->twodim) {
1533     lmaxneighs = 2;
1534   } else {
1535     lmaxneighs = 1;
1536     for (i=0;i<ne;i++) {
1537       const PetscInt *idxs;
1538       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1539       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1540       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1541     }
1542     lmaxneighs++; /* graph count does not include self */
1543   }
1544   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1545   maxsize = 0;
1546   for (i=0;i<ne;i++) {
1547     PetscInt nn;
1548     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1549     maxsize = PetscMax(maxsize,nn);
1550   }
1551   for (i=0;i<nf;i++) {
1552     PetscInt nn;
1553     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1554     maxsize = PetscMax(maxsize,nn);
1555   }
1556   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1557   /* create vectors to hold quadrature weights */
1558   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1559   if (!transpose) {
1560     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1561   } else {
1562     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1563   }
1564   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1565   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1566   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1567   for (i=0;i<maxneighs;i++) {
1568     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1569     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1570   }
1571 
1572   /* compute local quad vec */
1573   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1574   if (!transpose) {
1575     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1576   } else {
1577     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1578   }
1579   ierr = VecSet(p,1.);CHKERRQ(ierr);
1580   if (!transpose) {
1581     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1582   } else {
1583     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1584   }
1585   if (vl2l) {
1586     ierr = VecGetSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1587   } else {
1588     vins = v;
1589   }
1590   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1591   ierr = VecDestroy(&p);CHKERRQ(ierr);
1592 
1593   /* insert in global quadrature vecs */
1594   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1595   for (i=0;i<nf;i++) {
1596     const PetscInt    *idxs;
1597     PetscInt          idx,nn,j;
1598 
1599     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1600     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1601     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1602     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1603     idx = -(idx+1);
1604     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1605     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1606   }
1607   for (i=0;i<ne;i++) {
1608     const PetscInt    *idxs;
1609     PetscInt          idx,nn,j;
1610 
1611     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1612     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1613     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1614     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1615     idx  = -(idx+1);
1616     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1617     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1618   }
1619   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1620   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1621   if (vl2l) {
1622     ierr = VecRestoreSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1623   }
1624   ierr = VecDestroy(&v);CHKERRQ(ierr);
1625   ierr = PetscFree(vals);CHKERRQ(ierr);
1626 
1627   /* assemble near null space */
1628   for (i=0;i<maxneighs;i++) {
1629     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1630   }
1631   for (i=0;i<maxneighs;i++) {
1632     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1633     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1634   }
1635   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1636   PetscFunctionReturn(0);
1637 }
1638 
1639 
1640 #undef __FUNCT__
1641 #define __FUNCT__ "PCBDDCComputeLocalTopologyInfo"
1642 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1643 {
1644   PetscErrorCode ierr;
1645   Vec            local,global;
1646   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1647   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1648 
1649   PetscFunctionBegin;
1650   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1651   /* need to convert from global to local topology information and remove references to information in global ordering */
1652   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
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, create it in local ordering if bs > 1 */
1667       PetscInt i, n = matis->A->rmap->n;
1668       ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1669       if (i > 1) {
1670         pcbddc->n_ISForDofsLocal = i;
1671         ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1672         for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1673           ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1674         }
1675       }
1676     } else {
1677       PetscInt i;
1678       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1679         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1680       }
1681     }
1682   }
1683 
1684   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1685     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1686   } else if (pcbddc->DirichletBoundariesLocal) {
1687     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1688   }
1689   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1690     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1691   } else if (pcbddc->NeumannBoundariesLocal) {
1692     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1693   }
1694   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1695     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1696   }
1697   ierr = VecDestroy(&global);CHKERRQ(ierr);
1698   ierr = VecDestroy(&local);CHKERRQ(ierr);
1699 
1700   PetscFunctionReturn(0);
1701 }
1702 
1703 #undef __FUNCT__
1704 #define __FUNCT__ "PCBDDCConsistencyCheckIS"
1705 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1706 {
1707   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1708   PetscErrorCode  ierr;
1709   IS              nis;
1710   const PetscInt  *idxs;
1711   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1712   PetscBool       *ld;
1713 
1714   PetscFunctionBegin;
1715   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1716   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1717   if (mop == MPI_LAND) {
1718     /* init rootdata with true */
1719     ld   = (PetscBool*) matis->sf_rootdata;
1720     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1721   } else {
1722     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1723   }
1724   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1725   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1726   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1727   ld   = (PetscBool*) matis->sf_leafdata;
1728   for (i=0;i<nd;i++)
1729     if (-1 < idxs[i] && idxs[i] < n)
1730       ld[idxs[i]] = PETSC_TRUE;
1731   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1732   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1733   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1734   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1735   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1736   if (mop == MPI_LAND) {
1737     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1738   } else {
1739     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1740   }
1741   for (i=0,nnd=0;i<n;i++)
1742     if (ld[i])
1743       nidxs[nnd++] = i;
1744   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1745   ierr = ISDestroy(is);CHKERRQ(ierr);
1746   *is  = nis;
1747   PetscFunctionReturn(0);
1748 }
1749 
1750 #undef __FUNCT__
1751 #define __FUNCT__ "PCBDDCBenignRemoveInterior"
1752 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1753 {
1754   PC_IS             *pcis = (PC_IS*)(pc->data);
1755   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1756   PetscErrorCode    ierr;
1757 
1758   PetscFunctionBegin;
1759   if (!pcbddc->benign_have_null) {
1760     PetscFunctionReturn(0);
1761   }
1762   if (pcbddc->ChangeOfBasisMatrix) {
1763     Vec swap;
1764 
1765     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1766     swap = pcbddc->work_change;
1767     pcbddc->work_change = r;
1768     r = swap;
1769   }
1770   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1771   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1772   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1773   ierr = VecSet(z,0.);CHKERRQ(ierr);
1774   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1775   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1776   if (pcbddc->ChangeOfBasisMatrix) {
1777     pcbddc->work_change = r;
1778     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1779     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1780   }
1781   PetscFunctionReturn(0);
1782 }
1783 
1784 #undef __FUNCT__
1785 #define __FUNCT__ "PCBDDCBenignMatMult_Private_Private"
1786 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1787 {
1788   PCBDDCBenignMatMult_ctx ctx;
1789   PetscErrorCode          ierr;
1790   PetscBool               apply_right,apply_left,reset_x;
1791 
1792   PetscFunctionBegin;
1793   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1794   if (transpose) {
1795     apply_right = ctx->apply_left;
1796     apply_left = ctx->apply_right;
1797   } else {
1798     apply_right = ctx->apply_right;
1799     apply_left = ctx->apply_left;
1800   }
1801   reset_x = PETSC_FALSE;
1802   if (apply_right) {
1803     const PetscScalar *ax;
1804     PetscInt          nl,i;
1805 
1806     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1807     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1808     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1809     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1810     for (i=0;i<ctx->benign_n;i++) {
1811       PetscScalar    sum,val;
1812       const PetscInt *idxs;
1813       PetscInt       nz,j;
1814       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1815       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1816       sum = 0.;
1817       if (ctx->apply_p0) {
1818         val = ctx->work[idxs[nz-1]];
1819         for (j=0;j<nz-1;j++) {
1820           sum += ctx->work[idxs[j]];
1821           ctx->work[idxs[j]] += val;
1822         }
1823       } else {
1824         for (j=0;j<nz-1;j++) {
1825           sum += ctx->work[idxs[j]];
1826         }
1827       }
1828       ctx->work[idxs[nz-1]] -= sum;
1829       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1830     }
1831     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1832     reset_x = PETSC_TRUE;
1833   }
1834   if (transpose) {
1835     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1836   } else {
1837     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1838   }
1839   if (reset_x) {
1840     ierr = VecResetArray(x);CHKERRQ(ierr);
1841   }
1842   if (apply_left) {
1843     PetscScalar *ay;
1844     PetscInt    i;
1845 
1846     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1847     for (i=0;i<ctx->benign_n;i++) {
1848       PetscScalar    sum,val;
1849       const PetscInt *idxs;
1850       PetscInt       nz,j;
1851       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1852       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1853       val = -ay[idxs[nz-1]];
1854       if (ctx->apply_p0) {
1855         sum = 0.;
1856         for (j=0;j<nz-1;j++) {
1857           sum += ay[idxs[j]];
1858           ay[idxs[j]] += val;
1859         }
1860         ay[idxs[nz-1]] += sum;
1861       } else {
1862         for (j=0;j<nz-1;j++) {
1863           ay[idxs[j]] += val;
1864         }
1865         ay[idxs[nz-1]] = 0.;
1866       }
1867       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1868     }
1869     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1870   }
1871   PetscFunctionReturn(0);
1872 }
1873 
1874 #undef __FUNCT__
1875 #define __FUNCT__ "PCBDDCBenignMatMultTranspose_Private"
1876 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1877 {
1878   PetscErrorCode ierr;
1879 
1880   PetscFunctionBegin;
1881   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1882   PetscFunctionReturn(0);
1883 }
1884 
1885 #undef __FUNCT__
1886 #define __FUNCT__ "PCBDDCBenignMatMult_Private"
1887 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1888 {
1889   PetscErrorCode ierr;
1890 
1891   PetscFunctionBegin;
1892   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1893   PetscFunctionReturn(0);
1894 }
1895 
1896 #undef __FUNCT__
1897 #define __FUNCT__ "PCBDDCBenignShellMat"
1898 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1899 {
1900   PC_IS                   *pcis = (PC_IS*)pc->data;
1901   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1902   PCBDDCBenignMatMult_ctx ctx;
1903   PetscErrorCode          ierr;
1904 
1905   PetscFunctionBegin;
1906   if (!restore) {
1907     Mat                A_IB,A_BI;
1908     PetscScalar        *work;
1909     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1910 
1911     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1912     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1913     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1914     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1915     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1916     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1917     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1918     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1919     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1920     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1921     ctx->apply_left = PETSC_TRUE;
1922     ctx->apply_right = PETSC_FALSE;
1923     ctx->apply_p0 = PETSC_FALSE;
1924     ctx->benign_n = pcbddc->benign_n;
1925     if (reuse) {
1926       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1927       ctx->free = PETSC_FALSE;
1928     } else { /* TODO: could be optimized for successive solves */
1929       ISLocalToGlobalMapping N_to_D;
1930       PetscInt               i;
1931 
1932       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1933       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1934       for (i=0;i<pcbddc->benign_n;i++) {
1935         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1936       }
1937       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1938       ctx->free = PETSC_TRUE;
1939     }
1940     ctx->A = pcis->A_IB;
1941     ctx->work = work;
1942     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1943     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1944     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1945     pcis->A_IB = A_IB;
1946 
1947     /* A_BI as A_IB^T */
1948     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1949     pcbddc->benign_original_mat = pcis->A_BI;
1950     pcis->A_BI = A_BI;
1951   } else {
1952     if (!pcbddc->benign_original_mat) {
1953       PetscFunctionReturn(0);
1954     }
1955     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1956     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1957     pcis->A_IB = ctx->A;
1958     ctx->A = NULL;
1959     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1960     pcis->A_BI = pcbddc->benign_original_mat;
1961     pcbddc->benign_original_mat = NULL;
1962     if (ctx->free) {
1963       PetscInt i;
1964       for (i=0;i<ctx->benign_n;i++) {
1965         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1966       }
1967       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1968     }
1969     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1970     ierr = PetscFree(ctx);CHKERRQ(ierr);
1971   }
1972   PetscFunctionReturn(0);
1973 }
1974 
1975 /* used just in bddc debug mode */
1976 #undef __FUNCT__
1977 #define __FUNCT__ "PCBDDCBenignProject"
1978 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1979 {
1980   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1981   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1982   Mat            An;
1983   PetscErrorCode ierr;
1984 
1985   PetscFunctionBegin;
1986   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1987   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
1988   if (is1) {
1989     ierr = MatGetSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
1990     ierr = MatDestroy(&An);CHKERRQ(ierr);
1991   } else {
1992     *B = An;
1993   }
1994   PetscFunctionReturn(0);
1995 }
1996 
1997 /* TODO: add reuse flag */
1998 #undef __FUNCT__
1999 #define __FUNCT__ "MatSeqAIJCompress"
2000 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2001 {
2002   Mat            Bt;
2003   PetscScalar    *a,*bdata;
2004   const PetscInt *ii,*ij;
2005   PetscInt       m,n,i,nnz,*bii,*bij;
2006   PetscBool      flg_row;
2007   PetscErrorCode ierr;
2008 
2009   PetscFunctionBegin;
2010   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2011   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2012   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2013   nnz = n;
2014   for (i=0;i<ii[n];i++) {
2015     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2016   }
2017   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2018   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2019   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2020   nnz = 0;
2021   bii[0] = 0;
2022   for (i=0;i<n;i++) {
2023     PetscInt j;
2024     for (j=ii[i];j<ii[i+1];j++) {
2025       PetscScalar entry = a[j];
2026       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
2027         bij[nnz] = ij[j];
2028         bdata[nnz] = entry;
2029         nnz++;
2030       }
2031     }
2032     bii[i+1] = nnz;
2033   }
2034   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2035   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2036   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2037   {
2038     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2039     b->free_a = PETSC_TRUE;
2040     b->free_ij = PETSC_TRUE;
2041   }
2042   *B = Bt;
2043   PetscFunctionReturn(0);
2044 }
2045 
2046 #undef __FUNCT__
2047 #define __FUNCT__ "MatDetectDisconnectedComponents"
2048 PetscErrorCode MatDetectDisconnectedComponents(Mat A, PetscBool filter, PetscInt *ncc, IS* cc[])
2049 {
2050   Mat                    B;
2051   IS                     is_dummy,*cc_n;
2052   ISLocalToGlobalMapping l2gmap_dummy;
2053   PCBDDCGraph            graph;
2054   PetscInt               i,n;
2055   PetscInt               *xadj,*adjncy;
2056   PetscInt               *xadj_filtered,*adjncy_filtered;
2057   PetscBool              flg_row,isseqaij;
2058   PetscErrorCode         ierr;
2059 
2060   PetscFunctionBegin;
2061   if (!A->rmap->N || !A->cmap->N) {
2062     *ncc = 0;
2063     *cc = NULL;
2064     PetscFunctionReturn(0);
2065   }
2066   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2067   if (!isseqaij && filter) {
2068     PetscBool isseqdense;
2069 
2070     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2071     if (!isseqdense) {
2072       ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2073     } else { /* TODO: rectangular case and LDA */
2074       PetscScalar *array;
2075       PetscReal   chop=1.e-6;
2076 
2077       ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2078       ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2079       ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2080       for (i=0;i<n;i++) {
2081         PetscInt j;
2082         for (j=i+1;j<n;j++) {
2083           PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2084           if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2085           if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2086         }
2087       }
2088       ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2089       ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2090     }
2091   } else {
2092     B = A;
2093   }
2094   ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2095 
2096   /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2097   if (filter) {
2098     PetscScalar *data;
2099     PetscInt    j,cum;
2100 
2101     ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2102     ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2103     cum = 0;
2104     for (i=0;i<n;i++) {
2105       PetscInt t;
2106 
2107       for (j=xadj[i];j<xadj[i+1];j++) {
2108         if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2109           continue;
2110         }
2111         adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2112       }
2113       t = xadj_filtered[i];
2114       xadj_filtered[i] = cum;
2115       cum += t;
2116     }
2117     ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2118   } else {
2119     xadj_filtered = NULL;
2120     adjncy_filtered = NULL;
2121   }
2122 
2123   /* compute local connected components using PCBDDCGraph */
2124   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2125   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2126   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2127   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2128   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2129   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2130   if (xadj_filtered) {
2131     graph->xadj = xadj_filtered;
2132     graph->adjncy = adjncy_filtered;
2133   } else {
2134     graph->xadj = xadj;
2135     graph->adjncy = adjncy;
2136   }
2137   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2138   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2139   /* partial clean up */
2140   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2141   ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2142   if (A != B) {
2143     ierr = MatDestroy(&B);CHKERRQ(ierr);
2144   }
2145 
2146   /* get back data */
2147   if (ncc) *ncc = graph->ncc;
2148   if (cc) {
2149     ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2150     for (i=0;i<graph->ncc;i++) {
2151       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);
2152     }
2153     *cc = cc_n;
2154   }
2155   /* clean up graph */
2156   graph->xadj = 0;
2157   graph->adjncy = 0;
2158   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2159   PetscFunctionReturn(0);
2160 }
2161 
2162 #undef __FUNCT__
2163 #define __FUNCT__ "PCBDDCBenignCheck"
2164 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2165 {
2166   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2167   PC_IS*         pcis = (PC_IS*)(pc->data);
2168   IS             dirIS = NULL;
2169   PetscInt       i;
2170   PetscErrorCode ierr;
2171 
2172   PetscFunctionBegin;
2173   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2174   if (zerodiag) {
2175     Mat            A;
2176     Vec            vec3_N;
2177     PetscScalar    *vals;
2178     const PetscInt *idxs;
2179     PetscInt       nz,*count;
2180 
2181     /* p0 */
2182     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2183     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2184     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2185     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2186     for (i=0;i<nz;i++) vals[i] = 1.;
2187     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2188     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2189     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2190     /* v_I */
2191     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2192     for (i=0;i<nz;i++) vals[i] = 0.;
2193     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2194     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2195     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2196     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2197     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2198     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2199     if (dirIS) {
2200       PetscInt n;
2201 
2202       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2203       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2204       for (i=0;i<n;i++) vals[i] = 0.;
2205       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2206       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2207     }
2208     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2209     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2210     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2211     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2212     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2213     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2214     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2215     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]));
2216     ierr = PetscFree(vals);CHKERRQ(ierr);
2217     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2218 
2219     /* there should not be any pressure dofs lying on the interface */
2220     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2221     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2222     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2223     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2224     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2225     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]);
2226     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2227     ierr = PetscFree(count);CHKERRQ(ierr);
2228   }
2229   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2230 
2231   /* check PCBDDCBenignGetOrSetP0 */
2232   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2233   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2234   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2235   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2236   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2237   for (i=0;i<pcbddc->benign_n;i++) {
2238     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2239     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);CHKERRQ(ierr);
2240   }
2241   PetscFunctionReturn(0);
2242 }
2243 
2244 #undef __FUNCT__
2245 #define __FUNCT__ "PCBDDCBenignDetectSaddlePoint"
2246 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2247 {
2248   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2249   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2250   PetscInt       nz,n;
2251   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2252   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2253   PetscErrorCode ierr;
2254 
2255   PetscFunctionBegin;
2256   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2257   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2258   for (n=0;n<pcbddc->benign_n;n++) {
2259     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2260   }
2261   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2262   pcbddc->benign_n = 0;
2263 
2264   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2265      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2266      Checks if all the pressure dofs in each subdomain have a zero diagonal
2267      If not, a change of basis on pressures is not needed
2268      since the local Schur complements are already SPD
2269   */
2270   has_null_pressures = PETSC_TRUE;
2271   have_null = PETSC_TRUE;
2272   if (pcbddc->n_ISForDofsLocal) {
2273     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2274 
2275     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2276     ierr = PetscOptionsInt ("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2277     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2278     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2279     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2280     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2281     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2282     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2283     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2284     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2285     if (!sorted) {
2286       ierr = ISSort(pressures);CHKERRQ(ierr);
2287     }
2288   } else {
2289     pressures = NULL;
2290   }
2291   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2292   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2293   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2294   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2295   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2296   if (!sorted) {
2297     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2298   }
2299   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2300   zerodiag_save = zerodiag;
2301   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2302   if (!nz) {
2303     if (n) have_null = PETSC_FALSE;
2304     has_null_pressures = PETSC_FALSE;
2305     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2306   }
2307   recompute_zerodiag = PETSC_FALSE;
2308   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2309   zerodiag_subs    = NULL;
2310   pcbddc->benign_n = 0;
2311   n_interior_dofs  = 0;
2312   interior_dofs    = NULL;
2313   nneu             = 0;
2314   if (pcbddc->NeumannBoundariesLocal) {
2315     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2316   }
2317   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2318   if (checkb) { /* need to compute interior nodes */
2319     PetscInt n,i,j;
2320     PetscInt n_neigh,*neigh,*n_shared,**shared;
2321     PetscInt *iwork;
2322 
2323     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2324     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2325     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2326     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2327     for (i=1;i<n_neigh;i++)
2328       for (j=0;j<n_shared[i];j++)
2329           iwork[shared[i][j]] += 1;
2330     for (i=0;i<n;i++)
2331       if (!iwork[i])
2332         interior_dofs[n_interior_dofs++] = i;
2333     ierr = PetscFree(iwork);CHKERRQ(ierr);
2334     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2335   }
2336   if (has_null_pressures) {
2337     IS             *subs;
2338     PetscInt       nsubs,i,j,nl;
2339     const PetscInt *idxs;
2340     PetscScalar    *array;
2341     Vec            *work;
2342     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2343 
2344     subs  = pcbddc->local_subs;
2345     nsubs = pcbddc->n_local_subs;
2346     /* 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) */
2347     if (checkb) {
2348       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2349       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2350       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2351       /* work[0] = 1_p */
2352       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2353       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2354       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2355       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2356       /* work[0] = 1_v */
2357       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2358       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2359       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2360       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2361       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2362     }
2363     if (nsubs > 1) {
2364       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2365       for (i=0;i<nsubs;i++) {
2366         ISLocalToGlobalMapping l2g;
2367         IS                     t_zerodiag_subs;
2368         PetscInt               nl;
2369 
2370         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2371         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2372         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2373         if (nl) {
2374           PetscBool valid = PETSC_TRUE;
2375 
2376           if (checkb) {
2377             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2378             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2379             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2380             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2381             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2382             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2383             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2384             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2385             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2386             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2387             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2388             for (j=0;j<n_interior_dofs;j++) {
2389               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2390                 valid = PETSC_FALSE;
2391                 break;
2392               }
2393             }
2394             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2395           }
2396           if (valid && nneu) {
2397             const PetscInt *idxs;
2398             PetscInt       nzb;
2399 
2400             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2401             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2402             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2403             if (nzb) valid = PETSC_FALSE;
2404           }
2405           if (valid && pressures) {
2406             IS t_pressure_subs;
2407             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2408             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2409             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2410           }
2411           if (valid) {
2412             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2413             pcbddc->benign_n++;
2414           } else {
2415             recompute_zerodiag = PETSC_TRUE;
2416           }
2417         }
2418         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2419         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2420       }
2421     } else { /* there's just one subdomain (or zero if they have not been detected */
2422       PetscBool valid = PETSC_TRUE;
2423 
2424       if (nneu) valid = PETSC_FALSE;
2425       if (valid && pressures) {
2426         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2427       }
2428       if (valid && checkb) {
2429         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2430         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2431         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2432         for (j=0;j<n_interior_dofs;j++) {
2433           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2434             valid = PETSC_FALSE;
2435             break;
2436           }
2437         }
2438         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2439       }
2440       if (valid) {
2441         pcbddc->benign_n = 1;
2442         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2443         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2444         zerodiag_subs[0] = zerodiag;
2445       }
2446     }
2447     if (checkb) {
2448       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2449     }
2450   }
2451   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2452 
2453   if (!pcbddc->benign_n) {
2454     PetscInt n;
2455 
2456     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2457     recompute_zerodiag = PETSC_FALSE;
2458     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2459     if (n) {
2460       has_null_pressures = PETSC_FALSE;
2461       have_null = PETSC_FALSE;
2462     }
2463   }
2464 
2465   /* final check for null pressures */
2466   if (zerodiag && pressures) {
2467     PetscInt nz,np;
2468     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2469     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2470     if (nz != np) have_null = PETSC_FALSE;
2471   }
2472 
2473   if (recompute_zerodiag) {
2474     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2475     if (pcbddc->benign_n == 1) {
2476       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2477       zerodiag = zerodiag_subs[0];
2478     } else {
2479       PetscInt i,nzn,*new_idxs;
2480 
2481       nzn = 0;
2482       for (i=0;i<pcbddc->benign_n;i++) {
2483         PetscInt ns;
2484         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2485         nzn += ns;
2486       }
2487       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2488       nzn = 0;
2489       for (i=0;i<pcbddc->benign_n;i++) {
2490         PetscInt ns,*idxs;
2491         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2492         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2493         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2494         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2495         nzn += ns;
2496       }
2497       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2498       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2499     }
2500     have_null = PETSC_FALSE;
2501   }
2502 
2503   /* Prepare matrix to compute no-net-flux */
2504   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2505     Mat                    A,loc_divudotp;
2506     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2507     IS                     row,col,isused = NULL;
2508     PetscInt               M,N,n,st,n_isused;
2509 
2510     if (pressures) {
2511       isused = pressures;
2512     } else {
2513       isused = zerodiag_save;
2514     }
2515     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2516     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2517     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2518     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");
2519     n_isused = 0;
2520     if (isused) {
2521       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2522     }
2523     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2524     st = st-n_isused;
2525     if (n) {
2526       const PetscInt *gidxs;
2527 
2528       ierr = MatGetSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2529       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2530       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2531       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2532       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2533       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2534     } else {
2535       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2536       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2537       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2538     }
2539     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2540     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2541     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2542     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2543     ierr = ISDestroy(&row);CHKERRQ(ierr);
2544     ierr = ISDestroy(&col);CHKERRQ(ierr);
2545     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2546     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2547     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2548     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2549     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2550     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2551     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2552     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2553     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2554     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2555   }
2556   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2557 
2558   /* change of basis and p0 dofs */
2559   if (has_null_pressures) {
2560     IS             zerodiagc;
2561     const PetscInt *idxs,*idxsc;
2562     PetscInt       i,s,*nnz;
2563 
2564     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2565     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2566     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2567     /* local change of basis for pressures */
2568     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2569     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2570     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2571     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2572     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2573     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2574     for (i=0;i<pcbddc->benign_n;i++) {
2575       PetscInt nzs,j;
2576 
2577       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2578       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2579       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2580       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2581       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2582     }
2583     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2584     ierr = PetscFree(nnz);CHKERRQ(ierr);
2585     /* set identity on velocities */
2586     for (i=0;i<n-nz;i++) {
2587       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2588     }
2589     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2590     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2591     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2592     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2593     /* set change on pressures */
2594     for (s=0;s<pcbddc->benign_n;s++) {
2595       PetscScalar *array;
2596       PetscInt    nzs;
2597 
2598       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2599       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2600       for (i=0;i<nzs-1;i++) {
2601         PetscScalar vals[2];
2602         PetscInt    cols[2];
2603 
2604         cols[0] = idxs[i];
2605         cols[1] = idxs[nzs-1];
2606         vals[0] = 1.;
2607         vals[1] = 1.;
2608         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2609       }
2610       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2611       for (i=0;i<nzs-1;i++) array[i] = -1.;
2612       array[nzs-1] = 1.;
2613       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2614       /* store local idxs for p0 */
2615       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2616       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2617       ierr = PetscFree(array);CHKERRQ(ierr);
2618     }
2619     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2620     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2621     /* project if needed */
2622     if (pcbddc->benign_change_explicit) {
2623       Mat M;
2624 
2625       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2626       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2627       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2628       ierr = MatDestroy(&M);CHKERRQ(ierr);
2629     }
2630     /* store global idxs for p0 */
2631     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2632   }
2633   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2634   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2635 
2636   /* determines if the coarse solver will be singular or not */
2637   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2638   /* determines if the problem has subdomains with 0 pressure block */
2639   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2640   *zerodiaglocal = zerodiag;
2641   PetscFunctionReturn(0);
2642 }
2643 
2644 #undef __FUNCT__
2645 #define __FUNCT__ "PCBDDCBenignGetOrSetP0"
2646 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2647 {
2648   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2649   PetscScalar    *array;
2650   PetscErrorCode ierr;
2651 
2652   PetscFunctionBegin;
2653   if (!pcbddc->benign_sf) {
2654     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2655     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2656   }
2657   if (get) {
2658     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2659     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2660     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2661     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2662   } else {
2663     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2664     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2665     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2666     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2667   }
2668   PetscFunctionReturn(0);
2669 }
2670 
2671 #undef __FUNCT__
2672 #define __FUNCT__ "PCBDDCBenignPopOrPushB0"
2673 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2674 {
2675   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2676   PetscErrorCode ierr;
2677 
2678   PetscFunctionBegin;
2679   /* TODO: add error checking
2680     - avoid nested pop (or push) calls.
2681     - cannot push before pop.
2682     - cannot call this if pcbddc->local_mat is NULL
2683   */
2684   if (!pcbddc->benign_n) {
2685     PetscFunctionReturn(0);
2686   }
2687   if (pop) {
2688     if (pcbddc->benign_change_explicit) {
2689       IS       is_p0;
2690       MatReuse reuse;
2691 
2692       /* extract B_0 */
2693       reuse = MAT_INITIAL_MATRIX;
2694       if (pcbddc->benign_B0) {
2695         reuse = MAT_REUSE_MATRIX;
2696       }
2697       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2698       ierr = MatGetSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2699       /* remove rows and cols from local problem */
2700       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2701       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2702       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2703       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2704     } else {
2705       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2706       PetscScalar *vals;
2707       PetscInt    i,n,*idxs_ins;
2708 
2709       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2710       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2711       if (!pcbddc->benign_B0) {
2712         PetscInt *nnz;
2713         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2714         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2715         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2716         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2717         for (i=0;i<pcbddc->benign_n;i++) {
2718           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2719           nnz[i] = n - nnz[i];
2720         }
2721         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2722         ierr = PetscFree(nnz);CHKERRQ(ierr);
2723       }
2724 
2725       for (i=0;i<pcbddc->benign_n;i++) {
2726         PetscScalar *array;
2727         PetscInt    *idxs,j,nz,cum;
2728 
2729         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2730         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2731         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2732         for (j=0;j<nz;j++) vals[j] = 1.;
2733         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2734         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2735         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2736         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2737         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2738         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2739         cum = 0;
2740         for (j=0;j<n;j++) {
2741           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2742             vals[cum] = array[j];
2743             idxs_ins[cum] = j;
2744             cum++;
2745           }
2746         }
2747         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2748         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2749         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2750       }
2751       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2752       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2753       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2754     }
2755   } else { /* push */
2756     if (pcbddc->benign_change_explicit) {
2757       PetscInt i;
2758 
2759       for (i=0;i<pcbddc->benign_n;i++) {
2760         PetscScalar *B0_vals;
2761         PetscInt    *B0_cols,B0_ncol;
2762 
2763         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2764         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2765         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2766         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2767         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2768       }
2769       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2770       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2771     } else {
2772       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2773     }
2774   }
2775   PetscFunctionReturn(0);
2776 }
2777 
2778 #undef __FUNCT__
2779 #define __FUNCT__ "PCBDDCAdaptiveSelection"
2780 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2781 {
2782   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2783   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2784   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2785   PetscBLASInt    *B_iwork,*B_ifail;
2786   PetscScalar     *work,lwork;
2787   PetscScalar     *St,*S,*eigv;
2788   PetscScalar     *Sarray,*Starray;
2789   PetscReal       *eigs,thresh;
2790   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2791   PetscBool       allocated_S_St;
2792 #if defined(PETSC_USE_COMPLEX)
2793   PetscReal       *rwork;
2794 #endif
2795   PetscErrorCode  ierr;
2796 
2797   PetscFunctionBegin;
2798   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2799   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2800   if (sub_schurs->n_subs && (!sub_schurs->is_hermitian || !sub_schurs->is_posdef)) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for general matrix pencils (herm %d, posdef %d)\n",sub_schurs->is_hermitian,sub_schurs->is_posdef);
2801 
2802   if (pcbddc->dbg_flag) {
2803     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2804     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2805     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2806     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2807   }
2808 
2809   if (pcbddc->dbg_flag) {
2810     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2811   }
2812 
2813   /* max size of subsets */
2814   mss = 0;
2815   for (i=0;i<sub_schurs->n_subs;i++) {
2816     PetscInt subset_size;
2817 
2818     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2819     mss = PetscMax(mss,subset_size);
2820   }
2821 
2822   /* min/max and threshold */
2823   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2824   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2825   nmax = PetscMax(nmin,nmax);
2826   allocated_S_St = PETSC_FALSE;
2827   if (nmin) {
2828     allocated_S_St = PETSC_TRUE;
2829   }
2830 
2831   /* allocate lapack workspace */
2832   cum = cum2 = 0;
2833   maxneigs = 0;
2834   for (i=0;i<sub_schurs->n_subs;i++) {
2835     PetscInt n,subset_size;
2836 
2837     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2838     n = PetscMin(subset_size,nmax);
2839     cum += subset_size;
2840     cum2 += subset_size*n;
2841     maxneigs = PetscMax(maxneigs,n);
2842   }
2843   if (mss) {
2844     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2845       PetscBLASInt B_itype = 1;
2846       PetscBLASInt B_N = mss;
2847       PetscReal    zero = 0.0;
2848       PetscReal    eps = 0.0; /* dlamch? */
2849 
2850       B_lwork = -1;
2851       S = NULL;
2852       St = NULL;
2853       eigs = NULL;
2854       eigv = NULL;
2855       B_iwork = NULL;
2856       B_ifail = NULL;
2857 #if defined(PETSC_USE_COMPLEX)
2858       rwork = NULL;
2859 #endif
2860       thresh = 1.0;
2861       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2862 #if defined(PETSC_USE_COMPLEX)
2863       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));
2864 #else
2865       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));
2866 #endif
2867       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
2868       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2869     } else {
2870         /* TODO */
2871     }
2872   } else {
2873     lwork = 0;
2874   }
2875 
2876   nv = 0;
2877   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) */
2878     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
2879   }
2880   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
2881   if (allocated_S_St) {
2882     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
2883   }
2884   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
2885 #if defined(PETSC_USE_COMPLEX)
2886   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
2887 #endif
2888   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
2889                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
2890                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
2891                       nv+cum,&pcbddc->adaptive_constraints_idxs,
2892                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
2893   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
2894 
2895   maxneigs = 0;
2896   cum = cumarray = 0;
2897   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
2898   pcbddc->adaptive_constraints_data_ptr[0] = 0;
2899   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
2900     const PetscInt *idxs;
2901 
2902     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2903     for (cum=0;cum<nv;cum++) {
2904       pcbddc->adaptive_constraints_n[cum] = 1;
2905       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
2906       pcbddc->adaptive_constraints_data[cum] = 1.0;
2907       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
2908       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
2909     }
2910     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2911   }
2912 
2913   if (mss) { /* multilevel */
2914     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
2915     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
2916   }
2917 
2918   thresh = pcbddc->adaptive_threshold;
2919   for (i=0;i<sub_schurs->n_subs;i++) {
2920     const PetscInt *idxs;
2921     PetscReal      upper,lower;
2922     PetscInt       j,subset_size,eigs_start = 0;
2923     PetscBLASInt   B_N;
2924     PetscBool      same_data = PETSC_FALSE;
2925 
2926     if (pcbddc->use_deluxe_scaling) {
2927       upper = PETSC_MAX_REAL;
2928       lower = thresh;
2929     } else {
2930       upper = 1./thresh;
2931       lower = 0.;
2932     }
2933     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2934     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
2935     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2936     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
2937       if (sub_schurs->is_hermitian) {
2938         PetscInt j,k;
2939         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
2940           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2941           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2942         }
2943         for (j=0;j<subset_size;j++) {
2944           for (k=j;k<subset_size;k++) {
2945             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2946             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2947           }
2948         }
2949       } else {
2950         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2951         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2952       }
2953     } else {
2954       S = Sarray + cumarray;
2955       St = Starray + cumarray;
2956     }
2957     /* see if we can save some work */
2958     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
2959       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
2960     }
2961 
2962     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
2963       B_neigs = 0;
2964     } else {
2965       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2966         PetscBLASInt B_itype = 1;
2967         PetscBLASInt B_IL, B_IU;
2968         PetscReal    eps = -1.0; /* dlamch? */
2969         PetscInt     nmin_s;
2970         PetscBool    compute_range = PETSC_FALSE;
2971 
2972         if (pcbddc->dbg_flag) {
2973           PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d.\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]]);
2974         }
2975 
2976         compute_range = PETSC_FALSE;
2977         if (thresh > 1.+PETSC_SMALL && !same_data) {
2978           compute_range = PETSC_TRUE;
2979         }
2980 
2981         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2982         if (compute_range) {
2983 
2984           /* ask for eigenvalues larger than thresh */
2985 #if defined(PETSC_USE_COMPLEX)
2986           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));
2987 #else
2988           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));
2989 #endif
2990         } else if (!same_data) {
2991           B_IU = PetscMax(1,PetscMin(B_N,nmax));
2992           B_IL = 1;
2993 #if defined(PETSC_USE_COMPLEX)
2994           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));
2995 #else
2996           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));
2997 #endif
2998         } else { /* same_data is true, so just get the adaptive functional requested by the user */
2999           PetscInt k;
3000           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3001           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3002           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3003           nmin = nmax;
3004           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3005           for (k=0;k<nmax;k++) {
3006             eigs[k] = 1./PETSC_SMALL;
3007             eigv[k*(subset_size+1)] = 1.0;
3008           }
3009         }
3010         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3011         if (B_ierr) {
3012           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3013           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);
3014           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);
3015         }
3016 
3017         if (B_neigs > nmax) {
3018           if (pcbddc->dbg_flag) {
3019             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
3020           }
3021           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
3022           B_neigs = nmax;
3023         }
3024 
3025         nmin_s = PetscMin(nmin,B_N);
3026         if (B_neigs < nmin_s) {
3027           PetscBLASInt B_neigs2;
3028 
3029           if (pcbddc->use_deluxe_scaling) {
3030             B_IL = B_N - nmin_s + 1;
3031             B_IU = B_N - B_neigs;
3032           } else {
3033             B_IL = B_neigs + 1;
3034             B_IU = nmin_s;
3035           }
3036           if (pcbddc->dbg_flag) {
3037             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);
3038           }
3039           if (sub_schurs->is_hermitian) {
3040             PetscInt j,k;
3041             for (j=0;j<subset_size;j++) {
3042               for (k=j;k<subset_size;k++) {
3043                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3044                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3045               }
3046             }
3047           } else {
3048             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3049             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3050           }
3051           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3052 #if defined(PETSC_USE_COMPLEX)
3053           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));
3054 #else
3055           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));
3056 #endif
3057           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3058           B_neigs += B_neigs2;
3059         }
3060         if (B_ierr) {
3061           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3062           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);
3063           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);
3064         }
3065         if (pcbddc->dbg_flag) {
3066           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3067           for (j=0;j<B_neigs;j++) {
3068             if (eigs[j] == 0.0) {
3069               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3070             } else {
3071               if (pcbddc->use_deluxe_scaling) {
3072                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3073               } else {
3074                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3075               }
3076             }
3077           }
3078         }
3079       } else {
3080           /* TODO */
3081       }
3082     }
3083     /* change the basis back to the original one */
3084     if (sub_schurs->change) {
3085       Mat change,phi,phit;
3086 
3087       if (pcbddc->dbg_flag > 1) {
3088         PetscInt ii;
3089         for (ii=0;ii<B_neigs;ii++) {
3090           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3091           for (j=0;j<B_N;j++) {
3092 #if defined(PETSC_USE_COMPLEX)
3093             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3094             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3095             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3096 #else
3097             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3098 #endif
3099           }
3100         }
3101       }
3102       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3103       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3104       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3105       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3106       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3107       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3108     }
3109     maxneigs = PetscMax(B_neigs,maxneigs);
3110     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3111     if (B_neigs) {
3112       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);
3113 
3114       if (pcbddc->dbg_flag > 1) {
3115         PetscInt ii;
3116         for (ii=0;ii<B_neigs;ii++) {
3117           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3118           for (j=0;j<B_N;j++) {
3119 #if defined(PETSC_USE_COMPLEX)
3120             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3121             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3122             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3123 #else
3124             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3125 #endif
3126           }
3127         }
3128       }
3129       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3130       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3131       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3132       cum++;
3133     }
3134     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3135     /* shift for next computation */
3136     cumarray += subset_size*subset_size;
3137   }
3138   if (pcbddc->dbg_flag) {
3139     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3140   }
3141 
3142   if (mss) {
3143     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3144     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3145     /* destroy matrices (junk) */
3146     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3147     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3148   }
3149   if (allocated_S_St) {
3150     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3151   }
3152   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3153 #if defined(PETSC_USE_COMPLEX)
3154   ierr = PetscFree(rwork);CHKERRQ(ierr);
3155 #endif
3156   if (pcbddc->dbg_flag) {
3157     PetscInt maxneigs_r;
3158     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3159     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3160   }
3161   PetscFunctionReturn(0);
3162 }
3163 
3164 #undef __FUNCT__
3165 #define __FUNCT__ "PCBDDCSetUpSolvers"
3166 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3167 {
3168   PetscScalar    *coarse_submat_vals;
3169   PetscErrorCode ierr;
3170 
3171   PetscFunctionBegin;
3172   /* Setup local scatters R_to_B and (optionally) R_to_D */
3173   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3174   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3175 
3176   /* Setup local neumann solver ksp_R */
3177   /* PCBDDCSetUpLocalScatters should be called first! */
3178   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3179 
3180   /*
3181      Setup local correction and local part of coarse basis.
3182      Gives back the dense local part of the coarse matrix in column major ordering
3183   */
3184   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3185 
3186   /* Compute total number of coarse nodes and setup coarse solver */
3187   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3188 
3189   /* free */
3190   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3191   PetscFunctionReturn(0);
3192 }
3193 
3194 #undef __FUNCT__
3195 #define __FUNCT__ "PCBDDCResetCustomization"
3196 PetscErrorCode PCBDDCResetCustomization(PC pc)
3197 {
3198   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3199   PetscErrorCode ierr;
3200 
3201   PetscFunctionBegin;
3202   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3203   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3204   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3205   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3206   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3207   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3208   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3209   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3210   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3211   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3212   PetscFunctionReturn(0);
3213 }
3214 
3215 #undef __FUNCT__
3216 #define __FUNCT__ "PCBDDCResetTopography"
3217 PetscErrorCode PCBDDCResetTopography(PC pc)
3218 {
3219   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3220   PetscInt       i;
3221   PetscErrorCode ierr;
3222 
3223   PetscFunctionBegin;
3224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3226   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3227   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3228   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3229   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3230   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3231   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3232   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3233   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3234   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
3235   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
3236   for (i=0;i<pcbddc->n_local_subs;i++) {
3237     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3238   }
3239   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3240   if (pcbddc->sub_schurs) {
3241     ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
3242   }
3243   pcbddc->graphanalyzed        = PETSC_FALSE;
3244   pcbddc->recompute_topography = PETSC_TRUE;
3245   PetscFunctionReturn(0);
3246 }
3247 
3248 #undef __FUNCT__
3249 #define __FUNCT__ "PCBDDCResetSolvers"
3250 PetscErrorCode PCBDDCResetSolvers(PC pc)
3251 {
3252   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3253   PetscErrorCode ierr;
3254 
3255   PetscFunctionBegin;
3256   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3257   if (pcbddc->coarse_phi_B) {
3258     PetscScalar *array;
3259     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3260     ierr = PetscFree(array);CHKERRQ(ierr);
3261   }
3262   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3263   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3264   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3265   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3266   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3267   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3268   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3269   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3270   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3271   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3272   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3273   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3274   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3275   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3276   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
3277   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
3278   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
3279   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3280   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3281   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3282   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3283   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3284   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3285   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3286   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3287   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3288   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3289   if (pcbddc->benign_zerodiag_subs) {
3290     PetscInt i;
3291     for (i=0;i<pcbddc->benign_n;i++) {
3292       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3293     }
3294     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3295   }
3296   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3297   PetscFunctionReturn(0);
3298 }
3299 
3300 #undef __FUNCT__
3301 #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
3302 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3303 {
3304   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3305   PC_IS          *pcis = (PC_IS*)pc->data;
3306   VecType        impVecType;
3307   PetscInt       n_constraints,n_R,old_size;
3308   PetscErrorCode ierr;
3309 
3310   PetscFunctionBegin;
3311   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3312   n_R = pcis->n - pcbddc->n_vertices;
3313   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3314   /* local work vectors (try to avoid unneeded work)*/
3315   /* R nodes */
3316   old_size = -1;
3317   if (pcbddc->vec1_R) {
3318     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3319   }
3320   if (n_R != old_size) {
3321     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3322     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3323     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3324     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3325     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3326     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3327   }
3328   /* local primal dofs */
3329   old_size = -1;
3330   if (pcbddc->vec1_P) {
3331     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3332   }
3333   if (pcbddc->local_primal_size != old_size) {
3334     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3335     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3336     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3337     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3338   }
3339   /* local explicit constraints */
3340   old_size = -1;
3341   if (pcbddc->vec1_C) {
3342     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3343   }
3344   if (n_constraints && n_constraints != old_size) {
3345     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3346     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3347     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3348     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3349   }
3350   PetscFunctionReturn(0);
3351 }
3352 
3353 #undef __FUNCT__
3354 #define __FUNCT__ "PCBDDCSetUpCorrection"
3355 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3356 {
3357   PetscErrorCode  ierr;
3358   /* pointers to pcis and pcbddc */
3359   PC_IS*          pcis = (PC_IS*)pc->data;
3360   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3361   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3362   /* submatrices of local problem */
3363   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3364   /* submatrices of local coarse problem */
3365   Mat             S_VV,S_CV,S_VC,S_CC;
3366   /* working matrices */
3367   Mat             C_CR;
3368   /* additional working stuff */
3369   PC              pc_R;
3370   Mat             F;
3371   Vec             dummy_vec;
3372   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3373   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3374   PetscScalar     *work;
3375   PetscInt        *idx_V_B;
3376   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3377   PetscInt        i,n_R,n_D,n_B;
3378 
3379   /* some shortcuts to scalars */
3380   PetscScalar     one=1.0,m_one=-1.0;
3381 
3382   PetscFunctionBegin;
3383   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");
3384 
3385   /* Set Non-overlapping dimensions */
3386   n_vertices = pcbddc->n_vertices;
3387   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3388   n_B = pcis->n_B;
3389   n_D = pcis->n - n_B;
3390   n_R = pcis->n - n_vertices;
3391 
3392   /* vertices in boundary numbering */
3393   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3394   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3395   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3396 
3397   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3398   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3399   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3400   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3401   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3402   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3403   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3404   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3405   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3406   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3407 
3408   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3409   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3410   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3411   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3412   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3413   lda_rhs = n_R;
3414   need_benign_correction = PETSC_FALSE;
3415   if (isLU || isILU || isCHOL) {
3416     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3417   } else if (sub_schurs && sub_schurs->reuse_solver) {
3418     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3419     MatFactorType      type;
3420 
3421     F = reuse_solver->F;
3422     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3423     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3424     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3425     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3426   } else {
3427     F = NULL;
3428   }
3429 
3430   /* allocate workspace */
3431   n = 0;
3432   if (n_constraints) {
3433     n += lda_rhs*n_constraints;
3434   }
3435   if (n_vertices) {
3436     n = PetscMax(2*lda_rhs*n_vertices,n);
3437     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3438   }
3439   if (!pcbddc->symmetric_primal) {
3440     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3441   }
3442   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3443 
3444   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3445   dummy_vec = NULL;
3446   if (need_benign_correction && lda_rhs != n_R && F) {
3447     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3448   }
3449 
3450   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3451   if (n_constraints) {
3452     Mat         M1,M2,M3,C_B;
3453     IS          is_aux;
3454     PetscScalar *array,*array2;
3455 
3456     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3457     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3458 
3459     /* Extract constraints on R nodes: C_{CR}  */
3460     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3461     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3462     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3463 
3464     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3465     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3466     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3467     for (i=0;i<n_constraints;i++) {
3468       const PetscScalar *row_cmat_values;
3469       const PetscInt    *row_cmat_indices;
3470       PetscInt          size_of_constraint,j;
3471 
3472       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3473       for (j=0;j<size_of_constraint;j++) {
3474         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3475       }
3476       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3477     }
3478     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3479     if (F) {
3480       Mat B;
3481 
3482       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3483       if (need_benign_correction) {
3484         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3485 
3486         /* rhs is already zero on interior dofs, no need to change the rhs */
3487         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3488       }
3489       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3490       if (need_benign_correction) {
3491         PetscScalar        *marr;
3492         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3493 
3494         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3495         if (lda_rhs != n_R) {
3496           for (i=0;i<n_constraints;i++) {
3497             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3498             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3499             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3500           }
3501         } else {
3502           for (i=0;i<n_constraints;i++) {
3503             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3504             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3505             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3506           }
3507         }
3508         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3509       }
3510       ierr = MatDestroy(&B);CHKERRQ(ierr);
3511     } else {
3512       PetscScalar *marr;
3513 
3514       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3515       for (i=0;i<n_constraints;i++) {
3516         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3517         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3518         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3519         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3520         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3521       }
3522       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3523     }
3524     if (!pcbddc->switch_static) {
3525       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3526       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3527       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3528       for (i=0;i<n_constraints;i++) {
3529         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3530         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3531         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3532         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3533         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3534         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3535       }
3536       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3537       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3538       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3539     } else {
3540       if (lda_rhs != n_R) {
3541         IS dummy;
3542 
3543         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3544         ierr = MatGetSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3545         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3546       } else {
3547         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3548         pcbddc->local_auxmat2 = local_auxmat2_R;
3549       }
3550       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3551     }
3552     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3553     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3554     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3555     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3556     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3557     if (isCHOL) {
3558       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3559     } else {
3560       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3561     }
3562     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3563     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3564     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3565     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3566     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3567     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3568     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3569     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3570     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3571     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3572   }
3573 
3574   /* Get submatrices from subdomain matrix */
3575   if (n_vertices) {
3576     IS is_aux;
3577 
3578     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3579       IS tis;
3580 
3581       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3582       ierr = ISSort(tis);CHKERRQ(ierr);
3583       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3584       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3585     } else {
3586       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3587     }
3588     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3589     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3590     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3591     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3592   }
3593 
3594   /* Matrix of coarse basis functions (local) */
3595   if (pcbddc->coarse_phi_B) {
3596     PetscInt on_B,on_primal,on_D=n_D;
3597     if (pcbddc->coarse_phi_D) {
3598       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3599     }
3600     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3601     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3602       PetscScalar *marray;
3603 
3604       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3605       ierr = PetscFree(marray);CHKERRQ(ierr);
3606       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3607       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3608       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3609       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3610     }
3611   }
3612 
3613   if (!pcbddc->coarse_phi_B) {
3614     PetscScalar *marray;
3615 
3616     n = n_B*pcbddc->local_primal_size;
3617     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3618       n += n_D*pcbddc->local_primal_size;
3619     }
3620     if (!pcbddc->symmetric_primal) {
3621       n *= 2;
3622     }
3623     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
3624     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3625     n = n_B*pcbddc->local_primal_size;
3626     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3627       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3628       n += n_D*pcbddc->local_primal_size;
3629     }
3630     if (!pcbddc->symmetric_primal) {
3631       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3632       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3633         n = n_B*pcbddc->local_primal_size;
3634         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3635       }
3636     } else {
3637       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3638       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3639       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3640         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3641         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3642       }
3643     }
3644   }
3645 
3646   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3647   p0_lidx_I = NULL;
3648   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3649     const PetscInt *idxs;
3650 
3651     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3652     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3653     for (i=0;i<pcbddc->benign_n;i++) {
3654       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3655     }
3656     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3657   }
3658 
3659   /* vertices */
3660   if (n_vertices) {
3661 
3662     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3663 
3664     if (n_R) {
3665       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3666       PetscBLASInt B_N,B_one = 1;
3667       PetscScalar  *x,*y;
3668       PetscBool    isseqaij;
3669 
3670       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3671       if (need_benign_correction) {
3672         ISLocalToGlobalMapping RtoN;
3673         IS                     is_p0;
3674         PetscInt               *idxs_p0,n;
3675 
3676         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3677         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3678         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3679         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);
3680         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3681         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3682         ierr = MatGetSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3683         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3684       }
3685 
3686       if (lda_rhs == n_R) {
3687         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3688       } else {
3689         PetscScalar    *av,*array;
3690         const PetscInt *xadj,*adjncy;
3691         PetscInt       n;
3692         PetscBool      flg_row;
3693 
3694         array = work+lda_rhs*n_vertices;
3695         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3696         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3697         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3698         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3699         for (i=0;i<n;i++) {
3700           PetscInt j;
3701           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3702         }
3703         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3704         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3705         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3706       }
3707       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3708       if (need_benign_correction) {
3709         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3710         PetscScalar        *marr;
3711 
3712         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3713         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3714 
3715                | 0 0  0 | (V)
3716            L = | 0 0 -1 | (P-p0)
3717                | 0 0 -1 | (p0)
3718 
3719         */
3720         for (i=0;i<reuse_solver->benign_n;i++) {
3721           const PetscScalar *vals;
3722           const PetscInt    *idxs,*idxs_zero;
3723           PetscInt          n,j,nz;
3724 
3725           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3726           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3727           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3728           for (j=0;j<n;j++) {
3729             PetscScalar val = vals[j];
3730             PetscInt    k,col = idxs[j];
3731             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3732           }
3733           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3734           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3735         }
3736         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3737       }
3738       if (F) {
3739         /* need to correct the rhs */
3740         if (need_benign_correction) {
3741           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3742           PetscScalar        *marr;
3743 
3744           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3745           if (lda_rhs != n_R) {
3746             for (i=0;i<n_vertices;i++) {
3747               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3748               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3749               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3750             }
3751           } else {
3752             for (i=0;i<n_vertices;i++) {
3753               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3754               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3755               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3756             }
3757           }
3758           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3759         }
3760         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3761         /* need to correct the solution */
3762         if (need_benign_correction) {
3763           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3764           PetscScalar        *marr;
3765 
3766           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3767           if (lda_rhs != n_R) {
3768             for (i=0;i<n_vertices;i++) {
3769               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3770               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3771               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3772             }
3773           } else {
3774             for (i=0;i<n_vertices;i++) {
3775               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3776               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3777               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3778             }
3779           }
3780           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3781         }
3782       } else {
3783         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3784         for (i=0;i<n_vertices;i++) {
3785           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3786           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3787           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3788           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3789           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3790         }
3791         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3792       }
3793       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3794       /* S_VV and S_CV */
3795       if (n_constraints) {
3796         Mat B;
3797 
3798         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3799         for (i=0;i<n_vertices;i++) {
3800           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3801           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3802           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3803           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3804           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3805           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3806         }
3807         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3808         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3809         ierr = MatDestroy(&B);CHKERRQ(ierr);
3810         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3811         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3812         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3813         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3814         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3815         ierr = MatDestroy(&B);CHKERRQ(ierr);
3816       }
3817       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3818       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3819         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3820       }
3821       if (lda_rhs != n_R) {
3822         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3823         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3824         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3825       }
3826       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3827       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3828       if (need_benign_correction) {
3829         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3830         PetscScalar      *marr,*sums;
3831 
3832         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3833         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3834         for (i=0;i<reuse_solver->benign_n;i++) {
3835           const PetscScalar *vals;
3836           const PetscInt    *idxs,*idxs_zero;
3837           PetscInt          n,j,nz;
3838 
3839           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3840           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3841           for (j=0;j<n_vertices;j++) {
3842             PetscInt k;
3843             sums[j] = 0.;
3844             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3845           }
3846           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3847           for (j=0;j<n;j++) {
3848             PetscScalar val = vals[j];
3849             PetscInt k;
3850             for (k=0;k<n_vertices;k++) {
3851               marr[idxs[j]+k*n_vertices] += val*sums[k];
3852             }
3853           }
3854           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3855           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3856         }
3857         ierr = PetscFree(sums);CHKERRQ(ierr);
3858         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3859         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3860       }
3861       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3862       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3863       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3864       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3865       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3866       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3867       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3868       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3869       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3870     } else {
3871       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3872     }
3873     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3874 
3875     /* coarse basis functions */
3876     for (i=0;i<n_vertices;i++) {
3877       PetscScalar *y;
3878 
3879       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3880       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3881       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3882       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3883       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3884       y[n_B*i+idx_V_B[i]] = 1.0;
3885       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3886       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3887 
3888       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3889         PetscInt j;
3890 
3891         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3892         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3893         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3894         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3895         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3896         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3897         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3898       }
3899       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3900     }
3901     /* if n_R == 0 the object is not destroyed */
3902     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3903   }
3904   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
3905 
3906   if (n_constraints) {
3907     Mat B;
3908 
3909     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3910     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3911     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3912     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3913     if (n_vertices) {
3914       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
3915         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
3916       } else {
3917         Mat S_VCt;
3918 
3919         if (lda_rhs != n_R) {
3920           ierr = MatDestroy(&B);CHKERRQ(ierr);
3921           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
3922           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
3923         }
3924         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
3925         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3926         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
3927       }
3928     }
3929     ierr = MatDestroy(&B);CHKERRQ(ierr);
3930     /* coarse basis functions */
3931     for (i=0;i<n_constraints;i++) {
3932       PetscScalar *y;
3933 
3934       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3935       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3936       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
3937       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3938       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3939       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3940       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3941       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3942         PetscInt j;
3943 
3944         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3945         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
3946         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3947         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3948         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3949         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3950         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3951       }
3952       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3953     }
3954   }
3955   if (n_constraints) {
3956     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
3957   }
3958   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
3959 
3960   /* coarse matrix entries relative to B_0 */
3961   if (pcbddc->benign_n) {
3962     Mat         B0_B,B0_BPHI;
3963     IS          is_dummy;
3964     PetscScalar *data;
3965     PetscInt    j;
3966 
3967     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
3968     ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
3969     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
3970     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
3971     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
3972     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
3973     for (j=0;j<pcbddc->benign_n;j++) {
3974       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
3975       for (i=0;i<pcbddc->local_primal_size;i++) {
3976         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
3977         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
3978       }
3979     }
3980     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
3981     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
3982     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
3983   }
3984 
3985   /* compute other basis functions for non-symmetric problems */
3986   if (!pcbddc->symmetric_primal) {
3987     Mat         B_V=NULL,B_C=NULL;
3988     PetscScalar *marray;
3989 
3990     if (n_constraints) {
3991       Mat S_CCT,C_CRT;
3992 
3993       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
3994       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
3995       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
3996       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
3997       if (n_vertices) {
3998         Mat S_VCT;
3999 
4000         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4001         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4002         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4003       }
4004       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4005     } else {
4006       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4007     }
4008     if (n_vertices && n_R) {
4009       PetscScalar    *av,*marray;
4010       const PetscInt *xadj,*adjncy;
4011       PetscInt       n;
4012       PetscBool      flg_row;
4013 
4014       /* B_V = B_V - A_VR^T */
4015       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4016       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4017       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4018       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4019       for (i=0;i<n;i++) {
4020         PetscInt j;
4021         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4022       }
4023       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4024       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4025       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4026     }
4027 
4028     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4029     if (n_vertices) {
4030       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4031       for (i=0;i<n_vertices;i++) {
4032         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4033         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4034         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4035         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4036         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4037       }
4038       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4039     }
4040     if (B_C) {
4041       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4042       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4043         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4044         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4045         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4046         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4047         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4048       }
4049       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4050     }
4051     /* coarse basis functions */
4052     for (i=0;i<pcbddc->local_primal_size;i++) {
4053       PetscScalar *y;
4054 
4055       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4056       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4057       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4058       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4059       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4060       if (i<n_vertices) {
4061         y[n_B*i+idx_V_B[i]] = 1.0;
4062       }
4063       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4064       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4065 
4066       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4067         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4068         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4069         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4070         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4071         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4072         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4073       }
4074       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4075     }
4076     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4077     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4078   }
4079   /* free memory */
4080   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4081   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4082   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4083   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4084   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4085   ierr = PetscFree(work);CHKERRQ(ierr);
4086   if (n_vertices) {
4087     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4088   }
4089   if (n_constraints) {
4090     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4091   }
4092   /* Checking coarse_sub_mat and coarse basis functios */
4093   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4094   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4095   if (pcbddc->dbg_flag) {
4096     Mat         coarse_sub_mat;
4097     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4098     Mat         coarse_phi_D,coarse_phi_B;
4099     Mat         coarse_psi_D,coarse_psi_B;
4100     Mat         A_II,A_BB,A_IB,A_BI;
4101     Mat         C_B,CPHI;
4102     IS          is_dummy;
4103     Vec         mones;
4104     MatType     checkmattype=MATSEQAIJ;
4105     PetscReal   real_value;
4106 
4107     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4108       Mat A;
4109       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4110       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4111       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4112       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4113       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4114       ierr = MatDestroy(&A);CHKERRQ(ierr);
4115     } else {
4116       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4117       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4118       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4119       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4120     }
4121     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4122     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4123     if (!pcbddc->symmetric_primal) {
4124       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4125       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4126     }
4127     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4128 
4129     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4130     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4131     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4132     if (!pcbddc->symmetric_primal) {
4133       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4134       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4135       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4136       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4137       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4138       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4139       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4140       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4141       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4142       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4143       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4144       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4145     } else {
4146       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4147       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4148       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4149       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4150       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4151       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4152       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4153       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4154     }
4155     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4156     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4157     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4158     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4159     if (pcbddc->benign_n) {
4160       Mat         B0_B,B0_BPHI;
4161       PetscScalar *data,*data2;
4162       PetscInt    j;
4163 
4164       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4165       ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4166       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4167       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4168       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4169       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4170       for (j=0;j<pcbddc->benign_n;j++) {
4171         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4172         for (i=0;i<pcbddc->local_primal_size;i++) {
4173           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4174           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4175         }
4176       }
4177       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4178       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4179       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4180       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4181       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4182     }
4183 #if 0
4184   {
4185     PetscViewer viewer;
4186     char filename[256];
4187     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4188     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4189     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4190     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4191     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4192     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4193     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4194     if (save_change) {
4195       Mat phi_B;
4196       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4197       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4198       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4199       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4200     } else {
4201       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4202       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4203     }
4204     if (pcbddc->coarse_phi_D) {
4205       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4206       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4207     }
4208     if (pcbddc->coarse_psi_B) {
4209       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4210       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4211     }
4212     if (pcbddc->coarse_psi_D) {
4213       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4214       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4215     }
4216     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4217   }
4218 #endif
4219     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4220     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4221     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4222     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4223 
4224     /* check constraints */
4225     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4226     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4227     if (!pcbddc->benign_n) { /* TODO: add benign case */
4228       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4229     } else {
4230       PetscScalar *data;
4231       Mat         tmat;
4232       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4233       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4234       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4235       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4236       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4237     }
4238     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4239     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4240     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4241     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4242     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4243     if (!pcbddc->symmetric_primal) {
4244       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4245       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4246       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4247       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4248       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4249     }
4250     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4251     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4252     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4253     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4254     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4255     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4256     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4257     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4258     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4259     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4260     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4261     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4262     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4263     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4264     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4265     if (!pcbddc->symmetric_primal) {
4266       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4267       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4268     }
4269     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4270   }
4271   /* get back data */
4272   *coarse_submat_vals_n = coarse_submat_vals;
4273   PetscFunctionReturn(0);
4274 }
4275 
4276 #undef __FUNCT__
4277 #define __FUNCT__ "MatGetSubMatrixUnsorted"
4278 PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4279 {
4280   Mat            *work_mat;
4281   IS             isrow_s,iscol_s;
4282   PetscBool      rsorted,csorted;
4283   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4284   PetscErrorCode ierr;
4285 
4286   PetscFunctionBegin;
4287   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4288   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4289   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4290   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4291 
4292   if (!rsorted) {
4293     const PetscInt *idxs;
4294     PetscInt *idxs_sorted,i;
4295 
4296     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4297     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4298     for (i=0;i<rsize;i++) {
4299       idxs_perm_r[i] = i;
4300     }
4301     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4302     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4303     for (i=0;i<rsize;i++) {
4304       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4305     }
4306     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4307     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4308   } else {
4309     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4310     isrow_s = isrow;
4311   }
4312 
4313   if (!csorted) {
4314     if (isrow == iscol) {
4315       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4316       iscol_s = isrow_s;
4317     } else {
4318       const PetscInt *idxs;
4319       PetscInt       *idxs_sorted,i;
4320 
4321       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4322       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4323       for (i=0;i<csize;i++) {
4324         idxs_perm_c[i] = i;
4325       }
4326       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4327       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4328       for (i=0;i<csize;i++) {
4329         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4330       }
4331       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4332       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4333     }
4334   } else {
4335     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4336     iscol_s = iscol;
4337   }
4338 
4339   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4340 
4341   if (!rsorted || !csorted) {
4342     Mat      new_mat;
4343     IS       is_perm_r,is_perm_c;
4344 
4345     if (!rsorted) {
4346       PetscInt *idxs_r,i;
4347       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4348       for (i=0;i<rsize;i++) {
4349         idxs_r[idxs_perm_r[i]] = i;
4350       }
4351       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4352       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4353     } else {
4354       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4355     }
4356     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4357 
4358     if (!csorted) {
4359       if (isrow_s == iscol_s) {
4360         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4361         is_perm_c = is_perm_r;
4362       } else {
4363         PetscInt *idxs_c,i;
4364         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4365         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4366         for (i=0;i<csize;i++) {
4367           idxs_c[idxs_perm_c[i]] = i;
4368         }
4369         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4370         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4371       }
4372     } else {
4373       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4374     }
4375     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4376 
4377     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4378     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4379     work_mat[0] = new_mat;
4380     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4381     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4382   }
4383 
4384   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4385   *B = work_mat[0];
4386   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4387   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4388   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4389   PetscFunctionReturn(0);
4390 }
4391 
4392 #undef __FUNCT__
4393 #define __FUNCT__ "PCBDDCComputeLocalMatrix"
4394 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4395 {
4396   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4397   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4398   Mat            new_mat;
4399   IS             is_local,is_global;
4400   PetscInt       local_size;
4401   PetscBool      isseqaij;
4402   PetscErrorCode ierr;
4403 
4404   PetscFunctionBegin;
4405   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4406   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4407   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4408   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4409   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4410   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4411   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4412 
4413   /* check */
4414   if (pcbddc->dbg_flag) {
4415     Vec       x,x_change;
4416     PetscReal error;
4417 
4418     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4419     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4420     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4421     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4422     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4423     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4424     if (!pcbddc->change_interior) {
4425       const PetscScalar *x,*y,*v;
4426       PetscReal         lerror = 0.;
4427       PetscInt          i;
4428 
4429       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4430       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4431       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4432       for (i=0;i<local_size;i++)
4433         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4434           lerror = PetscAbsScalar(x[i]-y[i]);
4435       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4436       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4437       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4438       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4439       if (error > PETSC_SMALL) {
4440         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4441           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4442         } else {
4443           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4444         }
4445       }
4446     }
4447     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4448     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4449     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4450     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4451     if (error > PETSC_SMALL) {
4452       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4453         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4454       } else {
4455         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4456       }
4457     }
4458     ierr = VecDestroy(&x);CHKERRQ(ierr);
4459     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4460   }
4461 
4462   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4463   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4464   if (isseqaij) {
4465     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4466     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4467   } else {
4468     Mat work_mat;
4469 
4470     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4471     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4472     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4473     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4474   }
4475   if (matis->A->symmetric_set) {
4476     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4477 #if !defined(PETSC_USE_COMPLEX)
4478     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4479 #endif
4480   }
4481   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4482   PetscFunctionReturn(0);
4483 }
4484 
4485 #undef __FUNCT__
4486 #define __FUNCT__ "PCBDDCSetUpLocalScatters"
4487 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4488 {
4489   PC_IS*          pcis = (PC_IS*)(pc->data);
4490   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4491   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4492   PetscInt        *idx_R_local=NULL;
4493   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4494   PetscInt        vbs,bs;
4495   PetscBT         bitmask=NULL;
4496   PetscErrorCode  ierr;
4497 
4498   PetscFunctionBegin;
4499   /*
4500     No need to setup local scatters if
4501       - primal space is unchanged
4502         AND
4503       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4504         AND
4505       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4506   */
4507   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4508     PetscFunctionReturn(0);
4509   }
4510   /* destroy old objects */
4511   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4512   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4513   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4514   /* Set Non-overlapping dimensions */
4515   n_B = pcis->n_B;
4516   n_D = pcis->n - n_B;
4517   n_vertices = pcbddc->n_vertices;
4518 
4519   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4520 
4521   /* create auxiliary bitmask and allocate workspace */
4522   if (!sub_schurs || !sub_schurs->reuse_solver) {
4523     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4524     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4525     for (i=0;i<n_vertices;i++) {
4526       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4527     }
4528 
4529     for (i=0, n_R=0; i<pcis->n; i++) {
4530       if (!PetscBTLookup(bitmask,i)) {
4531         idx_R_local[n_R++] = i;
4532       }
4533     }
4534   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4535     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4536 
4537     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4538     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4539   }
4540 
4541   /* Block code */
4542   vbs = 1;
4543   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4544   if (bs>1 && !(n_vertices%bs)) {
4545     PetscBool is_blocked = PETSC_TRUE;
4546     PetscInt  *vary;
4547     if (!sub_schurs || !sub_schurs->reuse_solver) {
4548       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4549       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4550       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4551       /* 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 */
4552       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4553       for (i=0; i<pcis->n/bs; i++) {
4554         if (vary[i]!=0 && vary[i]!=bs) {
4555           is_blocked = PETSC_FALSE;
4556           break;
4557         }
4558       }
4559       ierr = PetscFree(vary);CHKERRQ(ierr);
4560     } else {
4561       /* Verify directly the R set */
4562       for (i=0; i<n_R/bs; i++) {
4563         PetscInt j,node=idx_R_local[bs*i];
4564         for (j=1; j<bs; j++) {
4565           if (node != idx_R_local[bs*i+j]-j) {
4566             is_blocked = PETSC_FALSE;
4567             break;
4568           }
4569         }
4570       }
4571     }
4572     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4573       vbs = bs;
4574       for (i=0;i<n_R/vbs;i++) {
4575         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4576       }
4577     }
4578   }
4579   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4580   if (sub_schurs && sub_schurs->reuse_solver) {
4581     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4582 
4583     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4584     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4585     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4586     reuse_solver->is_R = pcbddc->is_R_local;
4587   } else {
4588     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4589   }
4590 
4591   /* print some info if requested */
4592   if (pcbddc->dbg_flag) {
4593     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4594     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4595     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4596     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4597     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4598     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);
4599     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4600   }
4601 
4602   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4603   if (!sub_schurs || !sub_schurs->reuse_solver) {
4604     IS       is_aux1,is_aux2;
4605     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4606 
4607     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4608     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4609     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4610     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4611     for (i=0; i<n_D; i++) {
4612       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4613     }
4614     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4615     for (i=0, j=0; i<n_R; i++) {
4616       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4617         aux_array1[j++] = i;
4618       }
4619     }
4620     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4621     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4622     for (i=0, j=0; i<n_B; i++) {
4623       if (!PetscBTLookup(bitmask,is_indices[i])) {
4624         aux_array2[j++] = i;
4625       }
4626     }
4627     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4628     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4629     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4630     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4631     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4632 
4633     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4634       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4635       for (i=0, j=0; i<n_R; i++) {
4636         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4637           aux_array1[j++] = i;
4638         }
4639       }
4640       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4641       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4642       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4643     }
4644     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4645     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4646   } else {
4647     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4648     IS                 tis;
4649     PetscInt           schur_size;
4650 
4651     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4652     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4653     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4654     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4655     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4656       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4657       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4658       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4659     }
4660   }
4661   PetscFunctionReturn(0);
4662 }
4663 
4664 
4665 #undef __FUNCT__
4666 #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
4667 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4668 {
4669   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4670   PC_IS          *pcis = (PC_IS*)pc->data;
4671   PC             pc_temp;
4672   Mat            A_RR;
4673   MatReuse       reuse;
4674   PetscScalar    m_one = -1.0;
4675   PetscReal      value;
4676   PetscInt       n_D,n_R;
4677   PetscBool      check_corr[2],issbaij;
4678   PetscErrorCode ierr;
4679   /* prefixes stuff */
4680   char           dir_prefix[256],neu_prefix[256],str_level[16];
4681   size_t         len;
4682 
4683   PetscFunctionBegin;
4684 
4685   /* compute prefixes */
4686   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4687   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4688   if (!pcbddc->current_level) {
4689     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4690     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4691     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4692     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4693   } else {
4694     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4695     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4696     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4697     len -= 15; /* remove "pc_bddc_coarse_" */
4698     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4699     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4700     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4701     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4702     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4703     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4704     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4705     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4706   }
4707 
4708   /* DIRICHLET PROBLEM */
4709   if (dirichlet) {
4710     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4711     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4712       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4713       if (pcbddc->dbg_flag) {
4714         Mat    A_IIn;
4715 
4716         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4717         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4718         pcis->A_II = A_IIn;
4719       }
4720     }
4721     if (pcbddc->local_mat->symmetric_set) {
4722       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4723     }
4724     /* Matrix for Dirichlet problem is pcis->A_II */
4725     n_D = pcis->n - pcis->n_B;
4726     if (!pcbddc->ksp_D) { /* create object if not yet build */
4727       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4728       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4729       /* default */
4730       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4731       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4732       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4733       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4734       if (issbaij) {
4735         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4736       } else {
4737         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4738       }
4739       /* Allow user's customization */
4740       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4741       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4742     }
4743     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4744     if (sub_schurs && sub_schurs->reuse_solver) {
4745       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4746 
4747       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4748     }
4749     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4750     if (!n_D) {
4751       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4752       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4753     }
4754     /* Set Up KSP for Dirichlet problem of BDDC */
4755     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4756     /* set ksp_D into pcis data */
4757     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4758     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4759     pcis->ksp_D = pcbddc->ksp_D;
4760   }
4761 
4762   /* NEUMANN PROBLEM */
4763   A_RR = 0;
4764   if (neumann) {
4765     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4766     PetscInt        ibs,mbs;
4767     PetscBool       issbaij;
4768     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4769     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4770     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4771     if (pcbddc->ksp_R) { /* already created ksp */
4772       PetscInt nn_R;
4773       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4774       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4775       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4776       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4777         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4778         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4779         reuse = MAT_INITIAL_MATRIX;
4780       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4781         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4782           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4783           reuse = MAT_INITIAL_MATRIX;
4784         } else { /* safe to reuse the matrix */
4785           reuse = MAT_REUSE_MATRIX;
4786         }
4787       }
4788       /* last check */
4789       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4790         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4791         reuse = MAT_INITIAL_MATRIX;
4792       }
4793     } else { /* first time, so we need to create the matrix */
4794       reuse = MAT_INITIAL_MATRIX;
4795     }
4796     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4797     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4798     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4799     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4800     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4801       if (matis->A == pcbddc->local_mat) {
4802         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4803         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4804       } else {
4805         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4806       }
4807     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4808       if (matis->A == pcbddc->local_mat) {
4809         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4810         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4811       } else {
4812         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4813       }
4814     }
4815     /* extract A_RR */
4816     if (sub_schurs && sub_schurs->reuse_solver) {
4817       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4818 
4819       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4820         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4821         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4822           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4823         } else {
4824           ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4825         }
4826       } else {
4827         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4828         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4829         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4830       }
4831     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4832       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4833     }
4834     if (pcbddc->local_mat->symmetric_set) {
4835       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4836     }
4837     if (!pcbddc->ksp_R) { /* create object if not present */
4838       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4839       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4840       /* default */
4841       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4842       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4843       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4844       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4845       if (issbaij) {
4846         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4847       } else {
4848         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4849       }
4850       /* Allow user's customization */
4851       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4852       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4853     }
4854     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4855     if (!n_R) {
4856       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4857       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4858     }
4859     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4860     /* Reuse solver if it is present */
4861     if (sub_schurs && sub_schurs->reuse_solver) {
4862       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4863 
4864       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4865     }
4866     /* Set Up KSP for Neumann problem of BDDC */
4867     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4868   }
4869 
4870   if (pcbddc->dbg_flag) {
4871     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4872     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4873     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4874   }
4875 
4876   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
4877   check_corr[0] = check_corr[1] = PETSC_FALSE;
4878   if (pcbddc->NullSpace_corr[0]) {
4879     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
4880   }
4881   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
4882     check_corr[0] = PETSC_TRUE;
4883     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
4884   }
4885   if (neumann && pcbddc->NullSpace_corr[2]) {
4886     check_corr[1] = PETSC_TRUE;
4887     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
4888   }
4889 
4890   /* check Dirichlet and Neumann solvers */
4891   if (pcbddc->dbg_flag) {
4892     if (dirichlet) { /* Dirichlet */
4893       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
4894       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
4895       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
4896       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
4897       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
4898       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);
4899       if (check_corr[0]) {
4900         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
4901       }
4902       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4903     }
4904     if (neumann) { /* Neumann */
4905       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
4906       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4907       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
4908       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
4909       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
4910       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);
4911       if (check_corr[1]) {
4912         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
4913       }
4914       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4915     }
4916   }
4917   /* free Neumann problem's matrix */
4918   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4919   PetscFunctionReturn(0);
4920 }
4921 
4922 #undef __FUNCT__
4923 #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
4924 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
4925 {
4926   PetscErrorCode  ierr;
4927   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4928   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4929   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
4930 
4931   PetscFunctionBegin;
4932   if (!reuse_solver) {
4933     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
4934   }
4935   if (!pcbddc->switch_static) {
4936     if (applytranspose && pcbddc->local_auxmat1) {
4937       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4938       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4939     }
4940     if (!reuse_solver) {
4941       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4942       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4943     } else {
4944       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4945 
4946       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4947       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4948     }
4949   } else {
4950     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4951     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4952     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4953     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4954     if (applytranspose && pcbddc->local_auxmat1) {
4955       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
4956       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4957       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4958       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4959     }
4960   }
4961   if (!reuse_solver || pcbddc->switch_static) {
4962     if (applytranspose) {
4963       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4964     } else {
4965       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4966     }
4967   } else {
4968     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4969 
4970     if (applytranspose) {
4971       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4972     } else {
4973       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4974     }
4975   }
4976   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
4977   if (!pcbddc->switch_static) {
4978     if (!reuse_solver) {
4979       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4980       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4981     } else {
4982       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4983 
4984       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4985       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4986     }
4987     if (!applytranspose && pcbddc->local_auxmat1) {
4988       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4989       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4990     }
4991   } else {
4992     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4993     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4994     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4995     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4996     if (!applytranspose && pcbddc->local_auxmat1) {
4997       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4998       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4999     }
5000     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5001     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5002     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5003     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5004   }
5005   PetscFunctionReturn(0);
5006 }
5007 
5008 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5009 #undef __FUNCT__
5010 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
5011 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5012 {
5013   PetscErrorCode ierr;
5014   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5015   PC_IS*            pcis = (PC_IS*)  (pc->data);
5016   const PetscScalar zero = 0.0;
5017 
5018   PetscFunctionBegin;
5019   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5020   if (!pcbddc->benign_apply_coarse_only) {
5021     if (applytranspose) {
5022       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5023       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5024     } else {
5025       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5026       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5027     }
5028   } else {
5029     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5030   }
5031 
5032   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5033   if (pcbddc->benign_n) {
5034     PetscScalar *array;
5035     PetscInt    j;
5036 
5037     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5038     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5039     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5040   }
5041 
5042   /* start communications from local primal nodes to rhs of coarse solver */
5043   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5044   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5045   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5046 
5047   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5048   if (pcbddc->coarse_ksp) {
5049     Mat          coarse_mat;
5050     Vec          rhs,sol;
5051     MatNullSpace nullsp;
5052     PetscBool    isbddc = PETSC_FALSE;
5053 
5054     if (pcbddc->benign_have_null) {
5055       PC        coarse_pc;
5056 
5057       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5058       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5059       /* we need to propagate to coarser levels the need for a possible benign correction */
5060       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5061         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5062         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5063         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5064       }
5065     }
5066     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5067     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5068     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5069     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5070     if (nullsp) {
5071       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5072     }
5073     if (applytranspose) {
5074       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5075       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5076     } else {
5077       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5078         PC        coarse_pc;
5079 
5080         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5081         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5082         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5083         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5084       } else {
5085         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5086       }
5087     }
5088     /* we don't need the benign correction at coarser levels anymore */
5089     if (pcbddc->benign_have_null && isbddc) {
5090       PC        coarse_pc;
5091       PC_BDDC*  coarsepcbddc;
5092 
5093       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5094       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5095       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5096       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5097     }
5098     if (nullsp) {
5099       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5100     }
5101   }
5102 
5103   /* Local solution on R nodes */
5104   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5105     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5106   }
5107   /* communications from coarse sol to local primal nodes */
5108   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5109   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5110 
5111   /* Sum contributions from the two levels */
5112   if (!pcbddc->benign_apply_coarse_only) {
5113     if (applytranspose) {
5114       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5115       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5116     } else {
5117       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5118       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5119     }
5120     /* store p0 */
5121     if (pcbddc->benign_n) {
5122       PetscScalar *array;
5123       PetscInt    j;
5124 
5125       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5126       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5127       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5128     }
5129   } else { /* expand the coarse solution */
5130     if (applytranspose) {
5131       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5132     } else {
5133       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5134     }
5135   }
5136   PetscFunctionReturn(0);
5137 }
5138 
5139 #undef __FUNCT__
5140 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
5141 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5142 {
5143   PetscErrorCode ierr;
5144   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5145   PetscScalar    *array;
5146   Vec            from,to;
5147 
5148   PetscFunctionBegin;
5149   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5150     from = pcbddc->coarse_vec;
5151     to = pcbddc->vec1_P;
5152     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5153       Vec tvec;
5154 
5155       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5156       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5157       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5158       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5159       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5160       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5161     }
5162   } else { /* from local to global -> put data in coarse right hand side */
5163     from = pcbddc->vec1_P;
5164     to = pcbddc->coarse_vec;
5165   }
5166   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5167   PetscFunctionReturn(0);
5168 }
5169 
5170 #undef __FUNCT__
5171 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
5172 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5173 {
5174   PetscErrorCode ierr;
5175   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5176   PetscScalar    *array;
5177   Vec            from,to;
5178 
5179   PetscFunctionBegin;
5180   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5181     from = pcbddc->coarse_vec;
5182     to = pcbddc->vec1_P;
5183   } else { /* from local to global -> put data in coarse right hand side */
5184     from = pcbddc->vec1_P;
5185     to = pcbddc->coarse_vec;
5186   }
5187   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5188   if (smode == SCATTER_FORWARD) {
5189     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5190       Vec tvec;
5191 
5192       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5193       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5194       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5195       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5196     }
5197   } else {
5198     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5199      ierr = VecResetArray(from);CHKERRQ(ierr);
5200     }
5201   }
5202   PetscFunctionReturn(0);
5203 }
5204 
5205 /* uncomment for testing purposes */
5206 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5207 #undef __FUNCT__
5208 #define __FUNCT__ "PCBDDCConstraintsSetUp"
5209 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5210 {
5211   PetscErrorCode    ierr;
5212   PC_IS*            pcis = (PC_IS*)(pc->data);
5213   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5214   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5215   /* one and zero */
5216   PetscScalar       one=1.0,zero=0.0;
5217   /* space to store constraints and their local indices */
5218   PetscScalar       *constraints_data;
5219   PetscInt          *constraints_idxs,*constraints_idxs_B;
5220   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5221   PetscInt          *constraints_n;
5222   /* iterators */
5223   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5224   /* BLAS integers */
5225   PetscBLASInt      lwork,lierr;
5226   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5227   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5228   /* reuse */
5229   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5230   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5231   /* change of basis */
5232   PetscBool         qr_needed;
5233   PetscBT           change_basis,qr_needed_idx;
5234   /* auxiliary stuff */
5235   PetscInt          *nnz,*is_indices;
5236   PetscInt          ncc;
5237   /* some quantities */
5238   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5239   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5240 
5241   PetscFunctionBegin;
5242   /* Destroy Mat objects computed previously */
5243   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5244   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5245   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5246   /* save info on constraints from previous setup (if any) */
5247   olocal_primal_size = pcbddc->local_primal_size;
5248   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5249   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5250   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5251   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5252   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5253   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5254 
5255   if (!pcbddc->adaptive_selection) {
5256     IS           ISForVertices,*ISForFaces,*ISForEdges;
5257     MatNullSpace nearnullsp;
5258     const Vec    *nearnullvecs;
5259     Vec          *localnearnullsp;
5260     PetscScalar  *array;
5261     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5262     PetscBool    nnsp_has_cnst;
5263     /* LAPACK working arrays for SVD or POD */
5264     PetscBool    skip_lapack,boolforchange;
5265     PetscScalar  *work;
5266     PetscReal    *singular_vals;
5267 #if defined(PETSC_USE_COMPLEX)
5268     PetscReal    *rwork;
5269 #endif
5270 #if defined(PETSC_MISSING_LAPACK_GESVD)
5271     PetscScalar  *temp_basis,*correlation_mat;
5272 #else
5273     PetscBLASInt dummy_int=1;
5274     PetscScalar  dummy_scalar=1.;
5275 #endif
5276 
5277     /* Get index sets for faces, edges and vertices from graph */
5278     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5279     /* print some info */
5280     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5281       PetscInt nv;
5282 
5283       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5284       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5285       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5286       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5287       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5288       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5289       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5290       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5291       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5292     }
5293 
5294     /* free unneeded index sets */
5295     if (!pcbddc->use_vertices) {
5296       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5297     }
5298     if (!pcbddc->use_edges) {
5299       for (i=0;i<n_ISForEdges;i++) {
5300         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5301       }
5302       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5303       n_ISForEdges = 0;
5304     }
5305     if (!pcbddc->use_faces) {
5306       for (i=0;i<n_ISForFaces;i++) {
5307         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5308       }
5309       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5310       n_ISForFaces = 0;
5311     }
5312 
5313     /* check if near null space is attached to global mat */
5314     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5315     if (nearnullsp) {
5316       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5317       /* remove any stored info */
5318       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5319       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5320       /* store information for BDDC solver reuse */
5321       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5322       pcbddc->onearnullspace = nearnullsp;
5323       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5324       for (i=0;i<nnsp_size;i++) {
5325         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5326       }
5327     } else { /* if near null space is not provided BDDC uses constants by default */
5328       nnsp_size = 0;
5329       nnsp_has_cnst = PETSC_TRUE;
5330     }
5331     /* get max number of constraints on a single cc */
5332     max_constraints = nnsp_size;
5333     if (nnsp_has_cnst) max_constraints++;
5334 
5335     /*
5336          Evaluate maximum storage size needed by the procedure
5337          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5338          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5339          There can be multiple constraints per connected component
5340                                                                                                                                                            */
5341     n_vertices = 0;
5342     if (ISForVertices) {
5343       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5344     }
5345     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5346     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5347 
5348     total_counts = n_ISForFaces+n_ISForEdges;
5349     total_counts *= max_constraints;
5350     total_counts += n_vertices;
5351     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5352 
5353     total_counts = 0;
5354     max_size_of_constraint = 0;
5355     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5356       IS used_is;
5357       if (i<n_ISForEdges) {
5358         used_is = ISForEdges[i];
5359       } else {
5360         used_is = ISForFaces[i-n_ISForEdges];
5361       }
5362       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5363       total_counts += j;
5364       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5365     }
5366     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);
5367 
5368     /* get local part of global near null space vectors */
5369     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5370     for (k=0;k<nnsp_size;k++) {
5371       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5372       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5373       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5374     }
5375 
5376     /* whether or not to skip lapack calls */
5377     skip_lapack = PETSC_TRUE;
5378     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5379 
5380     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5381     if (!skip_lapack) {
5382       PetscScalar temp_work;
5383 
5384 #if defined(PETSC_MISSING_LAPACK_GESVD)
5385       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5386       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5387       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5388       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5389 #if defined(PETSC_USE_COMPLEX)
5390       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5391 #endif
5392       /* now we evaluate the optimal workspace using query with lwork=-1 */
5393       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5394       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5395       lwork = -1;
5396       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5397 #if !defined(PETSC_USE_COMPLEX)
5398       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5399 #else
5400       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5401 #endif
5402       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5403       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5404 #else /* on missing GESVD */
5405       /* SVD */
5406       PetscInt max_n,min_n;
5407       max_n = max_size_of_constraint;
5408       min_n = max_constraints;
5409       if (max_size_of_constraint < max_constraints) {
5410         min_n = max_size_of_constraint;
5411         max_n = max_constraints;
5412       }
5413       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5414 #if defined(PETSC_USE_COMPLEX)
5415       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5416 #endif
5417       /* now we evaluate the optimal workspace using query with lwork=-1 */
5418       lwork = -1;
5419       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5420       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5421       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5422       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5423 #if !defined(PETSC_USE_COMPLEX)
5424       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));
5425 #else
5426       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));
5427 #endif
5428       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5429       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5430 #endif /* on missing GESVD */
5431       /* Allocate optimal workspace */
5432       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5433       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5434     }
5435     /* Now we can loop on constraining sets */
5436     total_counts = 0;
5437     constraints_idxs_ptr[0] = 0;
5438     constraints_data_ptr[0] = 0;
5439     /* vertices */
5440     if (n_vertices) {
5441       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5442       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5443       for (i=0;i<n_vertices;i++) {
5444         constraints_n[total_counts] = 1;
5445         constraints_data[total_counts] = 1.0;
5446         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5447         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5448         total_counts++;
5449       }
5450       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5451       n_vertices = total_counts;
5452     }
5453 
5454     /* edges and faces */
5455     total_counts_cc = total_counts;
5456     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5457       IS        used_is;
5458       PetscBool idxs_copied = PETSC_FALSE;
5459 
5460       if (ncc<n_ISForEdges) {
5461         used_is = ISForEdges[ncc];
5462         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5463       } else {
5464         used_is = ISForFaces[ncc-n_ISForEdges];
5465         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5466       }
5467       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5468 
5469       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5470       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5471       /* change of basis should not be performed on local periodic nodes */
5472       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5473       if (nnsp_has_cnst) {
5474         PetscScalar quad_value;
5475 
5476         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5477         idxs_copied = PETSC_TRUE;
5478 
5479         if (!pcbddc->use_nnsp_true) {
5480           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5481         } else {
5482           quad_value = 1.0;
5483         }
5484         for (j=0;j<size_of_constraint;j++) {
5485           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5486         }
5487         temp_constraints++;
5488         total_counts++;
5489       }
5490       for (k=0;k<nnsp_size;k++) {
5491         PetscReal real_value;
5492         PetscScalar *ptr_to_data;
5493 
5494         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5495         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5496         for (j=0;j<size_of_constraint;j++) {
5497           ptr_to_data[j] = array[is_indices[j]];
5498         }
5499         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5500         /* check if array is null on the connected component */
5501         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5502         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5503         if (real_value > 0.0) { /* keep indices and values */
5504           temp_constraints++;
5505           total_counts++;
5506           if (!idxs_copied) {
5507             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5508             idxs_copied = PETSC_TRUE;
5509           }
5510         }
5511       }
5512       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5513       valid_constraints = temp_constraints;
5514       if (!pcbddc->use_nnsp_true && temp_constraints) {
5515         if (temp_constraints == 1) { /* just normalize the constraint */
5516           PetscScalar norm,*ptr_to_data;
5517 
5518           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5519           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5520           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5521           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5522           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5523         } else { /* perform SVD */
5524           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5525           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5526 
5527 #if defined(PETSC_MISSING_LAPACK_GESVD)
5528           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5529              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5530              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5531                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5532                 from that computed using LAPACKgesvd
5533              -> This is due to a different computation of eigenvectors in LAPACKheev
5534              -> The quality of the POD-computed basis will be the same */
5535           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5536           /* Store upper triangular part of correlation matrix */
5537           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5538           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5539           for (j=0;j<temp_constraints;j++) {
5540             for (k=0;k<j+1;k++) {
5541               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));
5542             }
5543           }
5544           /* compute eigenvalues and eigenvectors of correlation matrix */
5545           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5546           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5547 #if !defined(PETSC_USE_COMPLEX)
5548           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5549 #else
5550           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5551 #endif
5552           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5553           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5554           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5555           j = 0;
5556           while (j < temp_constraints && singular_vals[j] < tol) j++;
5557           total_counts = total_counts-j;
5558           valid_constraints = temp_constraints-j;
5559           /* scale and copy POD basis into used quadrature memory */
5560           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5561           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5562           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5563           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5564           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5565           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5566           if (j<temp_constraints) {
5567             PetscInt ii;
5568             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5569             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5570             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));
5571             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5572             for (k=0;k<temp_constraints-j;k++) {
5573               for (ii=0;ii<size_of_constraint;ii++) {
5574                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5575               }
5576             }
5577           }
5578 #else  /* on missing GESVD */
5579           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5580           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5581           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5582           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5583 #if !defined(PETSC_USE_COMPLEX)
5584           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));
5585 #else
5586           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));
5587 #endif
5588           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5589           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5590           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5591           k = temp_constraints;
5592           if (k > size_of_constraint) k = size_of_constraint;
5593           j = 0;
5594           while (j < k && singular_vals[k-j-1] < tol) j++;
5595           valid_constraints = k-j;
5596           total_counts = total_counts-temp_constraints+valid_constraints;
5597 #endif /* on missing GESVD */
5598         }
5599       }
5600       /* update pointers information */
5601       if (valid_constraints) {
5602         constraints_n[total_counts_cc] = valid_constraints;
5603         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5604         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5605         /* set change_of_basis flag */
5606         if (boolforchange) {
5607           PetscBTSet(change_basis,total_counts_cc);
5608         }
5609         total_counts_cc++;
5610       }
5611     }
5612     /* free workspace */
5613     if (!skip_lapack) {
5614       ierr = PetscFree(work);CHKERRQ(ierr);
5615 #if defined(PETSC_USE_COMPLEX)
5616       ierr = PetscFree(rwork);CHKERRQ(ierr);
5617 #endif
5618       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5619 #if defined(PETSC_MISSING_LAPACK_GESVD)
5620       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5621       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5622 #endif
5623     }
5624     for (k=0;k<nnsp_size;k++) {
5625       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5626     }
5627     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5628     /* free index sets of faces, edges and vertices */
5629     for (i=0;i<n_ISForFaces;i++) {
5630       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5631     }
5632     if (n_ISForFaces) {
5633       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5634     }
5635     for (i=0;i<n_ISForEdges;i++) {
5636       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5637     }
5638     if (n_ISForEdges) {
5639       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5640     }
5641     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5642   } else {
5643     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5644 
5645     total_counts = 0;
5646     n_vertices = 0;
5647     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5648       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5649     }
5650     max_constraints = 0;
5651     total_counts_cc = 0;
5652     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5653       total_counts += pcbddc->adaptive_constraints_n[i];
5654       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5655       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5656     }
5657     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5658     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5659     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5660     constraints_data = pcbddc->adaptive_constraints_data;
5661     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5662     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5663     total_counts_cc = 0;
5664     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5665       if (pcbddc->adaptive_constraints_n[i]) {
5666         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5667       }
5668     }
5669 #if 0
5670     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5671     for (i=0;i<total_counts_cc;i++) {
5672       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5673       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5674       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5675         printf(" %d",constraints_idxs[j]);
5676       }
5677       printf("\n");
5678       printf("number of cc: %d\n",constraints_n[i]);
5679     }
5680     for (i=0;i<n_vertices;i++) {
5681       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5682     }
5683     for (i=0;i<sub_schurs->n_subs;i++) {
5684       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]);
5685     }
5686 #endif
5687 
5688     max_size_of_constraint = 0;
5689     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]);
5690     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5691     /* Change of basis */
5692     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5693     if (pcbddc->use_change_of_basis) {
5694       for (i=0;i<sub_schurs->n_subs;i++) {
5695         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5696           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5697         }
5698       }
5699     }
5700   }
5701   pcbddc->local_primal_size = total_counts;
5702   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5703 
5704   /* map constraints_idxs in boundary numbering */
5705   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5706   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);
5707 
5708   /* Create constraint matrix */
5709   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5710   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5711   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5712 
5713   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5714   /* determine if a QR strategy is needed for change of basis */
5715   qr_needed = PETSC_FALSE;
5716   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5717   total_primal_vertices=0;
5718   pcbddc->local_primal_size_cc = 0;
5719   for (i=0;i<total_counts_cc;i++) {
5720     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5721     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5722       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5723       pcbddc->local_primal_size_cc += 1;
5724     } else if (PetscBTLookup(change_basis,i)) {
5725       for (k=0;k<constraints_n[i];k++) {
5726         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5727       }
5728       pcbddc->local_primal_size_cc += constraints_n[i];
5729       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5730         PetscBTSet(qr_needed_idx,i);
5731         qr_needed = PETSC_TRUE;
5732       }
5733     } else {
5734       pcbddc->local_primal_size_cc += 1;
5735     }
5736   }
5737   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5738   pcbddc->n_vertices = total_primal_vertices;
5739   /* permute indices in order to have a sorted set of vertices */
5740   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5741   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);
5742   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5743   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5744 
5745   /* nonzero structure of constraint matrix */
5746   /* and get reference dof for local constraints */
5747   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5748   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5749 
5750   j = total_primal_vertices;
5751   total_counts = total_primal_vertices;
5752   cum = total_primal_vertices;
5753   for (i=n_vertices;i<total_counts_cc;i++) {
5754     if (!PetscBTLookup(change_basis,i)) {
5755       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5756       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5757       cum++;
5758       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5759       for (k=0;k<constraints_n[i];k++) {
5760         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5761         nnz[j+k] = size_of_constraint;
5762       }
5763       j += constraints_n[i];
5764     }
5765   }
5766   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5767   ierr = PetscFree(nnz);CHKERRQ(ierr);
5768 
5769   /* set values in constraint matrix */
5770   for (i=0;i<total_primal_vertices;i++) {
5771     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5772   }
5773   total_counts = total_primal_vertices;
5774   for (i=n_vertices;i<total_counts_cc;i++) {
5775     if (!PetscBTLookup(change_basis,i)) {
5776       PetscInt *cols;
5777 
5778       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5779       cols = constraints_idxs+constraints_idxs_ptr[i];
5780       for (k=0;k<constraints_n[i];k++) {
5781         PetscInt    row = total_counts+k;
5782         PetscScalar *vals;
5783 
5784         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5785         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5786       }
5787       total_counts += constraints_n[i];
5788     }
5789   }
5790   /* assembling */
5791   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5792   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5793 
5794   /*
5795   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5796   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5797   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5798   */
5799   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5800   if (pcbddc->use_change_of_basis) {
5801     /* dual and primal dofs on a single cc */
5802     PetscInt     dual_dofs,primal_dofs;
5803     /* working stuff for GEQRF */
5804     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5805     PetscBLASInt lqr_work;
5806     /* working stuff for UNGQR */
5807     PetscScalar  *gqr_work,lgqr_work_t;
5808     PetscBLASInt lgqr_work;
5809     /* working stuff for TRTRS */
5810     PetscScalar  *trs_rhs;
5811     PetscBLASInt Blas_NRHS;
5812     /* pointers for values insertion into change of basis matrix */
5813     PetscInt     *start_rows,*start_cols;
5814     PetscScalar  *start_vals;
5815     /* working stuff for values insertion */
5816     PetscBT      is_primal;
5817     PetscInt     *aux_primal_numbering_B;
5818     /* matrix sizes */
5819     PetscInt     global_size,local_size;
5820     /* temporary change of basis */
5821     Mat          localChangeOfBasisMatrix;
5822     /* extra space for debugging */
5823     PetscScalar  *dbg_work;
5824 
5825     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5826     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5827     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5828     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5829     /* nonzeros for local mat */
5830     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5831     if (!pcbddc->benign_change || pcbddc->fake_change) {
5832       for (i=0;i<pcis->n;i++) nnz[i]=1;
5833     } else {
5834       const PetscInt *ii;
5835       PetscInt       n;
5836       PetscBool      flg_row;
5837       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5838       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5839       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5840     }
5841     for (i=n_vertices;i<total_counts_cc;i++) {
5842       if (PetscBTLookup(change_basis,i)) {
5843         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5844         if (PetscBTLookup(qr_needed_idx,i)) {
5845           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5846         } else {
5847           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5848           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5849         }
5850       }
5851     }
5852     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5853     ierr = PetscFree(nnz);CHKERRQ(ierr);
5854     /* Set interior change in the matrix */
5855     if (!pcbddc->benign_change || pcbddc->fake_change) {
5856       for (i=0;i<pcis->n;i++) {
5857         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5858       }
5859     } else {
5860       const PetscInt *ii,*jj;
5861       PetscScalar    *aa;
5862       PetscInt       n;
5863       PetscBool      flg_row;
5864       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5865       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5866       for (i=0;i<n;i++) {
5867         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5868       }
5869       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5870       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5871     }
5872 
5873     if (pcbddc->dbg_flag) {
5874       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5875       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5876     }
5877 
5878 
5879     /* Now we loop on the constraints which need a change of basis */
5880     /*
5881        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
5882        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
5883 
5884        Basic blocks of change of basis matrix T computed by
5885 
5886           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
5887 
5888             | 1        0   ...        0         s_1/S |
5889             | 0        1   ...        0         s_2/S |
5890             |              ...                        |
5891             | 0        ...            1     s_{n-1}/S |
5892             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
5893 
5894             with S = \sum_{i=1}^n s_i^2
5895             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
5896                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
5897 
5898           - QR decomposition of constraints otherwise
5899     */
5900     if (qr_needed) {
5901       /* space to store Q */
5902       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
5903       /* array to store scaling factors for reflectors */
5904       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
5905       /* first we issue queries for optimal work */
5906       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5907       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5908       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5909       lqr_work = -1;
5910       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
5911       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
5912       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
5913       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
5914       lgqr_work = -1;
5915       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5916       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
5917       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
5918       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5919       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
5920       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
5921       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
5922       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
5923       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
5924       /* array to store rhs and solution of triangular solver */
5925       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
5926       /* allocating workspace for check */
5927       if (pcbddc->dbg_flag) {
5928         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
5929       }
5930     }
5931     /* array to store whether a node is primal or not */
5932     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
5933     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
5934     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
5935     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);
5936     for (i=0;i<total_primal_vertices;i++) {
5937       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
5938     }
5939     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
5940 
5941     /* loop on constraints and see whether or not they need a change of basis and compute it */
5942     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
5943       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
5944       if (PetscBTLookup(change_basis,total_counts)) {
5945         /* get constraint info */
5946         primal_dofs = constraints_n[total_counts];
5947         dual_dofs = size_of_constraint-primal_dofs;
5948 
5949         if (pcbddc->dbg_flag) {
5950           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);
5951         }
5952 
5953         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
5954 
5955           /* copy quadrature constraints for change of basis check */
5956           if (pcbddc->dbg_flag) {
5957             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5958           }
5959           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
5960           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5961 
5962           /* compute QR decomposition of constraints */
5963           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5964           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5965           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5966           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5967           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
5968           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
5969           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5970 
5971           /* explictly compute R^-T */
5972           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
5973           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
5974           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5975           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
5976           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5977           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5978           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5979           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
5980           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
5981           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5982 
5983           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
5984           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5985           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5986           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5987           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5988           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5989           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
5990           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
5991           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5992 
5993           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
5994              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
5995              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
5996           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5997           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5998           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5999           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6000           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6001           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6002           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6003           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));
6004           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6005           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6006 
6007           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6008           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6009           /* insert cols for primal dofs */
6010           for (j=0;j<primal_dofs;j++) {
6011             start_vals = &qr_basis[j*size_of_constraint];
6012             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6013             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6014           }
6015           /* insert cols for dual dofs */
6016           for (j=0,k=0;j<dual_dofs;k++) {
6017             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6018               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6019               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6020               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6021               j++;
6022             }
6023           }
6024 
6025           /* check change of basis */
6026           if (pcbddc->dbg_flag) {
6027             PetscInt   ii,jj;
6028             PetscBool valid_qr=PETSC_TRUE;
6029             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6030             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6031             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6032             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6033             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6034             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6035             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6036             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));
6037             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6038             for (jj=0;jj<size_of_constraint;jj++) {
6039               for (ii=0;ii<primal_dofs;ii++) {
6040                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6041                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
6042               }
6043             }
6044             if (!valid_qr) {
6045               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6046               for (jj=0;jj<size_of_constraint;jj++) {
6047                 for (ii=0;ii<primal_dofs;ii++) {
6048                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6049                     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]));
6050                   }
6051                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
6052                     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]));
6053                   }
6054                 }
6055               }
6056             } else {
6057               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6058             }
6059           }
6060         } else { /* simple transformation block */
6061           PetscInt    row,col;
6062           PetscScalar val,norm;
6063 
6064           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6065           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6066           for (j=0;j<size_of_constraint;j++) {
6067             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6068             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6069             if (!PetscBTLookup(is_primal,row_B)) {
6070               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6071               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6072               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6073             } else {
6074               for (k=0;k<size_of_constraint;k++) {
6075                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6076                 if (row != col) {
6077                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6078                 } else {
6079                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6080                 }
6081                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6082               }
6083             }
6084           }
6085           if (pcbddc->dbg_flag) {
6086             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6087           }
6088         }
6089       } else {
6090         if (pcbddc->dbg_flag) {
6091           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6092         }
6093       }
6094     }
6095 
6096     /* free workspace */
6097     if (qr_needed) {
6098       if (pcbddc->dbg_flag) {
6099         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6100       }
6101       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6102       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6103       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6104       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6105       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6106     }
6107     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6108     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6109     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6110 
6111     /* assembling of global change of variable */
6112     if (!pcbddc->fake_change) {
6113       Mat      tmat;
6114       PetscInt bs;
6115 
6116       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6117       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6118       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6119       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6120       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6121       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6122       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6123       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6124       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6125       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6126       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6127       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6128       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6129       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6130       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6131       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6132       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6133       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6134 
6135       /* check */
6136       if (pcbddc->dbg_flag) {
6137         PetscReal error;
6138         Vec       x,x_change;
6139 
6140         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6141         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6142         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6143         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6144         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6145         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6146         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6147         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6148         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6149         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6150         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6151         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6152         if (error > PETSC_SMALL) {
6153           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6154         }
6155         ierr = VecDestroy(&x);CHKERRQ(ierr);
6156         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6157       }
6158       /* adapt sub_schurs computed (if any) */
6159       if (pcbddc->use_deluxe_scaling) {
6160         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6161 
6162         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");CHKERRQ(ierr);
6163         if (sub_schurs && sub_schurs->S_Ej_all) {
6164           Mat                    S_new,tmat;
6165           IS                     is_all_N,is_V_Sall = NULL;
6166 
6167           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6168           ierr = MatGetSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6169           if (pcbddc->deluxe_zerorows) {
6170             ISLocalToGlobalMapping NtoSall;
6171             IS                     is_V;
6172             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6173             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6174             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6175             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6176             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6177           }
6178           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6179           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6180           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6181           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6182           if (pcbddc->deluxe_zerorows) {
6183             const PetscScalar *array;
6184             const PetscInt    *idxs_V,*idxs_all;
6185             PetscInt          i,n_V;
6186 
6187             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6188             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6189             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6190             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6191             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6192             for (i=0;i<n_V;i++) {
6193               PetscScalar val;
6194               PetscInt    idx;
6195 
6196               idx = idxs_V[i];
6197               val = array[idxs_all[idxs_V[i]]];
6198               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6199             }
6200             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6201             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6202             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6203             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6204             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6205           }
6206           sub_schurs->S_Ej_all = S_new;
6207           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6208           if (sub_schurs->sum_S_Ej_all) {
6209             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6210             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6211             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6212             if (pcbddc->deluxe_zerorows) {
6213               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6214             }
6215             sub_schurs->sum_S_Ej_all = S_new;
6216             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6217           }
6218           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6219           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6220         }
6221         /* destroy any change of basis context in sub_schurs */
6222         if (sub_schurs && sub_schurs->change) {
6223           PetscInt i;
6224 
6225           for (i=0;i<sub_schurs->n_subs;i++) {
6226             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6227           }
6228           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6229         }
6230       }
6231       if (pcbddc->switch_static) { /* need to save the local change */
6232         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6233       } else {
6234         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6235       }
6236       /* determine if any process has changed the pressures locally */
6237       pcbddc->change_interior = pcbddc->benign_have_null;
6238     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6239       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6240       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6241       pcbddc->use_qr_single = qr_needed;
6242     }
6243   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6244     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6245       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6246       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6247     } else {
6248       Mat benign_global = NULL;
6249       if (pcbddc->benign_have_null) {
6250         Mat tmat;
6251 
6252         pcbddc->change_interior = PETSC_TRUE;
6253         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6254         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6255         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6256         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6257         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6258         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6259         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6260         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6261         if (pcbddc->benign_change) {
6262           Mat M;
6263 
6264           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6265           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6266           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6267           ierr = MatDestroy(&M);CHKERRQ(ierr);
6268         } else {
6269           Mat         eye;
6270           PetscScalar *array;
6271 
6272           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6273           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6274           for (i=0;i<pcis->n;i++) {
6275             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6276           }
6277           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6278           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6279           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6280           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6281           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6282         }
6283         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6284         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6285       }
6286       if (pcbddc->user_ChangeOfBasisMatrix) {
6287         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6288         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6289       } else if (pcbddc->benign_have_null) {
6290         pcbddc->ChangeOfBasisMatrix = benign_global;
6291       }
6292     }
6293     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6294       IS             is_global;
6295       const PetscInt *gidxs;
6296 
6297       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6298       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6299       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6300       ierr = MatGetSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6301       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6302     }
6303   }
6304   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6305     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6306   }
6307 
6308   if (!pcbddc->fake_change) {
6309     /* add pressure dofs to set of primal nodes for numbering purposes */
6310     for (i=0;i<pcbddc->benign_n;i++) {
6311       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6312       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6313       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6314       pcbddc->local_primal_size_cc++;
6315       pcbddc->local_primal_size++;
6316     }
6317 
6318     /* check if a new primal space has been introduced (also take into account benign trick) */
6319     pcbddc->new_primal_space_local = PETSC_TRUE;
6320     if (olocal_primal_size == pcbddc->local_primal_size) {
6321       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6322       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6323       if (!pcbddc->new_primal_space_local) {
6324         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6325         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6326       }
6327     }
6328     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6329     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6330   }
6331   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6332 
6333   /* flush dbg viewer */
6334   if (pcbddc->dbg_flag) {
6335     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6336   }
6337 
6338   /* free workspace */
6339   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6340   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6341   if (!pcbddc->adaptive_selection) {
6342     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6343     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6344   } else {
6345     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6346                       pcbddc->adaptive_constraints_idxs_ptr,
6347                       pcbddc->adaptive_constraints_data_ptr,
6348                       pcbddc->adaptive_constraints_idxs,
6349                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6350     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6351     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6352   }
6353   PetscFunctionReturn(0);
6354 }
6355 
6356 #undef __FUNCT__
6357 #define __FUNCT__ "PCBDDCAnalyzeInterface"
6358 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6359 {
6360   ISLocalToGlobalMapping map;
6361   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6362   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6363   PetscInt               i,N;
6364   PetscBool              rcsr = PETSC_FALSE;
6365   PetscErrorCode         ierr;
6366 
6367   PetscFunctionBegin;
6368   if (pcbddc->recompute_topography) {
6369     pcbddc->graphanalyzed = PETSC_FALSE;
6370     /* Reset previously computed graph */
6371     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6372     /* Init local Graph struct */
6373     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6374     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6375     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6376 
6377     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6378       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6379     }
6380     /* Check validity of the csr graph passed in by the user */
6381     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);
6382 
6383     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6384     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6385       PetscInt  *xadj,*adjncy;
6386       PetscInt  nvtxs;
6387       PetscBool flg_row=PETSC_FALSE;
6388 
6389       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6390       if (flg_row) {
6391         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6392         pcbddc->computed_rowadj = PETSC_TRUE;
6393       }
6394       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6395       rcsr = PETSC_TRUE;
6396     }
6397     if (pcbddc->dbg_flag) {
6398       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6399     }
6400 
6401     /* Setup of Graph */
6402     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6403     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6404 
6405     /* attach info on disconnected subdomains if present */
6406     if (pcbddc->n_local_subs) {
6407       PetscInt *local_subs;
6408 
6409       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6410       for (i=0;i<pcbddc->n_local_subs;i++) {
6411         const PetscInt *idxs;
6412         PetscInt       nl,j;
6413 
6414         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6415         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6416         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6417         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6418       }
6419       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6420       pcbddc->mat_graph->local_subs = local_subs;
6421     }
6422   }
6423 
6424   if (!pcbddc->graphanalyzed) {
6425     /* Graph's connected components analysis */
6426     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6427     pcbddc->graphanalyzed = PETSC_TRUE;
6428   }
6429   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6430   PetscFunctionReturn(0);
6431 }
6432 
6433 #undef __FUNCT__
6434 #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
6435 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6436 {
6437   PetscInt       i,j;
6438   PetscScalar    *alphas;
6439   PetscErrorCode ierr;
6440 
6441   PetscFunctionBegin;
6442   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6443   for (i=0;i<n;i++) {
6444     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6445     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6446     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6447     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6448   }
6449   ierr = PetscFree(alphas);CHKERRQ(ierr);
6450   PetscFunctionReturn(0);
6451 }
6452 
6453 #undef __FUNCT__
6454 #define __FUNCT__ "PCBDDCMatISGetSubassemblingPattern"
6455 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6456 {
6457   Mat            A;
6458   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6459   PetscMPIInt    size,rank,color;
6460   PetscInt       *xadj,*adjncy;
6461   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6462   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6463   PetscInt       void_procs,*procs_candidates = NULL;
6464   PetscInt       xadj_count,*count;
6465   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6466   PetscSubcomm   psubcomm;
6467   MPI_Comm       subcomm;
6468   PetscErrorCode ierr;
6469 
6470   PetscFunctionBegin;
6471   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6472   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6473   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6474   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6475   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6476   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6477 
6478   if (have_void) *have_void = PETSC_FALSE;
6479   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6480   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6481   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6482   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6483   im_active = !!n;
6484   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6485   void_procs = size - active_procs;
6486   /* get ranks of of non-active processes in mat communicator */
6487   if (void_procs) {
6488     PetscInt ncand;
6489 
6490     if (have_void) *have_void = PETSC_TRUE;
6491     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6492     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6493     for (i=0,ncand=0;i<size;i++) {
6494       if (!procs_candidates[i]) {
6495         procs_candidates[ncand++] = i;
6496       }
6497     }
6498     /* force n_subdomains to be not greater that the number of non-active processes */
6499     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6500   }
6501 
6502   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6503      number of subdomains requested 1 -> send to master or first candidate in voids  */
6504   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6505   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6506     PetscInt issize,isidx,dest;
6507     if (*n_subdomains == 1) dest = 0;
6508     else dest = rank;
6509     if (im_active) {
6510       issize = 1;
6511       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6512         isidx = procs_candidates[dest];
6513       } else {
6514         isidx = dest;
6515       }
6516     } else {
6517       issize = 0;
6518       isidx = -1;
6519     }
6520     if (*n_subdomains != 1) *n_subdomains = active_procs;
6521     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6522     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6523     PetscFunctionReturn(0);
6524   }
6525   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6526   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6527   threshold = PetscMax(threshold,2);
6528 
6529   /* Get info on mapping */
6530   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6531 
6532   /* build local CSR graph of subdomains' connectivity */
6533   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6534   xadj[0] = 0;
6535   xadj[1] = PetscMax(n_neighs-1,0);
6536   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6537   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6538   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6539   for (i=1;i<n_neighs;i++)
6540     for (j=0;j<n_shared[i];j++)
6541       count[shared[i][j]] += 1;
6542 
6543   xadj_count = 0;
6544   for (i=1;i<n_neighs;i++) {
6545     for (j=0;j<n_shared[i];j++) {
6546       if (count[shared[i][j]] < threshold) {
6547         adjncy[xadj_count] = neighs[i];
6548         adjncy_wgt[xadj_count] = n_shared[i];
6549         xadj_count++;
6550         break;
6551       }
6552     }
6553   }
6554   xadj[1] = xadj_count;
6555   ierr = PetscFree(count);CHKERRQ(ierr);
6556   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6557   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6558 
6559   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6560 
6561   /* Restrict work on active processes only */
6562   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6563   if (void_procs) {
6564     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6565     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6566     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6567     subcomm = PetscSubcommChild(psubcomm);
6568   } else {
6569     psubcomm = NULL;
6570     subcomm = PetscObjectComm((PetscObject)mat);
6571   }
6572 
6573   v_wgt = NULL;
6574   if (!color) {
6575     ierr = PetscFree(xadj);CHKERRQ(ierr);
6576     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6577     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6578   } else {
6579     Mat             subdomain_adj;
6580     IS              new_ranks,new_ranks_contig;
6581     MatPartitioning partitioner;
6582     PetscInt        rstart=0,rend=0;
6583     PetscInt        *is_indices,*oldranks;
6584     PetscMPIInt     size;
6585     PetscBool       aggregate;
6586 
6587     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6588     if (void_procs) {
6589       PetscInt prank = rank;
6590       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6591       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6592       for (i=0;i<xadj[1];i++) {
6593         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6594       }
6595       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6596     } else {
6597       oldranks = NULL;
6598     }
6599     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6600     if (aggregate) { /* TODO: all this part could be made more efficient */
6601       PetscInt    lrows,row,ncols,*cols;
6602       PetscMPIInt nrank;
6603       PetscScalar *vals;
6604 
6605       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6606       lrows = 0;
6607       if (nrank<redprocs) {
6608         lrows = size/redprocs;
6609         if (nrank<size%redprocs) lrows++;
6610       }
6611       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6612       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6613       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6614       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6615       row = nrank;
6616       ncols = xadj[1]-xadj[0];
6617       cols = adjncy;
6618       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6619       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6620       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6621       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6622       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6623       ierr = PetscFree(xadj);CHKERRQ(ierr);
6624       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6625       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6626       ierr = PetscFree(vals);CHKERRQ(ierr);
6627       if (use_vwgt) {
6628         Vec               v;
6629         const PetscScalar *array;
6630         PetscInt          nl;
6631 
6632         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6633         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6634         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6635         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6636         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6637         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6638         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6639         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6640         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6641         ierr = VecDestroy(&v);CHKERRQ(ierr);
6642       }
6643     } else {
6644       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6645       if (use_vwgt) {
6646         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6647         v_wgt[0] = n;
6648       }
6649     }
6650     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6651 
6652     /* Partition */
6653     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6654     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6655     if (v_wgt) {
6656       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6657     }
6658     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6659     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6660     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6661     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6662     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6663 
6664     /* renumber new_ranks to avoid "holes" in new set of processors */
6665     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6666     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6667     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6668     if (!aggregate) {
6669       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6670 #if defined(PETSC_USE_DEBUG)
6671         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6672 #endif
6673         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6674       } else if (oldranks) {
6675         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6676       } else {
6677         ranks_send_to_idx[0] = is_indices[0];
6678       }
6679     } else {
6680       PetscInt    idxs[1];
6681       PetscMPIInt tag;
6682       MPI_Request *reqs;
6683 
6684       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6685       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6686       for (i=rstart;i<rend;i++) {
6687         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6688       }
6689       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6690       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6691       ierr = PetscFree(reqs);CHKERRQ(ierr);
6692       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6693 #if defined(PETSC_USE_DEBUG)
6694         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6695 #endif
6696         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6697       } else if (oldranks) {
6698         ranks_send_to_idx[0] = oldranks[idxs[0]];
6699       } else {
6700         ranks_send_to_idx[0] = idxs[0];
6701       }
6702     }
6703     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6704     /* clean up */
6705     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6706     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6707     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6708     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6709   }
6710   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6711   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6712 
6713   /* assemble parallel IS for sends */
6714   i = 1;
6715   if (!color) i=0;
6716   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6717   PetscFunctionReturn(0);
6718 }
6719 
6720 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6721 
6722 #undef __FUNCT__
6723 #define __FUNCT__ "PCBDDCMatISSubassemble"
6724 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[])
6725 {
6726   Mat                    local_mat;
6727   IS                     is_sends_internal;
6728   PetscInt               rows,cols,new_local_rows;
6729   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6730   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6731   ISLocalToGlobalMapping l2gmap;
6732   PetscInt*              l2gmap_indices;
6733   const PetscInt*        is_indices;
6734   MatType                new_local_type;
6735   /* buffers */
6736   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6737   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6738   PetscInt               *recv_buffer_idxs_local;
6739   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6740   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6741   /* MPI */
6742   MPI_Comm               comm,comm_n;
6743   PetscSubcomm           subcomm;
6744   PetscMPIInt            n_sends,n_recvs,commsize;
6745   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6746   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6747   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6748   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6749   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6750   PetscErrorCode         ierr;
6751 
6752   PetscFunctionBegin;
6753   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6754   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6755   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6756   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6757   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6758   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6759   PetscValidLogicalCollectiveBool(mat,reuse,6);
6760   PetscValidLogicalCollectiveInt(mat,nis,8);
6761   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6762   if (nvecs) {
6763     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6764     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6765   }
6766   /* further checks */
6767   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6768   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6769   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6770   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6771   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6772   if (reuse && *mat_n) {
6773     PetscInt mrows,mcols,mnrows,mncols;
6774     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6775     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6776     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6777     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6778     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6779     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6780     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6781   }
6782   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6783   PetscValidLogicalCollectiveInt(mat,bs,0);
6784 
6785   /* prepare IS for sending if not provided */
6786   if (!is_sends) {
6787     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6788     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6789   } else {
6790     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6791     is_sends_internal = is_sends;
6792   }
6793 
6794   /* get comm */
6795   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6796 
6797   /* compute number of sends */
6798   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6799   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6800 
6801   /* compute number of receives */
6802   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6803   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6804   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6805   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6806   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6807   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6808   ierr = PetscFree(iflags);CHKERRQ(ierr);
6809 
6810   /* restrict comm if requested */
6811   subcomm = 0;
6812   destroy_mat = PETSC_FALSE;
6813   if (restrict_comm) {
6814     PetscMPIInt color,subcommsize;
6815 
6816     color = 0;
6817     if (restrict_full) {
6818       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6819     } else {
6820       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6821     }
6822     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6823     subcommsize = commsize - subcommsize;
6824     /* check if reuse has been requested */
6825     if (reuse) {
6826       if (*mat_n) {
6827         PetscMPIInt subcommsize2;
6828         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6829         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6830         comm_n = PetscObjectComm((PetscObject)*mat_n);
6831       } else {
6832         comm_n = PETSC_COMM_SELF;
6833       }
6834     } else { /* MAT_INITIAL_MATRIX */
6835       PetscMPIInt rank;
6836 
6837       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6838       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6839       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6840       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6841       comm_n = PetscSubcommChild(subcomm);
6842     }
6843     /* flag to destroy *mat_n if not significative */
6844     if (color) destroy_mat = PETSC_TRUE;
6845   } else {
6846     comm_n = comm;
6847   }
6848 
6849   /* prepare send/receive buffers */
6850   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6851   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6852   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6853   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6854   if (nis) {
6855     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6856   }
6857 
6858   /* Get data from local matrices */
6859   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6860     /* TODO: See below some guidelines on how to prepare the local buffers */
6861     /*
6862        send_buffer_vals should contain the raw values of the local matrix
6863        send_buffer_idxs should contain:
6864        - MatType_PRIVATE type
6865        - PetscInt        size_of_l2gmap
6866        - PetscInt        global_row_indices[size_of_l2gmap]
6867        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6868     */
6869   else {
6870     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6871     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6872     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6873     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6874     send_buffer_idxs[1] = i;
6875     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6876     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6877     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6878     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6879     for (i=0;i<n_sends;i++) {
6880       ilengths_vals[is_indices[i]] = len*len;
6881       ilengths_idxs[is_indices[i]] = len+2;
6882     }
6883   }
6884   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6885   /* additional is (if any) */
6886   if (nis) {
6887     PetscMPIInt psum;
6888     PetscInt j;
6889     for (j=0,psum=0;j<nis;j++) {
6890       PetscInt plen;
6891       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6892       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
6893       psum += len+1; /* indices + lenght */
6894     }
6895     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
6896     for (j=0,psum=0;j<nis;j++) {
6897       PetscInt plen;
6898       const PetscInt *is_array_idxs;
6899       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6900       send_buffer_idxs_is[psum] = plen;
6901       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6902       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
6903       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6904       psum += plen+1; /* indices + lenght */
6905     }
6906     for (i=0;i<n_sends;i++) {
6907       ilengths_idxs_is[is_indices[i]] = psum;
6908     }
6909     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
6910   }
6911 
6912   buf_size_idxs = 0;
6913   buf_size_vals = 0;
6914   buf_size_idxs_is = 0;
6915   buf_size_vecs = 0;
6916   for (i=0;i<n_recvs;i++) {
6917     buf_size_idxs += (PetscInt)olengths_idxs[i];
6918     buf_size_vals += (PetscInt)olengths_vals[i];
6919     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
6920     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
6921   }
6922   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
6923   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
6924   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
6925   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
6926 
6927   /* get new tags for clean communications */
6928   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
6929   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
6930   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
6931   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
6932 
6933   /* allocate for requests */
6934   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
6935   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
6936   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
6937   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
6938   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
6939   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
6940   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
6941   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
6942 
6943   /* communications */
6944   ptr_idxs = recv_buffer_idxs;
6945   ptr_vals = recv_buffer_vals;
6946   ptr_idxs_is = recv_buffer_idxs_is;
6947   ptr_vecs = recv_buffer_vecs;
6948   for (i=0;i<n_recvs;i++) {
6949     source_dest = onodes[i];
6950     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
6951     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
6952     ptr_idxs += olengths_idxs[i];
6953     ptr_vals += olengths_vals[i];
6954     if (nis) {
6955       source_dest = onodes_is[i];
6956       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);
6957       ptr_idxs_is += olengths_idxs_is[i];
6958     }
6959     if (nvecs) {
6960       source_dest = onodes[i];
6961       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
6962       ptr_vecs += olengths_idxs[i]-2;
6963     }
6964   }
6965   for (i=0;i<n_sends;i++) {
6966     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
6967     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
6968     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
6969     if (nis) {
6970       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);
6971     }
6972     if (nvecs) {
6973       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
6974       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
6975     }
6976   }
6977   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6978   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
6979 
6980   /* assemble new l2g map */
6981   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6982   ptr_idxs = recv_buffer_idxs;
6983   new_local_rows = 0;
6984   for (i=0;i<n_recvs;i++) {
6985     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6986     ptr_idxs += olengths_idxs[i];
6987   }
6988   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
6989   ptr_idxs = recv_buffer_idxs;
6990   new_local_rows = 0;
6991   for (i=0;i<n_recvs;i++) {
6992     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
6993     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6994     ptr_idxs += olengths_idxs[i];
6995   }
6996   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
6997   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
6998   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
6999 
7000   /* infer new local matrix type from received local matrices type */
7001   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7002   /* 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) */
7003   if (n_recvs) {
7004     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7005     ptr_idxs = recv_buffer_idxs;
7006     for (i=0;i<n_recvs;i++) {
7007       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7008         new_local_type_private = MATAIJ_PRIVATE;
7009         break;
7010       }
7011       ptr_idxs += olengths_idxs[i];
7012     }
7013     switch (new_local_type_private) {
7014       case MATDENSE_PRIVATE:
7015         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
7016           new_local_type = MATSEQAIJ;
7017           bs = 1;
7018         } else { /* if I receive only 1 dense matrix */
7019           new_local_type = MATSEQDENSE;
7020           bs = 1;
7021         }
7022         break;
7023       case MATAIJ_PRIVATE:
7024         new_local_type = MATSEQAIJ;
7025         bs = 1;
7026         break;
7027       case MATBAIJ_PRIVATE:
7028         new_local_type = MATSEQBAIJ;
7029         break;
7030       case MATSBAIJ_PRIVATE:
7031         new_local_type = MATSEQSBAIJ;
7032         break;
7033       default:
7034         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
7035         break;
7036     }
7037   } else { /* by default, new_local_type is seqdense */
7038     new_local_type = MATSEQDENSE;
7039     bs = 1;
7040   }
7041 
7042   /* create MATIS object if needed */
7043   if (!reuse) {
7044     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7045     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7046   } else {
7047     /* it also destroys the local matrices */
7048     if (*mat_n) {
7049       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7050     } else { /* this is a fake object */
7051       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7052     }
7053   }
7054   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7055   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7056 
7057   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7058 
7059   /* Global to local map of received indices */
7060   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7061   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7062   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7063 
7064   /* restore attributes -> type of incoming data and its size */
7065   buf_size_idxs = 0;
7066   for (i=0;i<n_recvs;i++) {
7067     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7068     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7069     buf_size_idxs += (PetscInt)olengths_idxs[i];
7070   }
7071   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7072 
7073   /* set preallocation */
7074   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7075   if (!newisdense) {
7076     PetscInt *new_local_nnz=0;
7077 
7078     ptr_idxs = recv_buffer_idxs_local;
7079     if (n_recvs) {
7080       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7081     }
7082     for (i=0;i<n_recvs;i++) {
7083       PetscInt j;
7084       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7085         for (j=0;j<*(ptr_idxs+1);j++) {
7086           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7087         }
7088       } else {
7089         /* TODO */
7090       }
7091       ptr_idxs += olengths_idxs[i];
7092     }
7093     if (new_local_nnz) {
7094       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7095       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7096       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7097       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7098       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7099       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7100     } else {
7101       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7102     }
7103     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7104   } else {
7105     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7106   }
7107 
7108   /* set values */
7109   ptr_vals = recv_buffer_vals;
7110   ptr_idxs = recv_buffer_idxs_local;
7111   for (i=0;i<n_recvs;i++) {
7112     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7113       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7114       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7115       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7116       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7117       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7118     } else {
7119       /* TODO */
7120     }
7121     ptr_idxs += olengths_idxs[i];
7122     ptr_vals += olengths_vals[i];
7123   }
7124   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7125   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7126   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7127   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7128   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7129 
7130 #if 0
7131   if (!restrict_comm) { /* check */
7132     Vec       lvec,rvec;
7133     PetscReal infty_error;
7134 
7135     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7136     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7137     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7138     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7139     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7140     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7141     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7142     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7143     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7144   }
7145 #endif
7146 
7147   /* assemble new additional is (if any) */
7148   if (nis) {
7149     PetscInt **temp_idxs,*count_is,j,psum;
7150 
7151     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7152     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7153     ptr_idxs = recv_buffer_idxs_is;
7154     psum = 0;
7155     for (i=0;i<n_recvs;i++) {
7156       for (j=0;j<nis;j++) {
7157         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7158         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7159         psum += plen;
7160         ptr_idxs += plen+1; /* shift pointer to received data */
7161       }
7162     }
7163     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7164     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7165     for (i=1;i<nis;i++) {
7166       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7167     }
7168     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7169     ptr_idxs = recv_buffer_idxs_is;
7170     for (i=0;i<n_recvs;i++) {
7171       for (j=0;j<nis;j++) {
7172         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7173         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7174         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7175         ptr_idxs += plen+1; /* shift pointer to received data */
7176       }
7177     }
7178     for (i=0;i<nis;i++) {
7179       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7180       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7181       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7182     }
7183     ierr = PetscFree(count_is);CHKERRQ(ierr);
7184     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7185     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7186   }
7187   /* free workspace */
7188   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7189   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7190   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7191   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7192   if (isdense) {
7193     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7194     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7195   } else {
7196     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7197   }
7198   if (nis) {
7199     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7200     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7201   }
7202 
7203   if (nvecs) {
7204     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7205     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7206     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7207     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7208     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7209     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7210     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7211     /* set values */
7212     ptr_vals = recv_buffer_vecs;
7213     ptr_idxs = recv_buffer_idxs_local;
7214     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7215     for (i=0;i<n_recvs;i++) {
7216       PetscInt j;
7217       for (j=0;j<*(ptr_idxs+1);j++) {
7218         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7219       }
7220       ptr_idxs += olengths_idxs[i];
7221       ptr_vals += olengths_idxs[i]-2;
7222     }
7223     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7224     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7225     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7226   }
7227 
7228   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7229   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7230   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7231   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7232   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7233   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7234   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7235   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7236   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7237   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7238   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7239   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7240   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7241   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7242   ierr = PetscFree(onodes);CHKERRQ(ierr);
7243   if (nis) {
7244     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7245     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7246     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7247   }
7248   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7249   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7250     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7251     for (i=0;i<nis;i++) {
7252       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7253     }
7254     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7255       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7256     }
7257     *mat_n = NULL;
7258   }
7259   PetscFunctionReturn(0);
7260 }
7261 
7262 /* temporary hack into ksp private data structure */
7263 #include <petsc/private/kspimpl.h>
7264 
7265 #undef __FUNCT__
7266 #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
7267 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7268 {
7269   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7270   PC_IS                  *pcis = (PC_IS*)pc->data;
7271   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7272   Mat                    coarsedivudotp = NULL;
7273   Mat                    coarseG,t_coarse_mat_is;
7274   MatNullSpace           CoarseNullSpace = NULL;
7275   ISLocalToGlobalMapping coarse_islg;
7276   IS                     coarse_is,*isarray;
7277   PetscInt               i,im_active=-1,active_procs=-1;
7278   PetscInt               nis,nisdofs,nisneu,nisvert;
7279   PC                     pc_temp;
7280   PCType                 coarse_pc_type;
7281   KSPType                coarse_ksp_type;
7282   PetscBool              multilevel_requested,multilevel_allowed;
7283   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7284   PetscInt               ncoarse,nedcfield;
7285   PetscBool              compute_vecs = PETSC_FALSE;
7286   PetscScalar            *array;
7287   MatReuse               coarse_mat_reuse;
7288   PetscBool              restr, full_restr, have_void;
7289   PetscErrorCode         ierr;
7290 
7291   PetscFunctionBegin;
7292   /* Assign global numbering to coarse dofs */
7293   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 */
7294     PetscInt ocoarse_size;
7295     compute_vecs = PETSC_TRUE;
7296     ocoarse_size = pcbddc->coarse_size;
7297     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7298     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7299     /* see if we can avoid some work */
7300     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7301       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7302       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7303         PC        pc;
7304         PetscBool isbddc;
7305 
7306         /* temporary workaround since PCBDDC does not have a reset method so far */
7307         ierr = KSPGetPC(pcbddc->coarse_ksp,&pc);CHKERRQ(ierr);
7308         ierr = PetscObjectTypeCompare((PetscObject)pc,PCBDDC,&isbddc);CHKERRQ(ierr);
7309         if (isbddc) {
7310           ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
7311         } else {
7312           ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7313         }
7314         coarse_reuse = PETSC_FALSE;
7315       } else { /* we can safely reuse already computed coarse matrix */
7316         coarse_reuse = PETSC_TRUE;
7317       }
7318     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7319       coarse_reuse = PETSC_FALSE;
7320     }
7321     /* reset any subassembling information */
7322     if (!coarse_reuse || pcbddc->recompute_topography) {
7323       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7324     }
7325   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7326     coarse_reuse = PETSC_TRUE;
7327   }
7328   /* assemble coarse matrix */
7329   if (coarse_reuse && pcbddc->coarse_ksp) {
7330     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7331     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7332     coarse_mat_reuse = MAT_REUSE_MATRIX;
7333   } else {
7334     coarse_mat = NULL;
7335     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7336   }
7337 
7338   /* creates temporary l2gmap and IS for coarse indexes */
7339   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7340   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7341 
7342   /* creates temporary MATIS object for coarse matrix */
7343   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7344   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7345   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7346   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7347   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);
7348   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7349   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7350   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7351   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7352 
7353   /* count "active" (i.e. with positive local size) and "void" processes */
7354   im_active = !!(pcis->n);
7355   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7356 
7357   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7358   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7359   /* full_restr : just use the receivers from the subassembling pattern */
7360   coarse_mat_is = NULL;
7361   multilevel_allowed = PETSC_FALSE;
7362   multilevel_requested = PETSC_FALSE;
7363   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7364   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7365   if (multilevel_requested) {
7366     ncoarse = active_procs/pcbddc->coarsening_ratio;
7367     restr = PETSC_FALSE;
7368     full_restr = PETSC_FALSE;
7369   } else {
7370     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7371     restr = PETSC_TRUE;
7372     full_restr = PETSC_TRUE;
7373   }
7374   if (!pcbddc->coarse_size) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7375   ncoarse = PetscMax(1,ncoarse);
7376   if (!pcbddc->coarse_subassembling) {
7377     if (pcbddc->coarsening_ratio > 1) {
7378       if (multilevel_requested) {
7379         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7380       } else {
7381         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7382       }
7383     } else {
7384       PetscMPIInt size,rank;
7385       ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7386       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7387       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7388       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7389     }
7390   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7391     PetscInt    psum;
7392     PetscMPIInt size;
7393     if (pcbddc->coarse_ksp) psum = 1;
7394     else psum = 0;
7395     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7396     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7397     if (ncoarse < size) have_void = PETSC_TRUE;
7398   }
7399   /* determine if we can go multilevel */
7400   if (multilevel_requested) {
7401     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7402     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7403   }
7404   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7405 
7406   /* dump subassembling pattern */
7407   if (pcbddc->dbg_flag && multilevel_allowed) {
7408     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7409   }
7410 
7411   /* compute dofs splitting and neumann boundaries for coarse dofs */
7412   nedcfield = -1;
7413   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7414     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7415     const PetscInt         *idxs;
7416     ISLocalToGlobalMapping tmap;
7417 
7418     /* create map between primal indices (in local representative ordering) and local primal numbering */
7419     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7420     /* allocate space for temporary storage */
7421     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7422     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7423     /* allocate for IS array */
7424     nisdofs = pcbddc->n_ISForDofsLocal;
7425     if (pcbddc->nedclocal) {
7426       if (pcbddc->nedfield > -1) {
7427         nedcfield = pcbddc->nedfield;
7428       } else {
7429         nedcfield = 0;
7430         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7431         nisdofs = 1;
7432       }
7433     }
7434     nisneu = !!pcbddc->NeumannBoundariesLocal;
7435     nisvert = 0; /* nisvert is not used */
7436     nis = nisdofs + nisneu + nisvert;
7437     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7438     /* dofs splitting */
7439     for (i=0;i<nisdofs;i++) {
7440       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7441       if (nedcfield != i) {
7442         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7443         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7444         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7445         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7446       } else {
7447         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7448         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7449         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7450         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7451         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7452       }
7453       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7454       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7455       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7456     }
7457     /* neumann boundaries */
7458     if (pcbddc->NeumannBoundariesLocal) {
7459       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7460       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7461       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7462       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7463       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7464       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7465       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7466       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7467     }
7468     /* free memory */
7469     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7470     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7471     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7472   } else {
7473     nis = 0;
7474     nisdofs = 0;
7475     nisneu = 0;
7476     nisvert = 0;
7477     isarray = NULL;
7478   }
7479   /* destroy no longer needed map */
7480   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7481 
7482   /* subassemble */
7483   if (multilevel_allowed) {
7484     Vec       vp[1];
7485     PetscInt  nvecs = 0;
7486     PetscBool reuse,reuser;
7487 
7488     if (coarse_mat) reuse = PETSC_TRUE;
7489     else reuse = PETSC_FALSE;
7490     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7491     vp[0] = NULL;
7492     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7493       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7494       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7495       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7496       nvecs = 1;
7497 
7498       if (pcbddc->divudotp) {
7499         Mat      B,loc_divudotp;
7500         Vec      v,p;
7501         IS       dummy;
7502         PetscInt np;
7503 
7504         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7505         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7506         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7507         ierr = MatGetSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7508         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7509         ierr = VecSet(p,1.);CHKERRQ(ierr);
7510         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7511         ierr = VecDestroy(&p);CHKERRQ(ierr);
7512         ierr = MatDestroy(&B);CHKERRQ(ierr);
7513         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7514         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7515         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7516         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7517         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7518         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7519         ierr = VecDestroy(&v);CHKERRQ(ierr);
7520       }
7521     }
7522     if (reuser) {
7523       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7524     } else {
7525       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7526     }
7527     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7528       PetscScalar *arraym,*arrayv;
7529       PetscInt    nl;
7530       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7531       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7532       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7533       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7534       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7535       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7536       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7537       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7538     } else {
7539       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7540     }
7541   } else {
7542     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7543   }
7544   if (coarse_mat_is || coarse_mat) {
7545     PetscMPIInt size;
7546     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7547     if (!multilevel_allowed) {
7548       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7549     } else {
7550       Mat A;
7551 
7552       /* if this matrix is present, it means we are not reusing the coarse matrix */
7553       if (coarse_mat_is) {
7554         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7555         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7556         coarse_mat = coarse_mat_is;
7557       }
7558       /* be sure we don't have MatSeqDENSE as local mat */
7559       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7560       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7561     }
7562   }
7563   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7564   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7565 
7566   /* create local to global scatters for coarse problem */
7567   if (compute_vecs) {
7568     PetscInt lrows;
7569     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7570     if (coarse_mat) {
7571       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7572     } else {
7573       lrows = 0;
7574     }
7575     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7576     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7577     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7578     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7579     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7580   }
7581   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7582 
7583   /* set defaults for coarse KSP and PC */
7584   if (multilevel_allowed) {
7585     coarse_ksp_type = KSPRICHARDSON;
7586     coarse_pc_type = PCBDDC;
7587   } else {
7588     coarse_ksp_type = KSPPREONLY;
7589     coarse_pc_type = PCREDUNDANT;
7590   }
7591 
7592   /* print some info if requested */
7593   if (pcbddc->dbg_flag) {
7594     if (!multilevel_allowed) {
7595       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7596       if (multilevel_requested) {
7597         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);
7598       } else if (pcbddc->max_levels) {
7599         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7600       }
7601       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7602     }
7603   }
7604 
7605   /* communicate coarse discrete gradient */
7606   coarseG = NULL;
7607   if (pcbddc->nedcG && multilevel_allowed) {
7608     MPI_Comm ccomm;
7609     if (coarse_mat) {
7610       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7611     } else {
7612       ccomm = MPI_COMM_NULL;
7613     }
7614     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7615   }
7616 
7617   /* create the coarse KSP object only once with defaults */
7618   if (coarse_mat) {
7619     PetscViewer dbg_viewer = NULL;
7620     if (pcbddc->dbg_flag) {
7621       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7622       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7623     }
7624     if (!pcbddc->coarse_ksp) {
7625       char prefix[256],str_level[16];
7626       size_t len;
7627 
7628       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7629       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7630       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7631       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7632       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7633       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7634       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7635       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7636       /* TODO is this logic correct? should check for coarse_mat type */
7637       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7638       /* prefix */
7639       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7640       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7641       if (!pcbddc->current_level) {
7642         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7643         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7644       } else {
7645         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7646         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7647         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7648         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7649         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7650         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7651       }
7652       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7653       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7654       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7655       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7656       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7657       /* allow user customization */
7658       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7659     }
7660     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7661     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7662     if (nisdofs) {
7663       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7664       for (i=0;i<nisdofs;i++) {
7665         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7666       }
7667     }
7668     if (nisneu) {
7669       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7670       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7671     }
7672     if (nisvert) {
7673       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7674       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7675     }
7676     if (coarseG) {
7677       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7678     }
7679 
7680     /* get some info after set from options */
7681     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7682     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7683     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7684     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
7685       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7686       isbddc = PETSC_FALSE;
7687     }
7688     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7689     if (isredundant) {
7690       KSP inner_ksp;
7691       PC  inner_pc;
7692       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7693       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7694       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7695     }
7696 
7697     /* parameters which miss an API */
7698     if (isbddc) {
7699       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7700       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7701       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7702       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7703       if (pcbddc_coarse->benign_saddle_point) {
7704         Mat                    coarsedivudotp_is;
7705         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7706         IS                     row,col;
7707         const PetscInt         *gidxs;
7708         PetscInt               n,st,M,N;
7709 
7710         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7711         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7712         st = st-n;
7713         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7714         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7715         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7716         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7717         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7718         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7719         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7720         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7721         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7722         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7723         ierr = ISDestroy(&row);CHKERRQ(ierr);
7724         ierr = ISDestroy(&col);CHKERRQ(ierr);
7725         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7726         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7727         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7728         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7729         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7730         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7731         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7732         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7733         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7734         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7735         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7736         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7737       }
7738     }
7739 
7740     /* propagate symmetry info of coarse matrix */
7741     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7742     if (pc->pmat->symmetric_set) {
7743       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7744     }
7745     if (pc->pmat->hermitian_set) {
7746       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7747     }
7748     if (pc->pmat->spd_set) {
7749       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7750     }
7751     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7752       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7753     }
7754     /* set operators */
7755     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7756     if (pcbddc->dbg_flag) {
7757       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7758     }
7759   }
7760   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7761   ierr = PetscFree(isarray);CHKERRQ(ierr);
7762 #if 0
7763   {
7764     PetscViewer viewer;
7765     char filename[256];
7766     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7767     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7768     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7769     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7770     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7771     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7772   }
7773 #endif
7774 
7775   if (pcbddc->coarse_ksp) {
7776     Vec crhs,csol;
7777 
7778     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7779     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7780     if (!csol) {
7781       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7782     }
7783     if (!crhs) {
7784       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7785     }
7786   }
7787   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7788 
7789   /* compute null space for coarse solver if the benign trick has been requested */
7790   if (pcbddc->benign_null) {
7791 
7792     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7793     for (i=0;i<pcbddc->benign_n;i++) {
7794       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7795     }
7796     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7797     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7798     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7799     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7800     if (coarse_mat) {
7801       Vec         nullv;
7802       PetscScalar *array,*array2;
7803       PetscInt    nl;
7804 
7805       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7806       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7807       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7808       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7809       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7810       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7811       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7812       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7813       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7814       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7815     }
7816   }
7817 
7818   if (pcbddc->coarse_ksp) {
7819     PetscBool ispreonly;
7820 
7821     if (CoarseNullSpace) {
7822       PetscBool isnull;
7823       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7824       if (isnull) {
7825         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7826       }
7827       /* TODO: add local nullspaces (if any) */
7828     }
7829     /* setup coarse ksp */
7830     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7831     /* Check coarse problem if in debug mode or if solving with an iterative method */
7832     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7833     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7834       KSP       check_ksp;
7835       KSPType   check_ksp_type;
7836       PC        check_pc;
7837       Vec       check_vec,coarse_vec;
7838       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7839       PetscInt  its;
7840       PetscBool compute_eigs;
7841       PetscReal *eigs_r,*eigs_c;
7842       PetscInt  neigs;
7843       const char *prefix;
7844 
7845       /* Create ksp object suitable for estimation of extreme eigenvalues */
7846       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7847       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7848       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7849       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7850       /* prevent from setup unneeded object */
7851       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7852       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7853       if (ispreonly) {
7854         check_ksp_type = KSPPREONLY;
7855         compute_eigs = PETSC_FALSE;
7856       } else {
7857         check_ksp_type = KSPGMRES;
7858         compute_eigs = PETSC_TRUE;
7859       }
7860       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7861       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7862       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7863       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7864       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7865       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7866       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7867       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7868       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7869       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7870       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7871       /* create random vec */
7872       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7873       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7874       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7875       /* solve coarse problem */
7876       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7877       /* set eigenvalue estimation if preonly has not been requested */
7878       if (compute_eigs) {
7879         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7880         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7881         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7882         if (neigs) {
7883           lambda_max = eigs_r[neigs-1];
7884           lambda_min = eigs_r[0];
7885           if (pcbddc->use_coarse_estimates) {
7886             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7887               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7888               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7889             }
7890           }
7891         }
7892       }
7893 
7894       /* check coarse problem residual error */
7895       if (pcbddc->dbg_flag) {
7896         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
7897         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7898         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
7899         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7900         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7901         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
7902         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
7903         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
7904         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
7905         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
7906         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
7907         if (CoarseNullSpace) {
7908           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
7909         }
7910         if (compute_eigs) {
7911           PetscReal          lambda_max_s,lambda_min_s;
7912           KSPConvergedReason reason;
7913           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
7914           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
7915           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
7916           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
7917           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);
7918           for (i=0;i<neigs;i++) {
7919             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
7920           }
7921         }
7922         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
7923         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7924       }
7925       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
7926       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
7927       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
7928       if (compute_eigs) {
7929         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
7930         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
7931       }
7932     }
7933   }
7934   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
7935   /* print additional info */
7936   if (pcbddc->dbg_flag) {
7937     /* waits until all processes reaches this point */
7938     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
7939     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
7940     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7941   }
7942 
7943   /* free memory */
7944   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
7945   PetscFunctionReturn(0);
7946 }
7947 
7948 #undef __FUNCT__
7949 #define __FUNCT__ "PCBDDCComputePrimalNumbering"
7950 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
7951 {
7952   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7953   PC_IS*         pcis = (PC_IS*)pc->data;
7954   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
7955   IS             subset,subset_mult,subset_n;
7956   PetscInt       local_size,coarse_size=0;
7957   PetscInt       *local_primal_indices=NULL;
7958   const PetscInt *t_local_primal_indices;
7959   PetscErrorCode ierr;
7960 
7961   PetscFunctionBegin;
7962   /* Compute global number of coarse dofs */
7963   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
7964   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
7965   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
7966   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7967   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
7968   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
7969   ierr = ISDestroy(&subset);CHKERRQ(ierr);
7970   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
7971   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
7972   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);
7973   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
7974   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7975   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
7976   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7977   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7978 
7979   /* check numbering */
7980   if (pcbddc->dbg_flag) {
7981     PetscScalar coarsesum,*array,*array2;
7982     PetscInt    i;
7983     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
7984 
7985     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7986     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7987     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
7988     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7989     /* counter */
7990     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7991     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
7992     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7993     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7994     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7995     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7996     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
7997     for (i=0;i<pcbddc->local_primal_size;i++) {
7998       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
7999     }
8000     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8001     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8002     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8003     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8004     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8005     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8006     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8007     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8008     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8009     for (i=0;i<pcis->n;i++) {
8010       if (array[i] != 0.0 && array[i] != array2[i]) {
8011         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8012         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8013         set_error = PETSC_TRUE;
8014         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8015         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);
8016       }
8017     }
8018     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8019     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8020     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8021     for (i=0;i<pcis->n;i++) {
8022       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8023     }
8024     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8025     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8026     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8027     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8028     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8029     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8030     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8031       PetscInt *gidxs;
8032 
8033       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8034       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8035       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8036       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8037       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8038       for (i=0;i<pcbddc->local_primal_size;i++) {
8039         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);
8040       }
8041       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8042       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8043     }
8044     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8045     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8046     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8047   }
8048   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8049   /* get back data */
8050   *coarse_size_n = coarse_size;
8051   *local_primal_indices_n = local_primal_indices;
8052   PetscFunctionReturn(0);
8053 }
8054 
8055 #undef __FUNCT__
8056 #define __FUNCT__ "PCBDDCGlobalToLocal"
8057 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8058 {
8059   IS             localis_t;
8060   PetscInt       i,lsize,*idxs,n;
8061   PetscScalar    *vals;
8062   PetscErrorCode ierr;
8063 
8064   PetscFunctionBegin;
8065   /* get indices in local ordering exploiting local to global map */
8066   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8067   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8068   for (i=0;i<lsize;i++) vals[i] = 1.0;
8069   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8070   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8071   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8072   if (idxs) { /* multilevel guard */
8073     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8074   }
8075   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8076   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8077   ierr = PetscFree(vals);CHKERRQ(ierr);
8078   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8079   /* now compute set in local ordering */
8080   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8081   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8082   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8083   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8084   for (i=0,lsize=0;i<n;i++) {
8085     if (PetscRealPart(vals[i]) > 0.5) {
8086       lsize++;
8087     }
8088   }
8089   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8090   for (i=0,lsize=0;i<n;i++) {
8091     if (PetscRealPart(vals[i]) > 0.5) {
8092       idxs[lsize++] = i;
8093     }
8094   }
8095   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8096   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8097   *localis = localis_t;
8098   PetscFunctionReturn(0);
8099 }
8100 
8101 #undef __FUNCT__
8102 #define __FUNCT__ "PCBDDCSetUpSubSchurs"
8103 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8104 {
8105   PC_IS               *pcis=(PC_IS*)pc->data;
8106   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8107   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8108   Mat                 S_j;
8109   PetscInt            *used_xadj,*used_adjncy;
8110   PetscBool           free_used_adj;
8111   PetscErrorCode      ierr;
8112 
8113   PetscFunctionBegin;
8114   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8115   free_used_adj = PETSC_FALSE;
8116   if (pcbddc->sub_schurs_layers == -1) {
8117     used_xadj = NULL;
8118     used_adjncy = NULL;
8119   } else {
8120     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8121       used_xadj = pcbddc->mat_graph->xadj;
8122       used_adjncy = pcbddc->mat_graph->adjncy;
8123     } else if (pcbddc->computed_rowadj) {
8124       used_xadj = pcbddc->mat_graph->xadj;
8125       used_adjncy = pcbddc->mat_graph->adjncy;
8126     } else {
8127       PetscBool      flg_row=PETSC_FALSE;
8128       const PetscInt *xadj,*adjncy;
8129       PetscInt       nvtxs;
8130 
8131       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8132       if (flg_row) {
8133         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8134         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8135         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8136         free_used_adj = PETSC_TRUE;
8137       } else {
8138         pcbddc->sub_schurs_layers = -1;
8139         used_xadj = NULL;
8140         used_adjncy = NULL;
8141       }
8142       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8143     }
8144   }
8145 
8146   /* setup sub_schurs data */
8147   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8148   if (!sub_schurs->schur_explicit) {
8149     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8150     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8151     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);
8152   } else {
8153     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8154     PetscBool isseqaij,need_change = PETSC_FALSE;
8155     PetscInt  benign_n;
8156     Mat       change = NULL;
8157     Vec       scaling = NULL;
8158     IS        change_primal = NULL;
8159 
8160     if (!pcbddc->use_vertices && reuse_solvers) {
8161       PetscInt n_vertices;
8162 
8163       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8164       reuse_solvers = (PetscBool)!n_vertices;
8165     }
8166     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8167     if (!isseqaij) {
8168       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8169       if (matis->A == pcbddc->local_mat) {
8170         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8171         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8172       } else {
8173         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8174       }
8175     }
8176     if (!pcbddc->benign_change_explicit) {
8177       benign_n = pcbddc->benign_n;
8178     } else {
8179       benign_n = 0;
8180     }
8181     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8182        We need a global reduction to avoid possible deadlocks.
8183        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8184     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8185       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8186       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8187       need_change = (PetscBool)(!need_change);
8188     }
8189     /* If the user defines additional constraints, we import them here.
8190        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 */
8191     if (need_change) {
8192       PC_IS   *pcisf;
8193       PC_BDDC *pcbddcf;
8194       PC      pcf;
8195 
8196       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8197       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8198       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8199       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8200       /* hacks */
8201       pcisf = (PC_IS*)pcf->data;
8202       pcisf->is_B_local = pcis->is_B_local;
8203       pcisf->vec1_N = pcis->vec1_N;
8204       pcisf->BtoNmap = pcis->BtoNmap;
8205       pcisf->n = pcis->n;
8206       pcisf->n_B = pcis->n_B;
8207       pcbddcf = (PC_BDDC*)pcf->data;
8208       ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8209       pcbddcf->mat_graph = pcbddc->mat_graph;
8210       pcbddcf->use_faces = PETSC_TRUE;
8211       pcbddcf->use_change_of_basis = PETSC_TRUE;
8212       pcbddcf->use_change_on_faces = PETSC_TRUE;
8213       pcbddcf->use_qr_single = PETSC_TRUE;
8214       pcbddcf->fake_change = PETSC_TRUE;
8215       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8216       /* store information on primal vertices and change of basis (in local numbering) */
8217       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8218       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8219       change = pcbddcf->ConstraintMatrix;
8220       pcbddcf->ConstraintMatrix = NULL;
8221       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8222       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8223       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8224       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8225       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8226       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8227       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8228       pcf->ops->destroy = NULL;
8229       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8230     }
8231     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8232     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);
8233     ierr = MatDestroy(&change);CHKERRQ(ierr);
8234     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8235   }
8236   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8237 
8238   /* free adjacency */
8239   if (free_used_adj) {
8240     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8241   }
8242   PetscFunctionReturn(0);
8243 }
8244 
8245 #undef __FUNCT__
8246 #define __FUNCT__ "PCBDDCInitSubSchurs"
8247 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8248 {
8249   PC_IS               *pcis=(PC_IS*)pc->data;
8250   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8251   PCBDDCGraph         graph;
8252   PetscErrorCode      ierr;
8253 
8254   PetscFunctionBegin;
8255   /* attach interface graph for determining subsets */
8256   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8257     IS       verticesIS,verticescomm;
8258     PetscInt vsize,*idxs;
8259 
8260     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8261     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8262     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8263     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8264     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8265     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8266     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8267     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8268     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8269     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8270     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8271   } else {
8272     graph = pcbddc->mat_graph;
8273   }
8274   /* print some info */
8275   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8276     IS       vertices;
8277     PetscInt nv,nedges,nfaces;
8278     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8279     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8280     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8281     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8282     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8283     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8284     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8285     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8286     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8287     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8288     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8289   }
8290 
8291   /* sub_schurs init */
8292   if (!pcbddc->sub_schurs) {
8293     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8294   }
8295   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8296 
8297   /* free graph struct */
8298   if (pcbddc->sub_schurs_rebuild) {
8299     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8300   }
8301   PetscFunctionReturn(0);
8302 }
8303 
8304 #undef __FUNCT__
8305 #define __FUNCT__ "PCBDDCCheckOperator"
8306 PetscErrorCode PCBDDCCheckOperator(PC pc)
8307 {
8308   PC_IS               *pcis=(PC_IS*)pc->data;
8309   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8310   PetscErrorCode      ierr;
8311 
8312   PetscFunctionBegin;
8313   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8314     IS             zerodiag = NULL;
8315     Mat            S_j,B0_B=NULL;
8316     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8317     PetscScalar    *p0_check,*array,*array2;
8318     PetscReal      norm;
8319     PetscInt       i;
8320 
8321     /* B0 and B0_B */
8322     if (zerodiag) {
8323       IS       dummy;
8324 
8325       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8326       ierr = MatGetSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8327       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8328       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8329     }
8330     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8331     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8332     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8333     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8334     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8335     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8336     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8337     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8338     /* S_j */
8339     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8340     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8341 
8342     /* mimic vector in \widetilde{W}_\Gamma */
8343     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8344     /* continuous in primal space */
8345     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8346     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8347     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8348     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8349     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8350     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8351     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8352     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8353     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8354     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8355     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8356     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8357     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8358     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8359 
8360     /* assemble rhs for coarse problem */
8361     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8362     /* local with Schur */
8363     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8364     if (zerodiag) {
8365       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8366       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8367       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8368       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8369     }
8370     /* sum on primal nodes the local contributions */
8371     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8372     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8373     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8374     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8375     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8376     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8377     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8378     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8379     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8380     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8381     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8382     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8383     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8384     /* scale primal nodes (BDDC sums contibutions) */
8385     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8386     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8387     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8388     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8389     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8390     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8391     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8392     /* global: \widetilde{B0}_B w_\Gamma */
8393     if (zerodiag) {
8394       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8395       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8396       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8397       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8398     }
8399     /* BDDC */
8400     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8401     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8402 
8403     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8404     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8405     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8406     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8407     for (i=0;i<pcbddc->benign_n;i++) {
8408       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8409     }
8410     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8411     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8412     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8413     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8414     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8415     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8416   }
8417   PetscFunctionReturn(0);
8418 }
8419 
8420 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8421 #undef __FUNCT__
8422 #define __FUNCT__ "MatMPIAIJRestrict"
8423 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8424 {
8425   Mat            At;
8426   IS             rows;
8427   PetscInt       rst,ren;
8428   PetscErrorCode ierr;
8429   PetscLayout    rmap;
8430 
8431   PetscFunctionBegin;
8432   rst = ren = 0;
8433   if (ccomm != MPI_COMM_NULL) {
8434     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8435     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8436     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8437     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8438     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8439   }
8440   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8441   ierr = MatGetSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8442   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8443 
8444   if (ccomm != MPI_COMM_NULL) {
8445     Mat_MPIAIJ *a,*b;
8446     IS         from,to;
8447     Vec        gvec;
8448     PetscInt   lsize;
8449 
8450     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8451     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8452     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8453     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8454     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8455     a    = (Mat_MPIAIJ*)At->data;
8456     b    = (Mat_MPIAIJ*)(*B)->data;
8457     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8458     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8459     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8460     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8461     b->A = a->A;
8462     b->B = a->B;
8463 
8464     b->donotstash      = a->donotstash;
8465     b->roworiented     = a->roworiented;
8466     b->rowindices      = 0;
8467     b->rowvalues       = 0;
8468     b->getrowactive    = PETSC_FALSE;
8469 
8470     (*B)->rmap         = rmap;
8471     (*B)->factortype   = A->factortype;
8472     (*B)->assembled    = PETSC_TRUE;
8473     (*B)->insertmode   = NOT_SET_VALUES;
8474     (*B)->preallocated = PETSC_TRUE;
8475 
8476     if (a->colmap) {
8477 #if defined(PETSC_USE_CTABLE)
8478       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8479 #else
8480       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8481       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8482       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8483 #endif
8484     } else b->colmap = 0;
8485     if (a->garray) {
8486       PetscInt len;
8487       len  = a->B->cmap->n;
8488       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8489       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8490       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8491     } else b->garray = 0;
8492 
8493     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8494     b->lvec = a->lvec;
8495     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8496 
8497     /* cannot use VecScatterCopy */
8498     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8499     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8500     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8501     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8502     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8503     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8504     ierr = ISDestroy(&from);CHKERRQ(ierr);
8505     ierr = ISDestroy(&to);CHKERRQ(ierr);
8506     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8507   }
8508   ierr = MatDestroy(&At);CHKERRQ(ierr);
8509   PetscFunctionReturn(0);
8510 }
8511