xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 7d871cd70b7dbcf8c1a6ebaab3b3899552b17b33)
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 /* returns B s.t. range(B) _|_ range(A) */
10 #undef __FUNCT__
11 #define __FUNCT__ "MatDense_OrthogonalComplement"
12 PetscErrorCode MatDense_OrthogonalComplement(Mat A, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
13 {
14 #if !defined(PETSC_USE_COMPLEX)
15   PetscScalar    *uwork,*data,*U, ds = 0.;
16   PetscReal      *sing;
17   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
18   PetscInt       ulw,i,nr,nc,n;
19   PetscErrorCode ierr;
20 
21   PetscFunctionBegin;
22 #if defined(PETSC_MISSING_LAPACK_GESVD)
23   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
24 #endif
25   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
26   if (!nr || !nc) PetscFunctionReturn(0);
27 
28   /* workspace */
29   if (!work) {
30     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
31     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
32   } else {
33     ulw   = lw;
34     uwork = work;
35   }
36   n = PetscMin(nr,nc);
37   if (!rwork) {
38     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
39   } else {
40     sing = rwork;
41   }
42 
43   /* SVD */
44   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
45   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
46   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
47   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
48   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
49   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
50   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
51   ierr = PetscFPTrapPop();CHKERRQ(ierr);
52   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
53   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
54   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
55   if (!rwork) {
56     ierr = PetscFree(sing);CHKERRQ(ierr);
57   }
58   if (!work) {
59     ierr = PetscFree(uwork);CHKERRQ(ierr);
60   }
61   /* create B */
62   ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
63   ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
64   ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
65   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
66   ierr = PetscFree(U);CHKERRQ(ierr);
67 #else
68   PetscFunctionBegin;
69   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
70 #endif
71   PetscFunctionReturn(0);
72 }
73 
74 /* TODO REMOVE */
75 #if defined(PRINT_GDET)
76 static int inc = 0;
77 static int lev = 0;
78 #endif
79 
80 #undef __FUNCT__
81 #define __FUNCT__ "PCBDDCComputeNedelecChangeEdge"
82 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
83 {
84   PetscErrorCode ierr;
85   Mat            GE,GEd;
86   PetscInt       rsize,csize,esize;
87   PetscScalar    *ptr;
88 
89   PetscFunctionBegin;
90   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
91   if (!esize) PetscFunctionReturn(0);
92   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
93   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
94 
95   /* gradients */
96   ptr  = work + 5*esize;
97   ierr = MatGetSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
98   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
99   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
100   ierr = MatDestroy(&GE);CHKERRQ(ierr);
101 
102   /* constants */
103   ptr += rsize*csize;
104   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
105   ierr = MatGetSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
107   ierr = MatDestroy(&GE);CHKERRQ(ierr);
108   ierr = MatDense_OrthogonalComplement(GEd,5*esize,work,rwork,GKins);CHKERRQ(ierr);
109   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
110 
111   if (corners) {
112     Mat            GEc;
113     PetscScalar    *vals,v;
114 
115     ierr = MatGetSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
116     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
117     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
118     /* v    = PetscAbsScalar(vals[0]) */;
119     v    = 1.;
120     cvals[0] = vals[0]/v;
121     cvals[1] = vals[1]/v;
122     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
123     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
124 #if defined(PRINT_GDET)
125     {
126       PetscViewer viewer;
127       char filename[256];
128       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
129       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
130       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
131       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
132       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
133       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
134       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
135       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
136       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
137       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
138     }
139 #endif
140     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
141     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
142   }
143 
144   PetscFunctionReturn(0);
145 }
146 
147 #undef __FUNCT__
148 #define __FUNCT__ "PCBDDCNedelecSupport"
149 PetscErrorCode PCBDDCNedelecSupport(PC pc)
150 {
151   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
152   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
153   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
154   Vec                    tvec;
155   PetscSF                sfv;
156   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
157   MPI_Comm               comm;
158   IS                     lned,primals,allprimals,nedfieldlocal;
159   IS                     *eedges,*extrows,*extcols,*alleedges;
160   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
161   PetscScalar            *vals,*work;
162   PetscReal              *rwork;
163   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
164   PetscInt               ne,nv,Lv,order,n,field;
165   PetscInt               n_neigh,*neigh,*n_shared,**shared;
166   PetscInt               i,j,extmem,cum,maxsize,nee;
167   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
168   PetscInt               *sfvleaves,*sfvroots;
169   PetscInt               *corners,*cedges;
170   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
171 #if defined(PETSC_USE_DEBUG)
172   PetscInt               *emarks;
173 #endif
174   PetscBool              print,eerr,done,lrc[2],conforming,global;
175   PetscErrorCode         ierr;
176 
177   PetscFunctionBegin;
178   /* test variable order code and print debug info TODO: to be removed */
179   print = PETSC_FALSE;
180   ierr = PetscOptionsGetBool(NULL,NULL,"-pc_bddc_print_nedelec",&print,NULL);CHKERRQ(ierr);
181   ierr = PetscOptionsGetInt(NULL,NULL,"-pc_bddc_nedelec_order",&pcbddc->nedorder,NULL);CHKERRQ(ierr);
182 
183   /* Return to caller if there are no edges in the decomposition */
184   ierr   = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
185   ierr   = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
186   ierr   = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
187   ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
188   lrc[0] = PETSC_FALSE;
189   for (i=0;i<n;i++) {
190     if (PetscRealPart(vals[i]) > 2.) {
191       lrc[0] = PETSC_TRUE;
192       break;
193     }
194   }
195   ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
196   ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
197   if (!lrc[1]) PetscFunctionReturn(0);
198 
199   /* If the discrete gradient is defined for a subset of dofs and global is true,
200      it assumes G is given in global ordering for all the dofs.
201      Otherwise, the ordering is global for the Nedelec field */
202   order      = pcbddc->nedorder;
203   conforming = pcbddc->conforming;
204   field      = pcbddc->nedfield;
205   global     = pcbddc->nedglobal;
206   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);
207   if (pcbddc->n_ISForDofsLocal && field > -1) {
208     PetscBool setprimal = PETSC_FALSE;
209     ierr = PetscOptionsGetBool(NULL,NULL,"-pc_bddc_nedelec_field_primal",&setprimal,NULL);CHKERRQ(ierr);
210     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
211     nedfieldlocal = pcbddc->ISForDofsLocal[field];
212     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
213     if (setprimal) {
214       IS       enedfieldlocal;
215       PetscInt *eidxs;
216 
217       ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
218       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
219       ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
220       for (i=0,cum=0;i<ne;i++) {
221         if (PetscRealPart(vals[idxs[i]]) > 2.) {
222           eidxs[cum++] = idxs[i];
223         }
224       }
225       ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
226       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
227       ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
228       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
229       ierr = PetscFree(eidxs);CHKERRQ(ierr);
230       ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
231       ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
232       PetscFunctionReturn(0);
233     }
234   } else if (!pcbddc->n_ISForDofsLocal) {
235     PetscBool testnedfield = PETSC_FALSE;
236     ierr = PetscOptionsGetBool(NULL,NULL,"-pc_bddc_nedelec_field",&testnedfield,NULL);CHKERRQ(ierr);
237     if (!testnedfield) {
238       ne            = n;
239       nedfieldlocal = NULL;
240     } else {
241       /* ierr = ISCreateStride(comm,n,0,1,&nedfieldlocal);CHKERRQ(ierr); */
242       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
243       ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
244       ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
245       for (i=0;i<n;i++) matis->sf_leafdata[i] = 1;
246       ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
247       ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
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       for (i=0,cum=0;i<n;i++) {
251         if (matis->sf_leafdata[i] > 1) {
252           matis->sf_leafdata[cum++] = i;
253         }
254       }
255       ierr = ISCreateGeneral(comm,cum,matis->sf_leafdata,PETSC_COPY_VALUES,&nedfieldlocal);CHKERRQ(ierr);
256       ierr = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
257     }
258     global = PETSC_TRUE;
259   } else {
260     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
261   }
262 
263   if (nedfieldlocal) { /* merge with previous code when testing is done */
264     IS is;
265 
266     /* need to map from the local Nedelec field to local numbering */
267     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
268     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
269     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
270     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
271     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
272     if (global) {
273       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
274       el2g = al2g;
275     } else {
276       IS gis;
277 
278       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
279       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
280       ierr = ISDestroy(&gis);CHKERRQ(ierr);
281     }
282     ierr = ISDestroy(&is);CHKERRQ(ierr);
283   } else {
284     /* restore default */
285     pcbddc->nedfield = -1;
286     /* one ref for the destruction of al2g, one for el2g */
287     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
288     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
289     el2g = al2g;
290     fl2g = NULL;
291   }
292 
293   /* Sanity checks */
294   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
295   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
296   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);
297 
298   /* Drop connections for interior edges */
299   ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
300   ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
301   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
302   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
303   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
304   if (nedfieldlocal) {
305     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
306     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
307     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
308   } else {
309     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
310   }
311   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
312   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
313   if (global) {
314     PetscInt rst;
315 
316     ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
317     for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
318       if (matis->sf_rootdata[i] < 2) {
319         matis->sf_rootdata[cum++] = i + rst;
320       }
321     }
322     ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
323     ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
324   } else {
325     PetscInt *tbz;
326 
327     ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
328     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
329     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
330     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
331     for (i=0,cum=0;i<ne;i++)
332       if (matis->sf_leafdata[idxs[i]] == 1)
333         tbz[cum++] = i;
334     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
335     ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
336     ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
337     ierr = PetscFree(tbz);CHKERRQ(ierr);
338   }
339 
340   /* Extract subdomain relevant rows of G */
341   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
342   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
343   ierr = MatGetSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
344   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
345   ierr = ISDestroy(&lned);CHKERRQ(ierr);
346   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
347   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
348   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
349   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
350   if (print) {
351     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
352     ierr = MatView(lG,NULL);CHKERRQ(ierr);
353   }
354 
355   /* SF for nodal communications */
356   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
357   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
358   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
359   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
360   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
361   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
362   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
363   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
364   ierr = PetscMalloc2(nv,&sfvleaves,Lv,&sfvroots);CHKERRQ(ierr);
365 
366   /* Destroy temporary G created in MATIS format and modified G */
367   ierr = MatDestroy(&G);CHKERRQ(ierr);
368   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
369 
370   /* Save lG */
371   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
372 
373   /* Analyze the edge-nodes connections (duplicate lG) */
374   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
375   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
376   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
377   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
378   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
379   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
380   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
381   /* need to import the boundary specification to ensure the
382      proper detection of coarse edges' endpoints */
383   if (pcbddc->DirichletBoundariesLocal) {
384     IS is;
385 
386     if (fl2g) {
387       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
388     } else {
389       is = pcbddc->DirichletBoundariesLocal;
390     }
391     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
392     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
393     for (i=0;i<cum;i++) {
394       if (idxs[i] >= 0) {
395         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
396         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
397       }
398     }
399     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
400     if (fl2g) {
401       ierr = ISDestroy(&is);CHKERRQ(ierr);
402     }
403   }
404   if (pcbddc->NeumannBoundariesLocal) {
405     IS is;
406 
407     if (fl2g) {
408       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
409     } else {
410       is = pcbddc->NeumannBoundariesLocal;
411     }
412     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
413     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
414     for (i=0;i<cum;i++) {
415       if (idxs[i] >= 0) {
416         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
417       }
418     }
419     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
420     if (fl2g) {
421       ierr = ISDestroy(&is);CHKERRQ(ierr);
422     }
423   }
424 
425   /* count neighs per dof */
426   ierr = PetscCalloc1(ne,&ecount);CHKERRQ(ierr);
427   ierr = PetscMalloc1(ne,&eneighs);CHKERRQ(ierr);
428   ierr = ISLocalToGlobalMappingGetInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
429   for (i=1,cum=0;i<n_neigh;i++) {
430     cum += n_shared[i];
431     for (j=0;j<n_shared[i];j++) {
432       ecount[shared[i][j]]++;
433     }
434   }
435   if (ne) {
436     ierr = PetscMalloc1(cum,&eneighs[0]);CHKERRQ(ierr);
437   }
438   for (i=1;i<ne;i++) eneighs[i] = eneighs[i-1] + ecount[i-1];
439   ierr = PetscMemzero(ecount,ne*sizeof(PetscInt));CHKERRQ(ierr);
440   for (i=1;i<n_neigh;i++) {
441     for (j=0;j<n_shared[i];j++) {
442       PetscInt k = shared[i][j];
443       eneighs[k][ecount[k]] = neigh[i];
444       ecount[k]++;
445     }
446   }
447   for (i=0;i<ne;i++) {
448     ierr = PetscSortRemoveDupsInt(&ecount[i],eneighs[i]);CHKERRQ(ierr);
449   }
450   ierr = ISLocalToGlobalMappingRestoreInfo(el2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
451   ierr = PetscCalloc1(nv,&vcount);CHKERRQ(ierr);
452   ierr = PetscMalloc1(nv,&vneighs);CHKERRQ(ierr);
453   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
454   for (i=1,cum=0;i<n_neigh;i++) {
455     cum += n_shared[i];
456     for (j=0;j<n_shared[i];j++) {
457       vcount[shared[i][j]]++;
458     }
459   }
460   if (nv) {
461     ierr = PetscMalloc1(cum,&vneighs[0]);CHKERRQ(ierr);
462   }
463   for (i=1;i<nv;i++) vneighs[i] = vneighs[i-1] + vcount[i-1];
464   ierr = PetscMemzero(vcount,nv*sizeof(PetscInt));CHKERRQ(ierr);
465   for (i=1;i<n_neigh;i++) {
466     for (j=0;j<n_shared[i];j++) {
467       PetscInt k = shared[i][j];
468       vneighs[k][vcount[k]] = neigh[i];
469       vcount[k]++;
470     }
471   }
472   for (i=0;i<nv;i++) {
473     ierr = PetscSortRemoveDupsInt(&vcount[i],vneighs[i]);CHKERRQ(ierr);
474   }
475   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
476 
477   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
478      for proper detection of coarse edges' endpoints */
479   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
480   for (i=0;i<ne;i++) {
481     if ((ecount[i] > 1 && !PetscBTLookup(btbd,i)) || (ecount[i] == 1 && PetscBTLookup(btb,i))) {
482       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
483     }
484   }
485   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
486   if (!conforming) {
487     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
488     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
489   }
490   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
491   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
492   cum  = 0;
493   for (i=0;i<ne;i++) {
494     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
495     if (!PetscBTLookup(btee,i)) {
496       marks[cum++] = i;
497       continue;
498     }
499     /* set badly connected edge dofs as primal */
500     if (!conforming) {
501       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
502         marks[cum++] = i;
503         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
504         for (j=ii[i];j<ii[i+1];j++) {
505           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
506         }
507       } else {
508         /* every edge dofs should be connected trough a certain number of nodal dofs
509            to other edge dofs belonging to coarse edges
510            - at most 2 endpoints
511            - order-1 interior nodal dofs
512            - no undefined nodal dofs (nconn < order)
513         */
514         PetscInt ends = 0,ints = 0, undef = 0;
515         for (j=ii[i];j<ii[i+1];j++) {
516           PetscInt v = jj[j],k;
517           PetscInt nconn = iit[v+1]-iit[v];
518           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
519           if (nconn > order) ends++;
520           else if (nconn == order) ints++;
521           else undef++;
522         }
523         if (undef || ends > 2 || ints != order -1) {
524           marks[cum++] = i;
525           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
526           for (j=ii[i];j<ii[i+1];j++) {
527             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
528           }
529         }
530       }
531     }
532     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
533     if (!order && ii[i+1] != ii[i]) {
534       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
535       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
536     }
537   }
538   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
539   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
540   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
541   if (!conforming) {
542     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
543     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
544   }
545   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
546 
547   /* identify splitpoints and corner candidates */
548   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
549   if (print) {
550     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
551     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
552     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
553     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
554   }
555   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
556   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
557   for (i=0;i<nv;i++) {
558     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
559     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
560     if (!order) { /* variable order */
561       PetscReal vorder = 0.;
562 
563       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
564       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
565       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
566       ord  = 1;
567     }
568 #if defined(PETSC_USE_DEBUG)
569     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);
570 #endif
571     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
572       if (PetscBTLookup(btbd,jj[j])) {
573         bdir = PETSC_TRUE;
574         break;
575       }
576       if (vc != ecount[jj[j]]) {
577         sneighs = PETSC_FALSE;
578       } else {
579         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
580         for (k=0;k<vc;k++) {
581           if (vn[k] != en[k]) {
582             sneighs = PETSC_FALSE;
583             break;
584           }
585         }
586       }
587     }
588     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
589       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
590       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
591     } else if (test == ord) {
592       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
593         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
594         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
595       } else {
596         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
597         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
598       }
599     }
600   }
601   ierr = PetscFree(ecount);CHKERRQ(ierr);
602   ierr = PetscFree(vcount);CHKERRQ(ierr);
603   if (ne) {
604     ierr = PetscFree(eneighs[0]);CHKERRQ(ierr);
605   }
606   if (nv) {
607     ierr = PetscFree(vneighs[0]);CHKERRQ(ierr);
608   }
609   ierr = PetscFree(eneighs);CHKERRQ(ierr);
610   ierr = PetscFree(vneighs);CHKERRQ(ierr);
611   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
612 
613   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
614   if (order != 1) {
615     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
616     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
617     for (i=0;i<nv;i++) {
618       if (PetscBTLookup(btvcand,i)) {
619         PetscBool found = PETSC_FALSE;
620         for (j=ii[i];j<ii[i+1] && !found;j++) {
621           PetscInt k,e = jj[j];
622           if (PetscBTLookup(bte,e)) continue;
623           for (k=iit[e];k<iit[e+1];k++) {
624             PetscInt v = jjt[k];
625             if (v != i && PetscBTLookup(btvcand,v)) {
626               found = PETSC_TRUE;
627               break;
628             }
629           }
630         }
631         if (!found) {
632           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
633           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
634         } else {
635           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
636         }
637       }
638     }
639     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
640   }
641   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
642   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
643   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
644 
645   /* Get the local G^T explicitly */
646   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
647   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
648   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
649 
650   /* Mark interior nodal dofs */
651   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
652   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
653   for (i=1;i<n_neigh;i++) {
654     for (j=0;j<n_shared[i];j++) {
655       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
656     }
657   }
658   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
659 
660   /* communicate corners and splitpoints */
661   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
662   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
663   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
664   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
665 
666   if (print) {
667     IS tbz;
668 
669     cum = 0;
670     for (i=0;i<nv;i++)
671       if (sfvleaves[i])
672         vmarks[cum++] = i;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679 
680   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
681   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
682   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
683   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
684 
685   /* Zero rows of lGt corresponding to identified corners
686      and interior nodal dofs */
687   cum = 0;
688   for (i=0;i<nv;i++) {
689     if (sfvleaves[i]) {
690       vmarks[cum++] = i;
691       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
692     }
693     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
694   }
695   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
696   if (print) {
697     IS tbz;
698 
699     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
700     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
701     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
702     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
703   }
704   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
705   ierr = PetscFree(vmarks);CHKERRQ(ierr);
706   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
707   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
708 
709   /* Recompute G */
710   ierr = MatDestroy(&lG);CHKERRQ(ierr);
711   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
712   if (print) {
713     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
714     ierr = MatView(lG,NULL);CHKERRQ(ierr);
715     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
716     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
717   }
718 
719   /* Get primal dofs (if any) */
720   cum = 0;
721   for (i=0;i<ne;i++) {
722     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
723   }
724   if (fl2g) {
725     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
726   }
727   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
728   if (print) {
729     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
730     ierr = ISView(primals,NULL);CHKERRQ(ierr);
731   }
732   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
733   /* TODO: what if the user passed in some of them ?  */
734   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
735   ierr = ISDestroy(&primals);CHKERRQ(ierr);
736 
737   /* Compute edge connectivity */
738   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
739   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
740   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
741   if (fl2g) {
742     PetscBT   btf;
743     PetscInt  *iia,*jja,*iiu,*jju;
744     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
745 
746     /* create CSR for all local dofs */
747     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
748     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
749       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);
750       iiu = pcbddc->mat_graph->xadj;
751       jju = pcbddc->mat_graph->adjncy;
752     } else if (pcbddc->use_local_adj) {
753       rest = PETSC_TRUE;
754       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
755     } else {
756       free   = PETSC_TRUE;
757       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
758       iiu[0] = 0;
759       for (i=0;i<n;i++) {
760         iiu[i+1] = i+1;
761         jju[i]   = -1;
762       }
763     }
764 
765     /* import sizes of CSR */
766     iia[0] = 0;
767     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
768 
769     /* overwrite entries corresponding to the Nedelec field */
770     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
771     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
772     for (i=0;i<ne;i++) {
773       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
774       iia[idxs[i]+1] = ii[i+1]-ii[i];
775     }
776 
777     /* iia in CSR */
778     for (i=0;i<n;i++) iia[i+1] += iia[i];
779 
780     /* jja in CSR */
781     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
782     for (i=0;i<n;i++)
783       if (!PetscBTLookup(btf,i))
784         for (j=0;j<iiu[i+1]-iiu[i];j++)
785           jja[iia[i]+j] = jju[iiu[i]+j];
786 
787     /* map edge dofs connectivity */
788     if (jj) {
789       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
790       for (i=0;i<ne;i++) {
791         PetscInt e = idxs[i];
792         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
793       }
794     }
795     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
796     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
797     if (rest) {
798       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
799     }
800     if (free) {
801       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
802     }
803     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
804   } else {
805     if (jj) {
806       ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
807     }
808   }
809 
810   /* Analyze interface for edge dofs */
811   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
812 
813   /* Get coarse edges in the edge space */
814   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
815   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
816 
817   if (fl2g) {
818     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
819     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
820     for (i=0;i<nee;i++) {
821       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
822     }
823   } else {
824     eedges  = alleedges;
825     primals = allprimals;
826   }
827 
828   /* Mark fine edge dofs with their coarse edge id */
829   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
830   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
831   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
832   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
833   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
834   if (print) {
835     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
836     ierr = ISView(primals,NULL);CHKERRQ(ierr);
837   }
838 
839   maxsize = 0;
840   for (i=0;i<nee;i++) {
841     PetscInt size,mark = i+1;
842 
843     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
844     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
845     for (j=0;j<size;j++) marks[idxs[j]] = mark;
846     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
847     maxsize = PetscMax(maxsize,size);
848   }
849 
850   /* Find coarse edge endpoints */
851   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
852   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
853   for (i=0;i<nee;i++) {
854     PetscInt mark = i+1,size;
855 
856     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
857     if (!size && nedfieldlocal) continue;
858     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
859     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
860     if (print) {
861       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
862       ISView(eedges[i],NULL);
863     }
864     for (j=0;j<size;j++) {
865       PetscInt k, ee = idxs[j];
866       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
867       for (k=ii[ee];k<ii[ee+1];k++) {
868         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
869         if (PetscBTLookup(btv,jj[k])) {
870           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
871         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
872           PetscInt  k2;
873           PetscBool corner = PETSC_FALSE;
874           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
875             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]));
876             /* it's a corner if either is connected with an edge dof belonging to a different cc or
877                if the edge dof lie on the natural part of the boundary */
878             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
879               corner = PETSC_TRUE;
880               break;
881             }
882           }
883           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
884             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
885             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
886           } else {
887             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
888           }
889         }
890       }
891     }
892     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
893   }
894   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
895   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
896   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
897 
898   /* Reset marked primal dofs */
899   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
900   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
901   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
902   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
903 
904   /* Now use the initial lG */
905   ierr = MatDestroy(&lG);CHKERRQ(ierr);
906   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
907   lG   = lGinit;
908   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
909 
910   /* Compute extended cols indices */
911   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
912   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
913   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
914   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
915   i   *= maxsize;
916   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
917   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
918   eerr = PETSC_FALSE;
919   for (i=0;i<nee;i++) {
920     PetscInt size,found = 0;
921 
922     cum  = 0;
923     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
924     if (!size && nedfieldlocal) continue;
925     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
926     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
927     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
928     for (j=0;j<size;j++) {
929       PetscInt k,ee = idxs[j];
930       for (k=ii[ee];k<ii[ee+1];k++) {
931         PetscInt vv = jj[k];
932         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
933         else if (!PetscBTLookupSet(btvc,vv)) found++;
934       }
935     }
936     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
937     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
938     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
939     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
940     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
941     /* it may happen that endpoints are not defined at this point
942        if it is the case, mark this edge for a second pass */
943     if (cum != size -1 || found != 2) {
944       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
945       if (print) {
946         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
947         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
948         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
949         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
950       }
951       eerr = PETSC_TRUE;
952     }
953   }
954   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
955   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
956   if (done) {
957     PetscInt *newprimals;
958 
959     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
960     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
961     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
962     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
963     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
964     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
965     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
966     for (i=0;i<nee;i++) {
967       PetscBool has_candidates = PETSC_FALSE;
968       if (PetscBTLookup(bter,i)) {
969         PetscInt size,mark = i+1;
970 
971         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
972         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
973         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
974         for (j=0;j<size;j++) {
975           PetscInt k,ee = idxs[j];
976           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
977           for (k=ii[ee];k<ii[ee+1];k++) {
978             /* set all candidates located on the edge as corners */
979             if (PetscBTLookup(btvcand,jj[k])) {
980               PetscInt k2,vv = jj[k];
981               has_candidates = PETSC_TRUE;
982               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
983               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
984               /* set all edge dofs connected to candidate as primals */
985               for (k2=iit[vv];k2<iit[vv+1];k2++) {
986                 if (marks[jjt[k2]] == mark) {
987                   PetscInt k3,ee2 = jjt[k2];
988                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
989                   newprimals[cum++] = ee2;
990                   /* finally set the new corners */
991                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
992                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
993                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
994                   }
995                 }
996               }
997             } else {
998               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
999             }
1000           }
1001         }
1002         if (!has_candidates) { /* circular edge */
1003           PetscInt k, ee = idxs[0],*tmarks;
1004 
1005           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
1006           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
1007           for (k=ii[ee];k<ii[ee+1];k++) {
1008             PetscInt k2;
1009             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
1010             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
1011             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
1012           }
1013           for (j=0;j<size;j++) {
1014             if (tmarks[idxs[j]] > 1) {
1015               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
1016               newprimals[cum++] = idxs[j];
1017             }
1018           }
1019           ierr = PetscFree(tmarks);CHKERRQ(ierr);
1020         }
1021         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1022       }
1023       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1024     }
1025     ierr = PetscFree(extcols);CHKERRQ(ierr);
1026     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1027     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1028     if (fl2g) {
1029       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1030       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1031       for (i=0;i<nee;i++) {
1032         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1033       }
1034       ierr = PetscFree(eedges);CHKERRQ(ierr);
1035     }
1036     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1037     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1038     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1039     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1040     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1041     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1042     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1043     if (fl2g) {
1044       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1045       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1046       for (i=0;i<nee;i++) {
1047         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1048       }
1049     } else {
1050       eedges  = alleedges;
1051       primals = allprimals;
1052     }
1053     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1054 
1055     /* Mark again */
1056     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1057     for (i=0;i<nee;i++) {
1058       PetscInt size,mark = i+1;
1059 
1060       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1061       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1062       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1063       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1064     }
1065     if (print) {
1066       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1067       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1068     }
1069 
1070     /* Recompute extended cols */
1071     eerr = PETSC_FALSE;
1072     for (i=0;i<nee;i++) {
1073       PetscInt size;
1074 
1075       cum  = 0;
1076       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1077       if (!size && nedfieldlocal) continue;
1078       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1079       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1080       for (j=0;j<size;j++) {
1081         PetscInt k,ee = idxs[j];
1082         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1083       }
1084       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1085       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1086       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1087       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1088       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1089       if (cum != size -1) {
1090         if (print) {
1091           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1092           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1093           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1094           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1095         }
1096         eerr = PETSC_TRUE;
1097       }
1098     }
1099   }
1100   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1101   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1102   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1103   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1104   /* an error should not occur at this point */
1105   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1106 
1107   /* Check the number of endpoints */
1108   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1109   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1110   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1111   for (i=0;i<nee;i++) {
1112     PetscInt size, found = 0, gc[2];
1113 
1114     /* init with defaults */
1115     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1116     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1117     if (!size && nedfieldlocal) continue;
1118     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1119     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1120     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1121     for (j=0;j<size;j++) {
1122       PetscInt k,ee = idxs[j];
1123       for (k=ii[ee];k<ii[ee+1];k++) {
1124         PetscInt vv = jj[k];
1125         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1126           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1127           corners[i*2+found++] = vv;
1128         }
1129       }
1130     }
1131     if (found != 2) {
1132       PetscInt e;
1133       if (fl2g) {
1134         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1135       } else {
1136         e = idxs[0];
1137       }
1138       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1139     }
1140 
1141     /* get primal dof index on this coarse edge */
1142     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1143     if (gc[0] > gc[1]) {
1144       PetscInt swap  = corners[2*i];
1145       corners[2*i]   = corners[2*i+1];
1146       corners[2*i+1] = swap;
1147     }
1148     cedges[i] = idxs[size-1];
1149     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1150     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1151   }
1152   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1153   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1154 
1155 #if defined(PETSC_USE_DEBUG)
1156   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1157      not interfere with neighbouring coarse edges */
1158   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1159   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1160   for (i=0;i<nv;i++) {
1161     PetscInt emax = 0,eemax = 0;
1162 
1163     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1164     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1165     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1166     for (j=1;j<nee+1;j++) {
1167       if (emax < emarks[j]) {
1168         emax = emarks[j];
1169         eemax = j;
1170       }
1171     }
1172     /* not relevant for edges */
1173     if (!eemax) continue;
1174 
1175     for (j=ii[i];j<ii[i+1];j++) {
1176       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1177         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]);
1178       }
1179     }
1180   }
1181   ierr = PetscFree(emarks);CHKERRQ(ierr);
1182   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1183 #endif
1184 
1185   /* Compute extended rows indices for edge blocks of the change of basis */
1186   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1188   extmem *= maxsize;
1189   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1190   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1191   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1192   for (i=0;i<nv;i++) {
1193     PetscInt mark = 0,size,start;
1194     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1195     for (j=ii[i];j<ii[i+1];j++)
1196       if (marks[jj[j]] && !mark)
1197         mark = marks[jj[j]];
1198 
1199     /* not relevant */
1200     if (!mark) continue;
1201 
1202     /* import extended row */
1203     mark--;
1204     start = mark*extmem+extrowcum[mark];
1205     size = ii[i+1]-ii[i];
1206     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1207     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1208     extrowcum[mark] += size;
1209   }
1210   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1211   cum  = 0;
1212   for (i=0;i<nee;i++) {
1213     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1214     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1215     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1216     cum  = PetscMax(cum,size);
1217   }
1218   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1219   ierr = PetscFree(marks);CHKERRQ(ierr);
1220   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1221   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1222 
1223   /* Workspace for lapack inner calls and VecSetValues */
1224   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1225 
1226   /* Create change of basis matrix (preallocation can be improved) */
1227   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1228   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1229                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1230   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1231   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1232   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1233   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1234   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1235   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1236   ierr = MatSetOption(T,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE);CHKERRQ(ierr);
1237 
1238   /* Defaults to identity */
1239   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1240   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1241   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1242   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1243 
1244   /* Create discrete gradient for the coarser level if needed */
1245   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1246   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1247   if (pcbddc->current_level < pcbddc->max_levels) {
1248     ISLocalToGlobalMapping cel2g,cvl2g;
1249     IS                     wis,gwis;
1250     PetscInt               cnv,cne;
1251 
1252     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1253     if (fl2g) {
1254       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1255     } else {
1256       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1257       pcbddc->nedclocal = wis;
1258     }
1259     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1260     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1261     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1262     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1263     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1264     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1265 
1266     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1267     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1268     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1269     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1270     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1271     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1272     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1273 
1274     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1275     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1276     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1277     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1278     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1279     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1280     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1281     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1282   }
1283 
1284 #if defined(PRINT_GDET)
1285   inc = 0;
1286   lev = pcbddc->current_level;
1287 #endif
1288   for (i=0;i<nee;i++) {
1289     Mat         Gins = NULL, GKins = NULL;
1290     IS          cornersis = NULL;
1291     PetscScalar cvals[2];
1292 
1293     if (pcbddc->nedcG) {
1294       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1295     }
1296     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1297     if (Gins && GKins) {
1298       PetscScalar    *data;
1299       const PetscInt *rows,*cols;
1300       PetscInt       nrh,nch,nrc,ncc;
1301 
1302       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1303       /* H1 */
1304       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1305       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1306       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1307       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1308       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1309       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1310       /* complement */
1311       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1312       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1313       if (ncc + nch != nrc) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d",ncc,nch,nrc);
1314       if (ncc != 1 && pcbddc->nedcG) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the dicrete gradient for the next level with ncc %d",ncc);
1315       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1316       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1317       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1318 
1319       /* coarse discrete gradient */
1320       if (pcbddc->nedcG) {
1321         PetscInt cols[2];
1322 
1323         cols[0] = 2*i;
1324         cols[1] = 2*i+1;
1325         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1326       }
1327       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1328     }
1329     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1330     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1331     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1332     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1333     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1334   }
1335 
1336   /* Start assembling */
1337   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1338   if (pcbddc->nedcG) {
1339     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1340   }
1341 
1342   /* Free */
1343   if (fl2g) {
1344     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1345     for (i=0;i<nee;i++) {
1346       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1347     }
1348     ierr = PetscFree(eedges);CHKERRQ(ierr);
1349   }
1350 
1351   /* hack mat_graph with primal dofs on the coarse edges */
1352   {
1353     PCBDDCGraph graph   = pcbddc->mat_graph;
1354     PetscInt    *oqueue = graph->queue;
1355     PetscInt    *ocptr  = graph->cptr;
1356     PetscInt    ncc,*idxs;
1357 
1358     /* find first primal edge */
1359     if (pcbddc->nedclocal) {
1360       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1361     } else {
1362       if (fl2g) {
1363         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1364       }
1365       idxs = cedges;
1366     }
1367     cum = 0;
1368     while (cum < nee && cedges[cum] < 0) cum++;
1369 
1370     /* adapt connected components */
1371     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1372     graph->cptr[0] = 0;
1373     for (i=0,ncc=0;i<graph->ncc;i++) {
1374       PetscInt lc = ocptr[i+1]-ocptr[i];
1375       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1376         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1377         graph->queue[graph->cptr[ncc]] = cedges[cum];
1378         ncc++;
1379         lc--;
1380         cum++;
1381         while (cum < nee && cedges[cum] < 0) cum++;
1382       }
1383       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1384       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1385       ncc++;
1386     }
1387     graph->ncc = ncc;
1388     if (pcbddc->nedclocal) {
1389       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1390     }
1391     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1392   }
1393   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1394   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1395 
1396 
1397   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1398   ierr = PetscFree(extrow);CHKERRQ(ierr);
1399   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1400   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1401   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1402   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1403   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1404   ierr = PetscFree(corners);CHKERRQ(ierr);
1405   ierr = PetscFree(cedges);CHKERRQ(ierr);
1406   ierr = PetscFree(extrows);CHKERRQ(ierr);
1407   ierr = PetscFree(extcols);CHKERRQ(ierr);
1408   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1409   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1410   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1411 
1412   /* Complete assembling */
1413   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1414   if (pcbddc->nedcG) {
1415     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1416 #if 0
1417     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1418     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1419 #endif
1420   }
1421 
1422   /* set change of basis */
1423   ierr = PCBDDCSetChangeOfBasisMat(pc,T,PETSC_FALSE);CHKERRQ(ierr);
1424 #if 0
1425   if (pcbddc->current_level) {
1426     PetscViewer viewer;
1427     char filename[256];
1428     Mat  Tned;
1429     IS   sub;
1430     PetscInt rst;
1431 
1432     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
1433     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
1434     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
1435     if (nedfieldlocal) {
1436       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
1437       for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
1438       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
1439     } else {
1440       for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
1441     }
1442     ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
1443     ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
1444     ierr = MatGetOwnershipRange(pc->pmat,&rst,NULL);CHKERRQ(ierr);
1445     for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
1446       if (matis->sf_rootdata[i]) {
1447         matis->sf_rootdata[cum++] = i + rst;
1448       }
1449     }
1450     PetscPrintf(PETSC_COMM_SELF,"[%D] LEVEL %d MY ne %d cum %d\n",PetscGlobalRank,pcbddc->current_level,ne,cum);
1451     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cum,matis->sf_rootdata,PETSC_USE_POINTER,&sub);CHKERRQ(ierr);
1452     ierr = MatGetSubMatrix(T,sub,sub,MAT_INITIAL_MATRIX,&Tned);CHKERRQ(ierr);
1453     ierr = ISDestroy(&sub);CHKERRQ(ierr);
1454 
1455     sprintf(filename,"Change_l%d.m",pcbddc->current_level);
1456     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)Tned),filename,&viewer);CHKERRQ(ierr);
1457     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
1458     ierr = PetscObjectSetName((PetscObject)Tned,"T");CHKERRQ(ierr);
1459     ierr = MatView(Tned,viewer);CHKERRQ(ierr);
1460     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
1461     ierr = MatDestroy(&Tned);CHKERRQ(ierr);
1462   }
1463   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1464 #endif
1465   ierr = MatDestroy(&T);CHKERRQ(ierr);
1466 
1467   PetscFunctionReturn(0);
1468 }
1469 
1470 /* the near-null space of BDDC carries information on quadrature weights,
1471    and these can be collinear -> so cheat with MatNullSpaceCreate
1472    and create a suitable set of basis vectors first */
1473 #undef __FUNCT__
1474 #define __FUNCT__ "PCBDDCNullSpaceCreate"
1475 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1476 {
1477   PetscErrorCode ierr;
1478   PetscInt       i;
1479 
1480   PetscFunctionBegin;
1481   for (i=0;i<nvecs;i++) {
1482     PetscInt first,last;
1483 
1484     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1485     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1486     if (i>=first && i < last) {
1487       PetscScalar *data;
1488       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1489       if (!has_const) {
1490         data[i-first] = 1.;
1491       } else {
1492         data[2*i-first] = 1./PetscSqrtReal(2.);
1493         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1494       }
1495       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1496     }
1497     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1498   }
1499   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1500   for (i=0;i<nvecs;i++) { /* reset vectors */
1501     PetscInt first,last;
1502     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1503     if (i>=first && i < last) {
1504       PetscScalar *data;
1505       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1506       if (!has_const) {
1507         data[i-first] = 0.;
1508       } else {
1509         data[2*i-first] = 0.;
1510         data[2*i-first+1] = 0.;
1511       }
1512       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1513     }
1514     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1515   }
1516   PetscFunctionReturn(0);
1517 }
1518 
1519 #undef __FUNCT__
1520 #define __FUNCT__ "PCBDDCComputeNoNetFlux"
1521 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1522 {
1523   Mat                    loc_divudotp;
1524   Vec                    p,v,vins,quad_vec,*quad_vecs;
1525   ISLocalToGlobalMapping map;
1526   IS                     *faces,*edges;
1527   PetscScalar            *vals;
1528   const PetscScalar      *array;
1529   PetscInt               i,maxneighs,lmaxneighs,maxsize,nf,ne;
1530   PetscMPIInt            rank;
1531   PetscErrorCode         ierr;
1532 
1533   PetscFunctionBegin;
1534   ierr = PCBDDCGraphGetCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1535   if (graph->twodim) {
1536     lmaxneighs = 2;
1537   } else {
1538     lmaxneighs = 1;
1539     for (i=0;i<ne;i++) {
1540       const PetscInt *idxs;
1541       ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1542       lmaxneighs = PetscMax(lmaxneighs,graph->count[idxs[0]]);
1543       ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1544     }
1545     lmaxneighs++; /* graph count does not include self */
1546   }
1547   ierr = MPIU_Allreduce(&lmaxneighs,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1548   maxsize = 0;
1549   for (i=0;i<ne;i++) {
1550     PetscInt nn;
1551     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1552     maxsize = PetscMax(maxsize,nn);
1553   }
1554   for (i=0;i<nf;i++) {
1555     PetscInt nn;
1556     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1557     maxsize = PetscMax(maxsize,nn);
1558   }
1559   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1560   /* create vectors to hold quadrature weights */
1561   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1562   if (!transpose) {
1563     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1564   } else {
1565     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1566   }
1567   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1568   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1569   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1570   for (i=0;i<maxneighs;i++) {
1571     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1572   }
1573 
1574   /* compute local quad vec */
1575   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1576   if (!transpose) {
1577     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1578   } else {
1579     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1580   }
1581   ierr = VecSet(p,1.);CHKERRQ(ierr);
1582   if (!transpose) {
1583     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1584   } else {
1585     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1586   }
1587   if (vl2l) {
1588     ierr = VecGetSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1589   } else {
1590     vins = v;
1591   }
1592   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1593   ierr = VecDestroy(&p);CHKERRQ(ierr);
1594 
1595   /* insert in global quadrature vecs */
1596   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1597   for (i=0;i<nf;i++) {
1598     const PetscInt    *idxs;
1599     PetscInt          idx,nn,j;
1600 
1601     ierr = ISGetIndices(faces[i],&idxs);CHKERRQ(ierr);
1602     ierr = ISGetLocalSize(faces[i],&nn);CHKERRQ(ierr);
1603     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1604     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1605     idx = -(idx+1);
1606     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1607     ierr = ISRestoreIndices(faces[i],&idxs);CHKERRQ(ierr);
1608   }
1609   for (i=0;i<ne;i++) {
1610     const PetscInt    *idxs;
1611     PetscInt          idx,nn,j;
1612 
1613     ierr = ISGetIndices(edges[i],&idxs);CHKERRQ(ierr);
1614     ierr = ISGetLocalSize(edges[i],&nn);CHKERRQ(ierr);
1615     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1616     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1617     idx = -(idx+1);
1618     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1619     ierr = ISRestoreIndices(edges[i],&idxs);CHKERRQ(ierr);
1620   }
1621   ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nf,&faces,&ne,&edges,NULL);CHKERRQ(ierr);
1622   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1623   if (vl2l) {
1624     ierr = VecRestoreSubVector(v,vl2l,&vins);CHKERRQ(ierr);
1625   }
1626   ierr = VecDestroy(&v);CHKERRQ(ierr);
1627   ierr = PetscFree(vals);CHKERRQ(ierr);
1628 
1629   /* assemble near null space */
1630   for (i=0;i<maxneighs;i++) {
1631     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1632   }
1633   for (i=0;i<maxneighs;i++) {
1634     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1635   }
1636   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1637   PetscFunctionReturn(0);
1638 }
1639 
1640 
1641 #undef __FUNCT__
1642 #define __FUNCT__ "PCBDDCComputeLocalTopologyInfo"
1643 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1644 {
1645   PetscErrorCode ierr;
1646   Vec            local,global;
1647   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1648   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1649 
1650   PetscFunctionBegin;
1651   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1652   /* need to convert from global to local topology information and remove references to information in global ordering */
1653   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1654   if (pcbddc->user_provided_isfordofs) {
1655     if (pcbddc->n_ISForDofs) {
1656       PetscInt i;
1657       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1658       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1659         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1660         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1661       }
1662       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1663       pcbddc->n_ISForDofs = 0;
1664       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1665     }
1666   } else {
1667     if (!pcbddc->n_ISForDofsLocal) { /* field split not present, create it in local ordering if bs > 1 */
1668       PetscInt i, n = matis->A->rmap->n;
1669       ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1670       if (i > 1) {
1671         pcbddc->n_ISForDofsLocal = i;
1672         ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1673         for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1674           ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1675         }
1676       }
1677     }
1678   }
1679 
1680   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1681     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1682   }
1683   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1684     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1685   }
1686   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1687     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1688   }
1689   ierr = VecDestroy(&global);CHKERRQ(ierr);
1690   ierr = VecDestroy(&local);CHKERRQ(ierr);
1691   PetscFunctionReturn(0);
1692 }
1693 
1694 #undef __FUNCT__
1695 #define __FUNCT__ "PCBDDCBenignRemoveInterior"
1696 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1697 {
1698   PC_IS             *pcis = (PC_IS*)(pc->data);
1699   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1700   PetscErrorCode    ierr;
1701 
1702   PetscFunctionBegin;
1703   if (!pcbddc->benign_have_null) {
1704     PetscFunctionReturn(0);
1705   }
1706   if (pcbddc->ChangeOfBasisMatrix) {
1707     Vec swap;
1708 
1709     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1710     swap = pcbddc->work_change;
1711     pcbddc->work_change = r;
1712     r = swap;
1713   }
1714   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1715   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1716   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1717   ierr = VecSet(z,0.);CHKERRQ(ierr);
1718   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1719   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1720   if (pcbddc->ChangeOfBasisMatrix) {
1721     pcbddc->work_change = r;
1722     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1723     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1724   }
1725   PetscFunctionReturn(0);
1726 }
1727 
1728 #undef __FUNCT__
1729 #define __FUNCT__ "PCBDDCBenignMatMult_Private_Private"
1730 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1731 {
1732   PCBDDCBenignMatMult_ctx ctx;
1733   PetscErrorCode          ierr;
1734   PetscBool               apply_right,apply_left,reset_x;
1735 
1736   PetscFunctionBegin;
1737   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1738   if (transpose) {
1739     apply_right = ctx->apply_left;
1740     apply_left = ctx->apply_right;
1741   } else {
1742     apply_right = ctx->apply_right;
1743     apply_left = ctx->apply_left;
1744   }
1745   reset_x = PETSC_FALSE;
1746   if (apply_right) {
1747     const PetscScalar *ax;
1748     PetscInt          nl,i;
1749 
1750     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1751     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1752     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1753     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1754     for (i=0;i<ctx->benign_n;i++) {
1755       PetscScalar    sum,val;
1756       const PetscInt *idxs;
1757       PetscInt       nz,j;
1758       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1759       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1760       sum = 0.;
1761       if (ctx->apply_p0) {
1762         val = ctx->work[idxs[nz-1]];
1763         for (j=0;j<nz-1;j++) {
1764           sum += ctx->work[idxs[j]];
1765           ctx->work[idxs[j]] += val;
1766         }
1767       } else {
1768         for (j=0;j<nz-1;j++) {
1769           sum += ctx->work[idxs[j]];
1770         }
1771       }
1772       ctx->work[idxs[nz-1]] -= sum;
1773       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1774     }
1775     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1776     reset_x = PETSC_TRUE;
1777   }
1778   if (transpose) {
1779     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1780   } else {
1781     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1782   }
1783   if (reset_x) {
1784     ierr = VecResetArray(x);CHKERRQ(ierr);
1785   }
1786   if (apply_left) {
1787     PetscScalar *ay;
1788     PetscInt    i;
1789 
1790     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1791     for (i=0;i<ctx->benign_n;i++) {
1792       PetscScalar    sum,val;
1793       const PetscInt *idxs;
1794       PetscInt       nz,j;
1795       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1796       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1797       val = -ay[idxs[nz-1]];
1798       if (ctx->apply_p0) {
1799         sum = 0.;
1800         for (j=0;j<nz-1;j++) {
1801           sum += ay[idxs[j]];
1802           ay[idxs[j]] += val;
1803         }
1804         ay[idxs[nz-1]] += sum;
1805       } else {
1806         for (j=0;j<nz-1;j++) {
1807           ay[idxs[j]] += val;
1808         }
1809         ay[idxs[nz-1]] = 0.;
1810       }
1811       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1812     }
1813     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1814   }
1815   PetscFunctionReturn(0);
1816 }
1817 
1818 #undef __FUNCT__
1819 #define __FUNCT__ "PCBDDCBenignMatMultTranspose_Private"
1820 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1821 {
1822   PetscErrorCode ierr;
1823 
1824   PetscFunctionBegin;
1825   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1826   PetscFunctionReturn(0);
1827 }
1828 
1829 #undef __FUNCT__
1830 #define __FUNCT__ "PCBDDCBenignMatMult_Private"
1831 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1832 {
1833   PetscErrorCode ierr;
1834 
1835   PetscFunctionBegin;
1836   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1837   PetscFunctionReturn(0);
1838 }
1839 
1840 #undef __FUNCT__
1841 #define __FUNCT__ "PCBDDCBenignShellMat"
1842 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1843 {
1844   PC_IS                   *pcis = (PC_IS*)pc->data;
1845   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1846   PCBDDCBenignMatMult_ctx ctx;
1847   PetscErrorCode          ierr;
1848 
1849   PetscFunctionBegin;
1850   if (!restore) {
1851     Mat                A_IB,A_BI;
1852     PetscScalar        *work;
1853     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1854 
1855     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1856     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1857     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1858     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1859     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1860     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1861     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1862     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1863     ierr = PetscNew(&ctx);CHKERRQ(ierr);
1864     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
1865     ctx->apply_left = PETSC_TRUE;
1866     ctx->apply_right = PETSC_FALSE;
1867     ctx->apply_p0 = PETSC_FALSE;
1868     ctx->benign_n = pcbddc->benign_n;
1869     if (reuse) {
1870       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
1871       ctx->free = PETSC_FALSE;
1872     } else { /* TODO: could be optimized for successive solves */
1873       ISLocalToGlobalMapping N_to_D;
1874       PetscInt               i;
1875 
1876       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
1877       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1878       for (i=0;i<pcbddc->benign_n;i++) {
1879         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1880       }
1881       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
1882       ctx->free = PETSC_TRUE;
1883     }
1884     ctx->A = pcis->A_IB;
1885     ctx->work = work;
1886     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
1887     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1888     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1889     pcis->A_IB = A_IB;
1890 
1891     /* A_BI as A_IB^T */
1892     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
1893     pcbddc->benign_original_mat = pcis->A_BI;
1894     pcis->A_BI = A_BI;
1895   } else {
1896     if (!pcbddc->benign_original_mat) {
1897       PetscFunctionReturn(0);
1898     }
1899     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
1900     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
1901     pcis->A_IB = ctx->A;
1902     ctx->A = NULL;
1903     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
1904     pcis->A_BI = pcbddc->benign_original_mat;
1905     pcbddc->benign_original_mat = NULL;
1906     if (ctx->free) {
1907       PetscInt i;
1908       for (i=0;i<ctx->benign_n;i++) {
1909         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
1910       }
1911       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
1912     }
1913     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
1914     ierr = PetscFree(ctx);CHKERRQ(ierr);
1915   }
1916   PetscFunctionReturn(0);
1917 }
1918 
1919 /* used just in bddc debug mode */
1920 #undef __FUNCT__
1921 #define __FUNCT__ "PCBDDCBenignProject"
1922 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
1923 {
1924   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1925   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1926   Mat            An;
1927   PetscErrorCode ierr;
1928 
1929   PetscFunctionBegin;
1930   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
1931   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
1932   if (is1) {
1933     ierr = MatGetSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
1934     ierr = MatDestroy(&An);CHKERRQ(ierr);
1935   } else {
1936     *B = An;
1937   }
1938   PetscFunctionReturn(0);
1939 }
1940 
1941 /* TODO: add reuse flag */
1942 #undef __FUNCT__
1943 #define __FUNCT__ "MatSeqAIJCompress"
1944 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
1945 {
1946   Mat            Bt;
1947   PetscScalar    *a,*bdata;
1948   const PetscInt *ii,*ij;
1949   PetscInt       m,n,i,nnz,*bii,*bij;
1950   PetscBool      flg_row;
1951   PetscErrorCode ierr;
1952 
1953   PetscFunctionBegin;
1954   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
1955   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
1956   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
1957   nnz = n;
1958   for (i=0;i<ii[n];i++) {
1959     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
1960   }
1961   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
1962   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
1963   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
1964   nnz = 0;
1965   bii[0] = 0;
1966   for (i=0;i<n;i++) {
1967     PetscInt j;
1968     for (j=ii[i];j<ii[i+1];j++) {
1969       PetscScalar entry = a[j];
1970       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || ij[j] == i) {
1971         bij[nnz] = ij[j];
1972         bdata[nnz] = entry;
1973         nnz++;
1974       }
1975     }
1976     bii[i+1] = nnz;
1977   }
1978   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
1979   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
1980   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
1981   {
1982     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
1983     b->free_a = PETSC_TRUE;
1984     b->free_ij = PETSC_TRUE;
1985   }
1986   *B = Bt;
1987   PetscFunctionReturn(0);
1988 }
1989 
1990 #undef __FUNCT__
1991 #define __FUNCT__ "MatDetectDisconnectedComponents"
1992 PetscErrorCode MatDetectDisconnectedComponents(Mat A, PetscBool filter, PetscInt *ncc, IS* cc[])
1993 {
1994   Mat                    B;
1995   IS                     is_dummy,*cc_n;
1996   ISLocalToGlobalMapping l2gmap_dummy;
1997   PCBDDCGraph            graph;
1998   PetscInt               i,n;
1999   PetscInt               *xadj,*adjncy;
2000   PetscInt               *xadj_filtered,*adjncy_filtered;
2001   PetscBool              flg_row,isseqaij;
2002   PetscErrorCode         ierr;
2003 
2004   PetscFunctionBegin;
2005   if (!A->rmap->N || !A->cmap->N) {
2006     *ncc = 0;
2007     *cc = NULL;
2008     PetscFunctionReturn(0);
2009   }
2010   ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2011   if (!isseqaij && filter) {
2012     PetscBool isseqdense;
2013 
2014     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2015     if (!isseqdense) {
2016       ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2017     } else { /* TODO: rectangular case and LDA */
2018       PetscScalar *array;
2019       PetscReal   chop=1.e-6;
2020 
2021       ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2022       ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2023       ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2024       for (i=0;i<n;i++) {
2025         PetscInt j;
2026         for (j=i+1;j<n;j++) {
2027           PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2028           if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2029           if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2030         }
2031       }
2032       ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2033       ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2034     }
2035   } else {
2036     B = A;
2037   }
2038   ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2039 
2040   /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2041   if (filter) {
2042     PetscScalar *data;
2043     PetscInt    j,cum;
2044 
2045     ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2046     ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2047     cum = 0;
2048     for (i=0;i<n;i++) {
2049       PetscInt t;
2050 
2051       for (j=xadj[i];j<xadj[i+1];j++) {
2052         if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2053           continue;
2054         }
2055         adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2056       }
2057       t = xadj_filtered[i];
2058       xadj_filtered[i] = cum;
2059       cum += t;
2060     }
2061     ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2062   } else {
2063     xadj_filtered = NULL;
2064     adjncy_filtered = NULL;
2065   }
2066 
2067   /* compute local connected components using PCBDDCGraph */
2068   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2069   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2070   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2071   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2072   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2073   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2074   if (xadj_filtered) {
2075     graph->xadj = xadj_filtered;
2076     graph->adjncy = adjncy_filtered;
2077   } else {
2078     graph->xadj = xadj;
2079     graph->adjncy = adjncy;
2080   }
2081   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2082   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2083   /* partial clean up */
2084   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2085   ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2086   if (A != B) {
2087     ierr = MatDestroy(&B);CHKERRQ(ierr);
2088   }
2089 
2090   /* get back data */
2091   if (ncc) *ncc = graph->ncc;
2092   if (cc) {
2093     ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2094     for (i=0;i<graph->ncc;i++) {
2095       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);
2096     }
2097     *cc = cc_n;
2098   }
2099   /* clean up graph */
2100   graph->xadj = 0;
2101   graph->adjncy = 0;
2102   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2103   PetscFunctionReturn(0);
2104 }
2105 
2106 #undef __FUNCT__
2107 #define __FUNCT__ "PCBDDCBenignCheck"
2108 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2109 {
2110   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2111   PC_IS*         pcis = (PC_IS*)(pc->data);
2112   IS             dirIS = NULL;
2113   PetscInt       i;
2114   PetscErrorCode ierr;
2115 
2116   PetscFunctionBegin;
2117   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2118   if (zerodiag) {
2119     Mat            A;
2120     Vec            vec3_N;
2121     PetscScalar    *vals;
2122     const PetscInt *idxs;
2123     PetscInt       nz,*count;
2124 
2125     /* p0 */
2126     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2127     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2128     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2129     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2130     for (i=0;i<nz;i++) vals[i] = 1.;
2131     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2132     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2133     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2134     /* v_I */
2135     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2136     for (i=0;i<nz;i++) vals[i] = 0.;
2137     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2138     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2139     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2140     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2141     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2142     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2143     if (dirIS) {
2144       PetscInt n;
2145 
2146       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2147       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2148       for (i=0;i<n;i++) vals[i] = 0.;
2149       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2150       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2151     }
2152     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2153     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2154     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2155     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2156     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2157     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2158     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2159     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]));
2160     ierr = PetscFree(vals);CHKERRQ(ierr);
2161     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2162 
2163     /* there should not be any pressure dofs lying on the interface */
2164     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2165     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2166     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2167     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2168     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2169     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]);
2170     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2171     ierr = PetscFree(count);CHKERRQ(ierr);
2172   }
2173   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2174 
2175   /* check PCBDDCBenignGetOrSetP0 */
2176   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2177   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2178   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2179   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2180   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2181   for (i=0;i<pcbddc->benign_n;i++) {
2182     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2183     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);
2184   }
2185   PetscFunctionReturn(0);
2186 }
2187 
2188 #undef __FUNCT__
2189 #define __FUNCT__ "PCBDDCBenignDetectSaddlePoint"
2190 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2191 {
2192   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2193   IS             pressures,zerodiag,*zerodiag_subs;
2194   PetscInt       nz,n;
2195   PetscInt       *interior_dofs,n_interior_dofs;
2196   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag;
2197   PetscErrorCode ierr;
2198 
2199   PetscFunctionBegin;
2200   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2201   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2202   for (n=0;n<pcbddc->benign_n;n++) {
2203     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2204   }
2205   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2206   pcbddc->benign_n = 0;
2207   /* if a local info on dofs is present, assumes that the last field represents  "pressures"
2208      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2209      Checks if all the pressure dofs in each subdomain have a zero diagonal
2210      If not, a change of basis on pressures is not needed
2211      since the local Schur complements are already SPD
2212   */
2213   has_null_pressures = PETSC_TRUE;
2214   have_null = PETSC_TRUE;
2215   if (pcbddc->n_ISForDofsLocal) {
2216     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2217 
2218     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2219     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2220     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2221     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2222     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2223     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2224     if (!sorted) {
2225       ierr = ISSort(pressures);CHKERRQ(ierr);
2226     }
2227   } else {
2228     pressures = NULL;
2229   }
2230   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2231   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2232   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2233   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2234   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2235   if (!sorted) {
2236     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2237   }
2238   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2239   if (!nz) {
2240     if (n) have_null = PETSC_FALSE;
2241     has_null_pressures = PETSC_FALSE;
2242     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2243   }
2244   recompute_zerodiag = PETSC_FALSE;
2245   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2246   zerodiag_subs = NULL;
2247   pcbddc->benign_n = 0;
2248   n_interior_dofs = 0;
2249   interior_dofs = NULL;
2250   if (pcbddc->current_level) { /* need to compute interior nodes */
2251     PetscInt n,i,j;
2252     PetscInt n_neigh,*neigh,*n_shared,**shared;
2253     PetscInt *iwork;
2254 
2255     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2256     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2257     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2258     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2259     for (i=1;i<n_neigh;i++)
2260       for (j=0;j<n_shared[i];j++)
2261           iwork[shared[i][j]] += 1;
2262     for (i=0;i<n;i++)
2263       if (!iwork[i])
2264         interior_dofs[n_interior_dofs++] = i;
2265     ierr = PetscFree(iwork);CHKERRQ(ierr);
2266     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2267   }
2268   if (has_null_pressures) {
2269     IS             *subs;
2270     PetscInt       nsubs,i,j,nl;
2271     const PetscInt *idxs;
2272     PetscScalar    *array;
2273     Vec            *work;
2274     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2275 
2276     subs = pcbddc->local_subs;
2277     nsubs = pcbddc->n_local_subs;
2278     /* 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) */
2279     if (pcbddc->current_level) {
2280       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2281       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2282       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2283       /* work[0] = 1_p */
2284       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2285       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2286       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2287       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2288       /* work[0] = 1_v */
2289       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2290       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2291       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2292       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2293       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2294     }
2295     if (nsubs > 1) {
2296       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2297       for (i=0;i<nsubs;i++) {
2298         ISLocalToGlobalMapping l2g;
2299         IS                     t_zerodiag_subs;
2300         PetscInt               nl;
2301 
2302         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2303         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2304         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2305         if (nl) {
2306           PetscBool valid = PETSC_TRUE;
2307 
2308           if (pcbddc->current_level) {
2309             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2310             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2311             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2312             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2313             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2314             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2315             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2316             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2317             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2318             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2319             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2320             for (j=0;j<n_interior_dofs;j++) {
2321               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2322                 valid = PETSC_FALSE;
2323                 break;
2324               }
2325             }
2326             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2327           }
2328           if (valid && pcbddc->NeumannBoundariesLocal) {
2329             IS       t_bc;
2330             PetscInt nzb;
2331 
2332             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pcbddc->NeumannBoundariesLocal,&t_bc);CHKERRQ(ierr);
2333             ierr = ISGetLocalSize(t_bc,&nzb);CHKERRQ(ierr);
2334             ierr = ISDestroy(&t_bc);CHKERRQ(ierr);
2335             if (nzb) valid = PETSC_FALSE;
2336           }
2337           if (valid && pressures) {
2338             IS t_pressure_subs;
2339             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2340             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2341             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2342           }
2343           if (valid) {
2344             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2345             pcbddc->benign_n++;
2346           } else {
2347             recompute_zerodiag = PETSC_TRUE;
2348           }
2349         }
2350         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2351         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2352       }
2353     } else { /* there's just one subdomain (or zero if they have not been detected */
2354       PetscBool valid = PETSC_TRUE;
2355 
2356       if (pcbddc->NeumannBoundariesLocal) {
2357         PetscInt nzb;
2358         ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nzb);CHKERRQ(ierr);
2359         if (nzb) valid = PETSC_FALSE;
2360       }
2361       if (valid && pressures) {
2362         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2363       }
2364       if (valid && pcbddc->current_level) {
2365         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2366         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2367         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2368         for (j=0;j<n_interior_dofs;j++) {
2369             if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2370               valid = PETSC_FALSE;
2371               break;
2372           }
2373         }
2374         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2375       }
2376       if (valid) {
2377         pcbddc->benign_n = 1;
2378         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2379         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2380         zerodiag_subs[0] = zerodiag;
2381       }
2382     }
2383     if (pcbddc->current_level) {
2384       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2385     }
2386   }
2387   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2388 
2389   if (!pcbddc->benign_n) {
2390     PetscInt n;
2391 
2392     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2393     recompute_zerodiag = PETSC_FALSE;
2394     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2395     if (n) {
2396       has_null_pressures = PETSC_FALSE;
2397       have_null = PETSC_FALSE;
2398     }
2399   }
2400 
2401   /* final check for null pressures */
2402   if (zerodiag && pressures) {
2403     PetscInt nz,np;
2404     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2405     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2406     if (nz != np) have_null = PETSC_FALSE;
2407   }
2408 
2409   if (recompute_zerodiag) {
2410     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2411     if (pcbddc->benign_n == 1) {
2412       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2413       zerodiag = zerodiag_subs[0];
2414     } else {
2415       PetscInt i,nzn,*new_idxs;
2416 
2417       nzn = 0;
2418       for (i=0;i<pcbddc->benign_n;i++) {
2419         PetscInt ns;
2420         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2421         nzn += ns;
2422       }
2423       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2424       nzn = 0;
2425       for (i=0;i<pcbddc->benign_n;i++) {
2426         PetscInt ns,*idxs;
2427         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2428         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2429         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2430         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2431         nzn += ns;
2432       }
2433       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2434       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2435     }
2436     have_null = PETSC_FALSE;
2437   }
2438 
2439   /* Prepare matrix to compute no-net-flux */
2440   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2441     Mat                    A,loc_divudotp;
2442     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2443     IS                     row,col,isused = NULL;
2444     PetscInt               M,N,n,st,n_isused;
2445 
2446     if (pressures) {
2447       isused = pressures;
2448     } else {
2449       isused = zerodiag;
2450     }
2451     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2452     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2453     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2454     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");
2455     n_isused = 0;
2456     if (isused) {
2457       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2458     }
2459     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2460     st = st-n_isused;
2461     if (n) {
2462       const PetscInt *gidxs;
2463 
2464       ierr = MatGetSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2465       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2466       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2467       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2468       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2469       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2470     } else {
2471       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2472       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2473       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2474     }
2475     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2476     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2477     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2478     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2479     ierr = ISDestroy(&row);CHKERRQ(ierr);
2480     ierr = ISDestroy(&col);CHKERRQ(ierr);
2481     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2482     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2483     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2484     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2485     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2486     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2487     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2488     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2489     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2490     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2491   }
2492 
2493   /* change of basis and p0 dofs */
2494   if (has_null_pressures) {
2495     IS             zerodiagc;
2496     const PetscInt *idxs,*idxsc;
2497     PetscInt       i,s,*nnz;
2498 
2499     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2500     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2501     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2502     /* local change of basis for pressures */
2503     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2504     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2505     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2506     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2507     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2508     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2509     for (i=0;i<pcbddc->benign_n;i++) {
2510       PetscInt nzs,j;
2511 
2512       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2513       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2514       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2515       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2516       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2517     }
2518     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2519     ierr = PetscFree(nnz);CHKERRQ(ierr);
2520     /* set identity on velocities */
2521     for (i=0;i<n-nz;i++) {
2522       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2523     }
2524     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2525     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2526     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2527     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2528     /* set change on pressures */
2529     for (s=0;s<pcbddc->benign_n;s++) {
2530       PetscScalar *array;
2531       PetscInt    nzs;
2532 
2533       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2534       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2535       for (i=0;i<nzs-1;i++) {
2536         PetscScalar vals[2];
2537         PetscInt    cols[2];
2538 
2539         cols[0] = idxs[i];
2540         cols[1] = idxs[nzs-1];
2541         vals[0] = 1.;
2542         vals[1] = 1.;
2543         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2544       }
2545       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2546       for (i=0;i<nzs-1;i++) array[i] = -1.;
2547       array[nzs-1] = 1.;
2548       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2549       /* store local idxs for p0 */
2550       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2551       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2552       ierr = PetscFree(array);CHKERRQ(ierr);
2553     }
2554     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2555     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2556     /* project if needed */
2557     if (pcbddc->benign_change_explicit) {
2558       Mat M;
2559 
2560       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2561       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2562       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2563       ierr = MatDestroy(&M);CHKERRQ(ierr);
2564     }
2565     /* store global idxs for p0 */
2566     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2567   }
2568   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2569   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2570 
2571   /* determines if the coarse solver will be singular or not */
2572   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2573   /* determines if the problem has subdomains with 0 pressure block */
2574   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2575   *zerodiaglocal = zerodiag;
2576   PetscFunctionReturn(0);
2577 }
2578 
2579 #undef __FUNCT__
2580 #define __FUNCT__ "PCBDDCBenignGetOrSetP0"
2581 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2582 {
2583   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2584   PetscScalar    *array;
2585   PetscErrorCode ierr;
2586 
2587   PetscFunctionBegin;
2588   if (!pcbddc->benign_sf) {
2589     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2590     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2591   }
2592   if (get) {
2593     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2594     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2595     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2596     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2597   } else {
2598     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2599     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2600     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2601     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2602   }
2603   PetscFunctionReturn(0);
2604 }
2605 
2606 #undef __FUNCT__
2607 #define __FUNCT__ "PCBDDCBenignPopOrPushB0"
2608 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2609 {
2610   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2611   PetscErrorCode ierr;
2612 
2613   PetscFunctionBegin;
2614   /* TODO: add error checking
2615     - avoid nested pop (or push) calls.
2616     - cannot push before pop.
2617     - cannot call this if pcbddc->local_mat is NULL
2618   */
2619   if (!pcbddc->benign_n) {
2620     PetscFunctionReturn(0);
2621   }
2622   if (pop) {
2623     if (pcbddc->benign_change_explicit) {
2624       IS       is_p0;
2625       MatReuse reuse;
2626 
2627       /* extract B_0 */
2628       reuse = MAT_INITIAL_MATRIX;
2629       if (pcbddc->benign_B0) {
2630         reuse = MAT_REUSE_MATRIX;
2631       }
2632       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2633       ierr = MatGetSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2634       /* remove rows and cols from local problem */
2635       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2636       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2637       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2638       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2639     } else {
2640       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2641       PetscScalar *vals;
2642       PetscInt    i,n,*idxs_ins;
2643 
2644       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2645       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2646       if (!pcbddc->benign_B0) {
2647         PetscInt *nnz;
2648         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2649         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2650         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2651         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2652         for (i=0;i<pcbddc->benign_n;i++) {
2653           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2654           nnz[i] = n - nnz[i];
2655         }
2656         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2657         ierr = PetscFree(nnz);CHKERRQ(ierr);
2658       }
2659 
2660       for (i=0;i<pcbddc->benign_n;i++) {
2661         PetscScalar *array;
2662         PetscInt    *idxs,j,nz,cum;
2663 
2664         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2665         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2666         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2667         for (j=0;j<nz;j++) vals[j] = 1.;
2668         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2669         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2670         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2671         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2672         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2673         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2674         cum = 0;
2675         for (j=0;j<n;j++) {
2676           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2677             vals[cum] = array[j];
2678             idxs_ins[cum] = j;
2679             cum++;
2680           }
2681         }
2682         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2683         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2684         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2685       }
2686       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2687       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2688       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2689     }
2690   } else { /* push */
2691     if (pcbddc->benign_change_explicit) {
2692       PetscInt i;
2693 
2694       for (i=0;i<pcbddc->benign_n;i++) {
2695         PetscScalar *B0_vals;
2696         PetscInt    *B0_cols,B0_ncol;
2697 
2698         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2699         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2700         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2701         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2702         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2703       }
2704       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2705       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2706     } else {
2707       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2708     }
2709   }
2710   PetscFunctionReturn(0);
2711 }
2712 
2713 #undef __FUNCT__
2714 #define __FUNCT__ "PCBDDCAdaptiveSelection"
2715 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
2716 {
2717   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
2718   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
2719   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
2720   PetscBLASInt    *B_iwork,*B_ifail;
2721   PetscScalar     *work,lwork;
2722   PetscScalar     *St,*S,*eigv;
2723   PetscScalar     *Sarray,*Starray;
2724   PetscReal       *eigs,thresh;
2725   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
2726   PetscBool       allocated_S_St;
2727 #if defined(PETSC_USE_COMPLEX)
2728   PetscReal       *rwork;
2729 #endif
2730   PetscErrorCode  ierr;
2731 
2732   PetscFunctionBegin;
2733   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
2734   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
2735   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);
2736 
2737   if (pcbddc->dbg_flag) {
2738     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
2739     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
2740     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
2741     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
2742   }
2743 
2744   if (pcbddc->dbg_flag) {
2745     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
2746   }
2747 
2748   /* max size of subsets */
2749   mss = 0;
2750   for (i=0;i<sub_schurs->n_subs;i++) {
2751     PetscInt subset_size;
2752 
2753     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2754     mss = PetscMax(mss,subset_size);
2755   }
2756 
2757   /* min/max and threshold */
2758   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
2759   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
2760   nmax = PetscMax(nmin,nmax);
2761   allocated_S_St = PETSC_FALSE;
2762   if (nmin) {
2763     allocated_S_St = PETSC_TRUE;
2764   }
2765 
2766   /* allocate lapack workspace */
2767   cum = cum2 = 0;
2768   maxneigs = 0;
2769   for (i=0;i<sub_schurs->n_subs;i++) {
2770     PetscInt n,subset_size;
2771 
2772     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2773     n = PetscMin(subset_size,nmax);
2774     cum += subset_size;
2775     cum2 += subset_size*n;
2776     maxneigs = PetscMax(maxneigs,n);
2777   }
2778   if (mss) {
2779     if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2780       PetscBLASInt B_itype = 1;
2781       PetscBLASInt B_N = mss;
2782       PetscReal    zero = 0.0;
2783       PetscReal    eps = 0.0; /* dlamch? */
2784 
2785       B_lwork = -1;
2786       S = NULL;
2787       St = NULL;
2788       eigs = NULL;
2789       eigv = NULL;
2790       B_iwork = NULL;
2791       B_ifail = NULL;
2792 #if defined(PETSC_USE_COMPLEX)
2793       rwork = NULL;
2794 #endif
2795       thresh = 1.0;
2796       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2797 #if defined(PETSC_USE_COMPLEX)
2798       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));
2799 #else
2800       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));
2801 #endif
2802       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
2803       ierr = PetscFPTrapPop();CHKERRQ(ierr);
2804     } else {
2805         /* TODO */
2806     }
2807   } else {
2808     lwork = 0;
2809   }
2810 
2811   nv = 0;
2812   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) */
2813     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
2814   }
2815   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
2816   if (allocated_S_St) {
2817     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
2818   }
2819   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
2820 #if defined(PETSC_USE_COMPLEX)
2821   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
2822 #endif
2823   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
2824                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
2825                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
2826                       nv+cum,&pcbddc->adaptive_constraints_idxs,
2827                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
2828   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
2829 
2830   maxneigs = 0;
2831   cum = cumarray = 0;
2832   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
2833   pcbddc->adaptive_constraints_data_ptr[0] = 0;
2834   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
2835     const PetscInt *idxs;
2836 
2837     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2838     for (cum=0;cum<nv;cum++) {
2839       pcbddc->adaptive_constraints_n[cum] = 1;
2840       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
2841       pcbddc->adaptive_constraints_data[cum] = 1.0;
2842       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
2843       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
2844     }
2845     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
2846   }
2847 
2848   if (mss) { /* multilevel */
2849     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
2850     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
2851   }
2852 
2853   thresh = pcbddc->adaptive_threshold;
2854   for (i=0;i<sub_schurs->n_subs;i++) {
2855     const PetscInt *idxs;
2856     PetscReal      upper,lower;
2857     PetscInt       j,subset_size,eigs_start = 0;
2858     PetscBLASInt   B_N;
2859     PetscBool      same_data = PETSC_FALSE;
2860 
2861     if (pcbddc->use_deluxe_scaling) {
2862       upper = PETSC_MAX_REAL;
2863       lower = thresh;
2864     } else {
2865       upper = 1./thresh;
2866       lower = 0.;
2867     }
2868     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
2869     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
2870     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
2871     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
2872       if (sub_schurs->is_hermitian) {
2873         PetscInt j,k;
2874         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
2875           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2876           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2877         }
2878         for (j=0;j<subset_size;j++) {
2879           for (k=j;k<subset_size;k++) {
2880             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2881             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2882           }
2883         }
2884       } else {
2885         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2886         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2887       }
2888     } else {
2889       S = Sarray + cumarray;
2890       St = Starray + cumarray;
2891     }
2892     /* see if we can save some work */
2893     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
2894       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
2895     }
2896 
2897     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
2898       B_neigs = 0;
2899     } else {
2900       if (sub_schurs->is_hermitian && sub_schurs->is_posdef) {
2901         PetscBLASInt B_itype = 1;
2902         PetscBLASInt B_IL, B_IU;
2903         PetscReal    eps = -1.0; /* dlamch? */
2904         PetscInt     nmin_s;
2905         PetscBool    compute_range = PETSC_FALSE;
2906 
2907         if (pcbddc->dbg_flag) {
2908           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]]);
2909         }
2910 
2911         compute_range = PETSC_FALSE;
2912         if (thresh > 1.+PETSC_SMALL && !same_data) {
2913           compute_range = PETSC_TRUE;
2914         }
2915 
2916         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2917         if (compute_range) {
2918 
2919           /* ask for eigenvalues larger than thresh */
2920 #if defined(PETSC_USE_COMPLEX)
2921           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));
2922 #else
2923           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));
2924 #endif
2925         } else if (!same_data) {
2926           B_IU = PetscMax(1,PetscMin(B_N,nmax));
2927           B_IL = 1;
2928 #if defined(PETSC_USE_COMPLEX)
2929           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));
2930 #else
2931           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));
2932 #endif
2933         } else { /* same_data is true, so just get the adaptive functional requested by the user */
2934           PetscInt k;
2935           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
2936           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
2937           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
2938           nmin = nmax;
2939           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
2940           for (k=0;k<nmax;k++) {
2941             eigs[k] = 1./PETSC_SMALL;
2942             eigv[k*(subset_size+1)] = 1.0;
2943           }
2944         }
2945         ierr = PetscFPTrapPop();CHKERRQ(ierr);
2946         if (B_ierr) {
2947           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
2948           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);
2949           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);
2950         }
2951 
2952         if (B_neigs > nmax) {
2953           if (pcbddc->dbg_flag) {
2954             PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);
2955           }
2956           if (pcbddc->use_deluxe_scaling) eigs_start = B_neigs -nmax;
2957           B_neigs = nmax;
2958         }
2959 
2960         nmin_s = PetscMin(nmin,B_N);
2961         if (B_neigs < nmin_s) {
2962           PetscBLASInt B_neigs2;
2963 
2964           if (pcbddc->use_deluxe_scaling) {
2965             B_IL = B_N - nmin_s + 1;
2966             B_IU = B_N - B_neigs;
2967           } else {
2968             B_IL = B_neigs + 1;
2969             B_IU = nmin_s;
2970           }
2971           if (pcbddc->dbg_flag) {
2972             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);
2973           }
2974           if (sub_schurs->is_hermitian) {
2975             PetscInt j,k;
2976             for (j=0;j<subset_size;j++) {
2977               for (k=j;k<subset_size;k++) {
2978                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
2979                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
2980               }
2981             }
2982           } else {
2983             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2984             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
2985           }
2986           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
2987 #if defined(PETSC_USE_COMPLEX)
2988           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));
2989 #else
2990           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));
2991 #endif
2992           ierr = PetscFPTrapPop();CHKERRQ(ierr);
2993           B_neigs += B_neigs2;
2994         }
2995         if (B_ierr) {
2996           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
2997           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);
2998           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);
2999         }
3000         if (pcbddc->dbg_flag) {
3001           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3002           for (j=0;j<B_neigs;j++) {
3003             if (eigs[j] == 0.0) {
3004               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3005             } else {
3006               if (pcbddc->use_deluxe_scaling) {
3007                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3008               } else {
3009                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3010               }
3011             }
3012           }
3013         }
3014       } else {
3015           /* TODO */
3016       }
3017     }
3018     /* change the basis back to the original one */
3019     if (sub_schurs->change) {
3020       Mat change,phi,phit;
3021 
3022       if (pcbddc->dbg_flag > 1) {
3023         PetscInt ii;
3024         for (ii=0;ii<B_neigs;ii++) {
3025           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3026           for (j=0;j<B_N;j++) {
3027 #if defined(PETSC_USE_COMPLEX)
3028             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3029             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3030             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3031 #else
3032             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3033 #endif
3034           }
3035         }
3036       }
3037       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3038       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3039       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3040       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3041       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3042       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3043     }
3044     maxneigs = PetscMax(B_neigs,maxneigs);
3045     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3046     if (B_neigs) {
3047       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);
3048 
3049       if (pcbddc->dbg_flag > 1) {
3050         PetscInt ii;
3051         for (ii=0;ii<B_neigs;ii++) {
3052           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3053           for (j=0;j<B_N;j++) {
3054 #if defined(PETSC_USE_COMPLEX)
3055             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3056             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3057             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3058 #else
3059             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3060 #endif
3061           }
3062         }
3063       }
3064       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3065       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3066       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3067       cum++;
3068     }
3069     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3070     /* shift for next computation */
3071     cumarray += subset_size*subset_size;
3072   }
3073   if (pcbddc->dbg_flag) {
3074     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3075   }
3076 
3077   if (mss) {
3078     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3079     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3080     /* destroy matrices (junk) */
3081     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3082     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3083   }
3084   if (allocated_S_St) {
3085     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3086   }
3087   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3088 #if defined(PETSC_USE_COMPLEX)
3089   ierr = PetscFree(rwork);CHKERRQ(ierr);
3090 #endif
3091   if (pcbddc->dbg_flag) {
3092     PetscInt maxneigs_r;
3093     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3094     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3095   }
3096   PetscFunctionReturn(0);
3097 }
3098 
3099 #undef __FUNCT__
3100 #define __FUNCT__ "PCBDDCSetUpSolvers"
3101 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3102 {
3103   PetscScalar    *coarse_submat_vals;
3104   PetscErrorCode ierr;
3105 
3106   PetscFunctionBegin;
3107   /* Setup local scatters R_to_B and (optionally) R_to_D */
3108   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3109   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3110 
3111   /* Setup local neumann solver ksp_R */
3112   /* PCBDDCSetUpLocalScatters should be called first! */
3113   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3114 
3115   /*
3116      Setup local correction and local part of coarse basis.
3117      Gives back the dense local part of the coarse matrix in column major ordering
3118   */
3119   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3120 
3121   /* Compute total number of coarse nodes and setup coarse solver */
3122   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3123 
3124   /* free */
3125   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3126   PetscFunctionReturn(0);
3127 }
3128 
3129 #undef __FUNCT__
3130 #define __FUNCT__ "PCBDDCResetCustomization"
3131 PetscErrorCode PCBDDCResetCustomization(PC pc)
3132 {
3133   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3134   PetscErrorCode ierr;
3135 
3136   PetscFunctionBegin;
3137   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3138   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3139   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3140   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3141   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3142   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3143   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3144   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3145   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3146   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3147   PetscFunctionReturn(0);
3148 }
3149 
3150 #undef __FUNCT__
3151 #define __FUNCT__ "PCBDDCResetTopography"
3152 PetscErrorCode PCBDDCResetTopography(PC pc)
3153 {
3154   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3155   PetscInt       i;
3156   PetscErrorCode ierr;
3157 
3158   PetscFunctionBegin;
3159   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3160   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3161   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3162   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3163   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3164   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3165   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3166   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3167   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3168   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3169   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
3170   ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
3171   for (i=0;i<pcbddc->n_local_subs;i++) {
3172     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3173   }
3174   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3175   if (pcbddc->sub_schurs) {
3176     ierr = PCBDDCSubSchursReset(pcbddc->sub_schurs);CHKERRQ(ierr);
3177   }
3178   pcbddc->graphanalyzed        = PETSC_FALSE;
3179   pcbddc->recompute_topography = PETSC_TRUE;
3180   PetscFunctionReturn(0);
3181 }
3182 
3183 #undef __FUNCT__
3184 #define __FUNCT__ "PCBDDCResetSolvers"
3185 PetscErrorCode PCBDDCResetSolvers(PC pc)
3186 {
3187   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3188   PetscErrorCode ierr;
3189 
3190   PetscFunctionBegin;
3191   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3192   if (pcbddc->coarse_phi_B) {
3193     PetscScalar *array;
3194     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3195     ierr = PetscFree(array);CHKERRQ(ierr);
3196   }
3197   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3198   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3199   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3200   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3201   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3202   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3203   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3204   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3205   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3206   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3207   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3208   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3209   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3210   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3211   ierr = KSPDestroy(&pcbddc->ksp_D);CHKERRQ(ierr);
3212   ierr = KSPDestroy(&pcbddc->ksp_R);CHKERRQ(ierr);
3213   ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
3214   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3215   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3216   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3217   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3218   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3219   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3220   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3221   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3222   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3223   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3224   if (pcbddc->benign_zerodiag_subs) {
3225     PetscInt i;
3226     for (i=0;i<pcbddc->benign_n;i++) {
3227       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3228     }
3229     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3230   }
3231   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3232   PetscFunctionReturn(0);
3233 }
3234 
3235 #undef __FUNCT__
3236 #define __FUNCT__ "PCBDDCSetUpLocalWorkVectors"
3237 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3238 {
3239   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3240   PC_IS          *pcis = (PC_IS*)pc->data;
3241   VecType        impVecType;
3242   PetscInt       n_constraints,n_R,old_size;
3243   PetscErrorCode ierr;
3244 
3245   PetscFunctionBegin;
3246   if (!pcbddc->ConstraintMatrix) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Constraint matrix has not been created");
3247   /* get sizes */
3248   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3249   n_R = pcis->n - pcbddc->n_vertices;
3250   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3251   /* local work vectors (try to avoid unneeded work)*/
3252   /* R nodes */
3253   old_size = -1;
3254   if (pcbddc->vec1_R) {
3255     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3256   }
3257   if (n_R != old_size) {
3258     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3259     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3260     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3261     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3262     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3263     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3264   }
3265   /* local primal dofs */
3266   old_size = -1;
3267   if (pcbddc->vec1_P) {
3268     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3269   }
3270   if (pcbddc->local_primal_size != old_size) {
3271     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3272     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3273     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3274     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3275   }
3276   /* local explicit constraints */
3277   old_size = -1;
3278   if (pcbddc->vec1_C) {
3279     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3280   }
3281   if (n_constraints && n_constraints != old_size) {
3282     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3283     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3284     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3285     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3286   }
3287   PetscFunctionReturn(0);
3288 }
3289 
3290 #undef __FUNCT__
3291 #define __FUNCT__ "PCBDDCSetUpCorrection"
3292 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3293 {
3294   PetscErrorCode  ierr;
3295   /* pointers to pcis and pcbddc */
3296   PC_IS*          pcis = (PC_IS*)pc->data;
3297   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3298   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3299   /* submatrices of local problem */
3300   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3301   /* submatrices of local coarse problem */
3302   Mat             S_VV,S_CV,S_VC,S_CC;
3303   /* working matrices */
3304   Mat             C_CR;
3305   /* additional working stuff */
3306   PC              pc_R;
3307   Mat             F;
3308   Vec             dummy_vec;
3309   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3310   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3311   PetscScalar     *work;
3312   PetscInt        *idx_V_B;
3313   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3314   PetscInt        i,n_R,n_D,n_B;
3315 
3316   /* some shortcuts to scalars */
3317   PetscScalar     one=1.0,m_one=-1.0;
3318 
3319   PetscFunctionBegin;
3320   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");
3321 
3322   /* Set Non-overlapping dimensions */
3323   n_vertices = pcbddc->n_vertices;
3324   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3325   n_B = pcis->n_B;
3326   n_D = pcis->n - n_B;
3327   n_R = pcis->n - n_vertices;
3328 
3329   /* vertices in boundary numbering */
3330   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3331   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3332   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3333 
3334   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3335   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3336   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3337   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3338   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3339   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3340   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3341   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3342   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3343   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3344 
3345   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3346   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3347   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3348   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3349   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3350   lda_rhs = n_R;
3351   need_benign_correction = PETSC_FALSE;
3352   if (isLU || isILU || isCHOL) {
3353     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3354   } else if (sub_schurs && sub_schurs->reuse_solver) {
3355     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3356     MatFactorType      type;
3357 
3358     F = reuse_solver->F;
3359     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3360     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3361     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3362     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3363   } else {
3364     F = NULL;
3365   }
3366 
3367   /* allocate workspace */
3368   n = 0;
3369   if (n_constraints) {
3370     n += lda_rhs*n_constraints;
3371   }
3372   if (n_vertices) {
3373     n = PetscMax(2*lda_rhs*n_vertices,n);
3374     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3375   }
3376   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3377 
3378   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3379   dummy_vec = NULL;
3380   if (need_benign_correction && lda_rhs != n_R && F) {
3381     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3382   }
3383 
3384   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3385   if (n_constraints) {
3386     Mat         M1,M2,M3,C_B;
3387     IS          is_aux;
3388     PetscScalar *array,*array2;
3389 
3390     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3391     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3392 
3393     /* Extract constraints on R nodes: C_{CR}  */
3394     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3395     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3396     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3397 
3398     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3399     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3400     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3401     for (i=0;i<n_constraints;i++) {
3402       const PetscScalar *row_cmat_values;
3403       const PetscInt    *row_cmat_indices;
3404       PetscInt          size_of_constraint,j;
3405 
3406       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3407       for (j=0;j<size_of_constraint;j++) {
3408         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3409       }
3410       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3411     }
3412     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3413     if (F) {
3414       Mat B;
3415 
3416       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3417       if (need_benign_correction) {
3418         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3419 
3420         /* rhs is already zero on interior dofs, no need to change the rhs */
3421         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3422       }
3423       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3424       if (need_benign_correction) {
3425         PetscScalar        *marr;
3426         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3427 
3428         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3429         if (lda_rhs != n_R) {
3430           for (i=0;i<n_constraints;i++) {
3431             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3432             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3433             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3434           }
3435         } else {
3436           for (i=0;i<n_constraints;i++) {
3437             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3438             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3439             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3440           }
3441         }
3442         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3443       }
3444       ierr = MatDestroy(&B);CHKERRQ(ierr);
3445     } else {
3446       PetscScalar *marr;
3447 
3448       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3449       for (i=0;i<n_constraints;i++) {
3450         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3451         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3452         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3453         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3454         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3455       }
3456       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3457     }
3458     if (!pcbddc->switch_static) {
3459       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3460       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3461       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3462       for (i=0;i<n_constraints;i++) {
3463         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3464         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3465         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3466         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3467         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3468         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3469       }
3470       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3471       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3472       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3473     } else {
3474       if (lda_rhs != n_R) {
3475         IS dummy;
3476 
3477         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3478         ierr = MatGetSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3479         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3480       } else {
3481         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3482         pcbddc->local_auxmat2 = local_auxmat2_R;
3483       }
3484       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3485     }
3486     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3487     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3488     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3489     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3490     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3491     if (isCHOL) {
3492       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3493     } else {
3494       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3495     }
3496     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3497     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3498     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3499     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3500     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3501     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3502     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3503     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3504     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3505     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3506   }
3507 
3508   /* Get submatrices from subdomain matrix */
3509   if (n_vertices) {
3510     IS is_aux;
3511 
3512     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3513       IS tis;
3514 
3515       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3516       ierr = ISSort(tis);CHKERRQ(ierr);
3517       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3518       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3519     } else {
3520       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3521     }
3522     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3523     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3524     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3525     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3526   }
3527 
3528   /* Matrix of coarse basis functions (local) */
3529   if (pcbddc->coarse_phi_B) {
3530     PetscInt on_B,on_primal,on_D=n_D;
3531     if (pcbddc->coarse_phi_D) {
3532       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3533     }
3534     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3535     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3536       PetscScalar *marray;
3537 
3538       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3539       ierr = PetscFree(marray);CHKERRQ(ierr);
3540       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3541       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3542       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3543       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3544     }
3545   }
3546 
3547   if (!pcbddc->coarse_phi_B) {
3548     PetscScalar *marray;
3549 
3550     n = n_B*pcbddc->local_primal_size;
3551     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3552       n += n_D*pcbddc->local_primal_size;
3553     }
3554     if (!pcbddc->symmetric_primal) {
3555       n *= 2;
3556     }
3557     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
3558     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3559     n = n_B*pcbddc->local_primal_size;
3560     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3561       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3562       n += n_D*pcbddc->local_primal_size;
3563     }
3564     if (!pcbddc->symmetric_primal) {
3565       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3566       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3567         n = n_B*pcbddc->local_primal_size;
3568         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3569       }
3570     } else {
3571       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3572       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3573       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3574         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3575         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3576       }
3577     }
3578   }
3579 
3580   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3581   p0_lidx_I = NULL;
3582   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3583     const PetscInt *idxs;
3584 
3585     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3586     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3587     for (i=0;i<pcbddc->benign_n;i++) {
3588       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3589     }
3590     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3591   }
3592 
3593   /* vertices */
3594   if (n_vertices) {
3595 
3596     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3597 
3598     if (n_R) {
3599       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3600       PetscBLASInt B_N,B_one = 1;
3601       PetscScalar  *x,*y;
3602       PetscBool    isseqaij;
3603 
3604       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3605       if (need_benign_correction) {
3606         ISLocalToGlobalMapping RtoN;
3607         IS                     is_p0;
3608         PetscInt               *idxs_p0,n;
3609 
3610         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3611         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3612         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3613         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);
3614         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3615         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3616         ierr = MatGetSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3617         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3618       }
3619 
3620       if (lda_rhs == n_R) {
3621         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3622       } else {
3623         PetscScalar    *av,*array;
3624         const PetscInt *xadj,*adjncy;
3625         PetscInt       n;
3626         PetscBool      flg_row;
3627 
3628         array = work+lda_rhs*n_vertices;
3629         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3630         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3631         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3632         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3633         for (i=0;i<n;i++) {
3634           PetscInt j;
3635           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3636         }
3637         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3638         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3639         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3640       }
3641       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3642       if (need_benign_correction) {
3643         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3644         PetscScalar        *marr;
3645 
3646         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3647         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3648 
3649                | 0 0  0 | (V)
3650            L = | 0 0 -1 | (P-p0)
3651                | 0 0 -1 | (p0)
3652 
3653         */
3654         for (i=0;i<reuse_solver->benign_n;i++) {
3655           const PetscScalar *vals;
3656           const PetscInt    *idxs,*idxs_zero;
3657           PetscInt          n,j,nz;
3658 
3659           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3660           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3661           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3662           for (j=0;j<n;j++) {
3663             PetscScalar val = vals[j];
3664             PetscInt    k,col = idxs[j];
3665             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3666           }
3667           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3668           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3669         }
3670         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3671       }
3672       if (F) {
3673         /* need to correct the rhs */
3674         if (need_benign_correction) {
3675           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3676           PetscScalar        *marr;
3677 
3678           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3679           if (lda_rhs != n_R) {
3680             for (i=0;i<n_vertices;i++) {
3681               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3682               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3683               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3684             }
3685           } else {
3686             for (i=0;i<n_vertices;i++) {
3687               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3688               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3689               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3690             }
3691           }
3692           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3693         }
3694         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3695         /* need to correct the solution */
3696         if (need_benign_correction) {
3697           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3698           PetscScalar        *marr;
3699 
3700           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3701           if (lda_rhs != n_R) {
3702             for (i=0;i<n_vertices;i++) {
3703               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3704               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3705               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3706             }
3707           } else {
3708             for (i=0;i<n_vertices;i++) {
3709               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3710               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3711               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3712             }
3713           }
3714           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3715         }
3716       } else {
3717         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3718         for (i=0;i<n_vertices;i++) {
3719           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3720           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3721           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3722           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3723           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3724         }
3725         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3726       }
3727       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3728       /* S_VV and S_CV */
3729       if (n_constraints) {
3730         Mat B;
3731 
3732         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3733         for (i=0;i<n_vertices;i++) {
3734           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3735           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3736           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3737           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3738           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3739           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3740         }
3741         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3742         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3743         ierr = MatDestroy(&B);CHKERRQ(ierr);
3744         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3745         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3746         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3747         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3748         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3749         ierr = MatDestroy(&B);CHKERRQ(ierr);
3750       }
3751       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3752       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3753         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3754       }
3755       if (lda_rhs != n_R) {
3756         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3757         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3758         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3759       }
3760       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3761       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3762       if (need_benign_correction) {
3763         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3764         PetscScalar      *marr,*sums;
3765 
3766         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3767         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3768         for (i=0;i<reuse_solver->benign_n;i++) {
3769           const PetscScalar *vals;
3770           const PetscInt    *idxs,*idxs_zero;
3771           PetscInt          n,j,nz;
3772 
3773           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3774           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3775           for (j=0;j<n_vertices;j++) {
3776             PetscInt k;
3777             sums[j] = 0.;
3778             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3779           }
3780           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3781           for (j=0;j<n;j++) {
3782             PetscScalar val = vals[j];
3783             PetscInt k;
3784             for (k=0;k<n_vertices;k++) {
3785               marr[idxs[j]+k*n_vertices] += val*sums[k];
3786             }
3787           }
3788           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3789           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3790         }
3791         ierr = PetscFree(sums);CHKERRQ(ierr);
3792         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3793         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3794       }
3795       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3796       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3797       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3798       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3799       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3800       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3801       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3802       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3803       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3804     } else {
3805       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3806     }
3807     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3808 
3809     /* coarse basis functions */
3810     for (i=0;i<n_vertices;i++) {
3811       PetscScalar *y;
3812 
3813       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3814       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3815       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3816       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3817       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3818       y[n_B*i+idx_V_B[i]] = 1.0;
3819       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3820       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3821 
3822       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3823         PetscInt j;
3824 
3825         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3826         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3827         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3828         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3829         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3830         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3831         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3832       }
3833       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3834     }
3835     /* if n_R == 0 the object is not destroyed */
3836     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3837   }
3838   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
3839 
3840   if (n_constraints) {
3841     Mat B;
3842 
3843     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3844     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3845     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3846     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3847     if (n_vertices) {
3848       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
3849         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
3850       } else {
3851         Mat S_VCt;
3852 
3853         if (lda_rhs != n_R) {
3854           ierr = MatDestroy(&B);CHKERRQ(ierr);
3855           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
3856           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
3857         }
3858         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
3859         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3860         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
3861       }
3862     }
3863     ierr = MatDestroy(&B);CHKERRQ(ierr);
3864     /* coarse basis functions */
3865     for (i=0;i<n_constraints;i++) {
3866       PetscScalar *y;
3867 
3868       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3869       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3870       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
3871       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3872       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3873       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3874       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3875       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3876         PetscInt j;
3877 
3878         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3879         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
3880         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3881         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3882         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3883         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3884         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3885       }
3886       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3887     }
3888   }
3889   if (n_constraints) {
3890     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
3891   }
3892   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
3893 
3894   /* coarse matrix entries relative to B_0 */
3895   if (pcbddc->benign_n) {
3896     Mat         B0_B,B0_BPHI;
3897     IS          is_dummy;
3898     PetscScalar *data;
3899     PetscInt    j;
3900 
3901     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
3902     ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
3903     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
3904     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
3905     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
3906     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
3907     for (j=0;j<pcbddc->benign_n;j++) {
3908       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
3909       for (i=0;i<pcbddc->local_primal_size;i++) {
3910         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
3911         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
3912       }
3913     }
3914     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
3915     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
3916     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
3917   }
3918 
3919   /* compute other basis functions for non-symmetric problems */
3920   if (!pcbddc->symmetric_primal) {
3921     Mat         B_V=NULL,B_C=NULL;
3922     PetscScalar *marray;
3923 
3924     if (n_constraints) {
3925       Mat S_CCT,C_CRT;
3926 
3927       ierr = MatTranspose(C_CR,MAT_INPLACE_MATRIX,&C_CRT);CHKERRQ(ierr);
3928       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
3929       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
3930       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
3931       if (n_vertices) {
3932         Mat S_VCT;
3933 
3934         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
3935         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
3936         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
3937       }
3938       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
3939     } else {
3940       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
3941     }
3942     if (n_vertices && n_R) {
3943       PetscScalar    *av,*marray;
3944       const PetscInt *xadj,*adjncy;
3945       PetscInt       n;
3946       PetscBool      flg_row;
3947 
3948       /* B_V = B_V - A_VR^T */
3949       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3950       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3951       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
3952       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
3953       for (i=0;i<n;i++) {
3954         PetscInt j;
3955         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
3956       }
3957       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
3958       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3959       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
3960     }
3961 
3962     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
3963     ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
3964     for (i=0;i<n_vertices;i++) {
3965       ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
3966       ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
3967       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3968       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3969       ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3970     }
3971     ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
3972     if (B_C) {
3973       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
3974       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
3975         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
3976         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
3977         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3978         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3979         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3980       }
3981       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
3982     }
3983     /* coarse basis functions */
3984     for (i=0;i<pcbddc->local_primal_size;i++) {
3985       PetscScalar *y;
3986 
3987       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
3988       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
3989       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3990       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3991       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3992       if (i<n_vertices) {
3993         y[n_B*i+idx_V_B[i]] = 1.0;
3994       }
3995       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
3996       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3997 
3998       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3999         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4000         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4001         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4002         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4003         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4004         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4005       }
4006       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4007     }
4008     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4009     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4010   }
4011   /* free memory */
4012   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4013   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4014   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4015   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4016   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4017   ierr = PetscFree(work);CHKERRQ(ierr);
4018   if (n_vertices) {
4019     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4020   }
4021   if (n_constraints) {
4022     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4023   }
4024   /* Checking coarse_sub_mat and coarse basis functios */
4025   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4026   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4027   if (pcbddc->dbg_flag) {
4028     Mat         coarse_sub_mat;
4029     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4030     Mat         coarse_phi_D,coarse_phi_B;
4031     Mat         coarse_psi_D,coarse_psi_B;
4032     Mat         A_II,A_BB,A_IB,A_BI;
4033     Mat         C_B,CPHI;
4034     IS          is_dummy;
4035     Vec         mones;
4036     MatType     checkmattype=MATSEQAIJ;
4037     PetscReal   real_value;
4038 
4039     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4040       Mat A;
4041       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4042       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4043       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4044       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4045       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4046       ierr = MatDestroy(&A);CHKERRQ(ierr);
4047     } else {
4048       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4049       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4050       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4051       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4052     }
4053     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4054     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4055     if (!pcbddc->symmetric_primal) {
4056       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4057       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4058     }
4059     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4060 
4061     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4062     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4063     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4064     if (!pcbddc->symmetric_primal) {
4065       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4066       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4067       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4068       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4069       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4070       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4071       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4072       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4073       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4074       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4075       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4076       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4077     } else {
4078       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4079       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4080       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4081       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4082       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4083       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4084       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4085       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4086     }
4087     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4088     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4089     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4090     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4091     if (pcbddc->benign_n) {
4092       Mat         B0_B,B0_BPHI;
4093       PetscScalar *data,*data2;
4094       PetscInt    j;
4095 
4096       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4097       ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4098       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4099       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4100       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4101       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4102       for (j=0;j<pcbddc->benign_n;j++) {
4103         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4104         for (i=0;i<pcbddc->local_primal_size;i++) {
4105           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4106           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4107         }
4108       }
4109       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4110       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4111       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4112       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4113       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4114     }
4115 #if 0
4116   {
4117     PetscViewer viewer;
4118     char filename[256];
4119     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4120     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4121     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4122     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4123     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4124     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4125     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4126     if (save_change) {
4127       Mat phi_B;
4128       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4129       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4130       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4131       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4132     } else {
4133       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4134       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4135     }
4136     if (pcbddc->coarse_phi_D) {
4137       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4138       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4139     }
4140     if (pcbddc->coarse_psi_B) {
4141       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4142       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4143     }
4144     if (pcbddc->coarse_psi_D) {
4145       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4146       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4147     }
4148     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4149   }
4150 #endif
4151     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4152     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4153     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4154     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4155 
4156     /* check constraints */
4157     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4158     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4159     if (!pcbddc->benign_n) { /* TODO: add benign case */
4160       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4161     } else {
4162       PetscScalar *data;
4163       Mat         tmat;
4164       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4165       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4166       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4167       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4168       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4169     }
4170     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4171     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4172     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4173     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4174     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4175     if (!pcbddc->symmetric_primal) {
4176       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4177       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4178       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4179       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4180       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4181     }
4182     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4183     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4184     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4185     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4186     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4187     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4188     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4189     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4190     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4191     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4192     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4193     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4194     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4195     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4196     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4197     if (!pcbddc->symmetric_primal) {
4198       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4199       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4200     }
4201     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4202   }
4203   /* get back data */
4204   *coarse_submat_vals_n = coarse_submat_vals;
4205   PetscFunctionReturn(0);
4206 }
4207 
4208 #undef __FUNCT__
4209 #define __FUNCT__ "MatGetSubMatrixUnsorted"
4210 PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4211 {
4212   Mat            *work_mat;
4213   IS             isrow_s,iscol_s;
4214   PetscBool      rsorted,csorted;
4215   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4216   PetscErrorCode ierr;
4217 
4218   PetscFunctionBegin;
4219   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4220   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4221   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4222   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4223 
4224   if (!rsorted) {
4225     const PetscInt *idxs;
4226     PetscInt *idxs_sorted,i;
4227 
4228     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4229     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4230     for (i=0;i<rsize;i++) {
4231       idxs_perm_r[i] = i;
4232     }
4233     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4234     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4235     for (i=0;i<rsize;i++) {
4236       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4237     }
4238     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4239     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4240   } else {
4241     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4242     isrow_s = isrow;
4243   }
4244 
4245   if (!csorted) {
4246     if (isrow == iscol) {
4247       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4248       iscol_s = isrow_s;
4249     } else {
4250       const PetscInt *idxs;
4251       PetscInt       *idxs_sorted,i;
4252 
4253       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4254       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4255       for (i=0;i<csize;i++) {
4256         idxs_perm_c[i] = i;
4257       }
4258       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4259       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4260       for (i=0;i<csize;i++) {
4261         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4262       }
4263       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4264       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4265     }
4266   } else {
4267     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4268     iscol_s = iscol;
4269   }
4270 
4271   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4272 
4273   if (!rsorted || !csorted) {
4274     Mat      new_mat;
4275     IS       is_perm_r,is_perm_c;
4276 
4277     if (!rsorted) {
4278       PetscInt *idxs_r,i;
4279       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4280       for (i=0;i<rsize;i++) {
4281         idxs_r[idxs_perm_r[i]] = i;
4282       }
4283       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4284       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4285     } else {
4286       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4287     }
4288     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4289 
4290     if (!csorted) {
4291       if (isrow_s == iscol_s) {
4292         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4293         is_perm_c = is_perm_r;
4294       } else {
4295         PetscInt *idxs_c,i;
4296         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4297         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4298         for (i=0;i<csize;i++) {
4299           idxs_c[idxs_perm_c[i]] = i;
4300         }
4301         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4302         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4303       }
4304     } else {
4305       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4306     }
4307     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4308 
4309     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4310     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4311     work_mat[0] = new_mat;
4312     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4313     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4314   }
4315 
4316   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4317   *B = work_mat[0];
4318   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4319   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4320   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4321   PetscFunctionReturn(0);
4322 }
4323 
4324 #undef __FUNCT__
4325 #define __FUNCT__ "PCBDDCComputeLocalMatrix"
4326 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4327 {
4328   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4329   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4330   Mat            new_mat;
4331   IS             is_local,is_global;
4332   PetscInt       local_size;
4333   PetscBool      isseqaij;
4334   PetscErrorCode ierr;
4335 
4336   PetscFunctionBegin;
4337   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4338   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4339   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4340   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4341   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4342   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4343   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4344 
4345   /* check */
4346   if (pcbddc->dbg_flag) {
4347     Vec       x,x_change;
4348     PetscReal error;
4349 
4350     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4351     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4352     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4353     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4354     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4355     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4356     if (!pcbddc->change_interior) {
4357       const PetscScalar *x,*y,*v;
4358       PetscReal         lerror = 0.;
4359       PetscInt          i;
4360 
4361       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4362       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4363       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4364       for (i=0;i<local_size;i++)
4365         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4366           lerror = PetscAbsScalar(x[i]-y[i]);
4367       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4368       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4369       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4370       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4371       if (error > PETSC_SMALL) {
4372         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4373           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4374         } else {
4375           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4376         }
4377       }
4378     }
4379     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4380     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4381     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4382     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4383     if (error > PETSC_SMALL) {
4384       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4385         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4386       } else {
4387         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4388       }
4389     }
4390     ierr = VecDestroy(&x);CHKERRQ(ierr);
4391     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4392   }
4393 
4394   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4395   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4396   if (isseqaij) {
4397     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4398     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4399   } else {
4400     Mat work_mat;
4401 
4402     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4403     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4404     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4405     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4406   }
4407   if (matis->A->symmetric_set) {
4408     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4409 #if !defined(PETSC_USE_COMPLEX)
4410     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4411 #endif
4412   }
4413   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4414   PetscFunctionReturn(0);
4415 }
4416 
4417 #undef __FUNCT__
4418 #define __FUNCT__ "PCBDDCSetUpLocalScatters"
4419 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4420 {
4421   PC_IS*          pcis = (PC_IS*)(pc->data);
4422   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4423   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4424   PetscInt        *idx_R_local=NULL;
4425   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4426   PetscInt        vbs,bs;
4427   PetscBT         bitmask=NULL;
4428   PetscErrorCode  ierr;
4429 
4430   PetscFunctionBegin;
4431   /*
4432     No need to setup local scatters if
4433       - primal space is unchanged
4434         AND
4435       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4436         AND
4437       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4438   */
4439   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4440     PetscFunctionReturn(0);
4441   }
4442   /* destroy old objects */
4443   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4444   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4445   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4446   /* Set Non-overlapping dimensions */
4447   n_B = pcis->n_B;
4448   n_D = pcis->n - n_B;
4449   n_vertices = pcbddc->n_vertices;
4450 
4451   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4452 
4453   /* create auxiliary bitmask and allocate workspace */
4454   if (!sub_schurs || !sub_schurs->reuse_solver) {
4455     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4456     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4457     for (i=0;i<n_vertices;i++) {
4458       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4459     }
4460 
4461     for (i=0, n_R=0; i<pcis->n; i++) {
4462       if (!PetscBTLookup(bitmask,i)) {
4463         idx_R_local[n_R++] = i;
4464       }
4465     }
4466   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4467     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4468 
4469     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4470     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4471   }
4472 
4473   /* Block code */
4474   vbs = 1;
4475   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4476   if (bs>1 && !(n_vertices%bs)) {
4477     PetscBool is_blocked = PETSC_TRUE;
4478     PetscInt  *vary;
4479     if (!sub_schurs || !sub_schurs->reuse_solver) {
4480       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4481       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4482       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4483       /* 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 */
4484       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4485       for (i=0; i<pcis->n/bs; i++) {
4486         if (vary[i]!=0 && vary[i]!=bs) {
4487           is_blocked = PETSC_FALSE;
4488           break;
4489         }
4490       }
4491       ierr = PetscFree(vary);CHKERRQ(ierr);
4492     } else {
4493       /* Verify directly the R set */
4494       for (i=0; i<n_R/bs; i++) {
4495         PetscInt j,node=idx_R_local[bs*i];
4496         for (j=1; j<bs; j++) {
4497           if (node != idx_R_local[bs*i+j]-j) {
4498             is_blocked = PETSC_FALSE;
4499             break;
4500           }
4501         }
4502       }
4503     }
4504     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4505       vbs = bs;
4506       for (i=0;i<n_R/vbs;i++) {
4507         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4508       }
4509     }
4510   }
4511   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4512   if (sub_schurs && sub_schurs->reuse_solver) {
4513     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4514 
4515     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4516     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4517     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4518     reuse_solver->is_R = pcbddc->is_R_local;
4519   } else {
4520     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4521   }
4522 
4523   /* print some info if requested */
4524   if (pcbddc->dbg_flag) {
4525     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4526     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4527     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4528     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4529     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4530     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);
4531     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4532   }
4533 
4534   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4535   if (!sub_schurs || !sub_schurs->reuse_solver) {
4536     IS       is_aux1,is_aux2;
4537     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4538 
4539     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4540     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4541     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4542     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4543     for (i=0; i<n_D; i++) {
4544       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4545     }
4546     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4547     for (i=0, j=0; i<n_R; i++) {
4548       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4549         aux_array1[j++] = i;
4550       }
4551     }
4552     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4553     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4554     for (i=0, j=0; i<n_B; i++) {
4555       if (!PetscBTLookup(bitmask,is_indices[i])) {
4556         aux_array2[j++] = i;
4557       }
4558     }
4559     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4560     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4561     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4562     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4563     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4564 
4565     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4566       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4567       for (i=0, j=0; i<n_R; i++) {
4568         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4569           aux_array1[j++] = i;
4570         }
4571       }
4572       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4573       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4574       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4575     }
4576     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4577     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4578   } else {
4579     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4580     IS                 tis;
4581     PetscInt           schur_size;
4582 
4583     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4584     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4585     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4586     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4587     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4588       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4589       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4590       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4591     }
4592   }
4593   PetscFunctionReturn(0);
4594 }
4595 
4596 
4597 #undef __FUNCT__
4598 #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
4599 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4600 {
4601   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4602   PC_IS          *pcis = (PC_IS*)pc->data;
4603   PC             pc_temp;
4604   Mat            A_RR;
4605   MatReuse       reuse;
4606   PetscScalar    m_one = -1.0;
4607   PetscReal      value;
4608   PetscInt       n_D,n_R;
4609   PetscBool      check_corr[2],issbaij;
4610   PetscErrorCode ierr;
4611   /* prefixes stuff */
4612   char           dir_prefix[256],neu_prefix[256],str_level[16];
4613   size_t         len;
4614 
4615   PetscFunctionBegin;
4616 
4617   /* compute prefixes */
4618   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4619   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4620   if (!pcbddc->current_level) {
4621     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4622     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4623     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4624     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4625   } else {
4626     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4627     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4628     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4629     len -= 15; /* remove "pc_bddc_coarse_" */
4630     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4631     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4632     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4633     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4634     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4635     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4636     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4637     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4638   }
4639 
4640   /* DIRICHLET PROBLEM */
4641   if (dirichlet) {
4642     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4643     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4644       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4645       if (pcbddc->dbg_flag) {
4646         Mat    A_IIn;
4647 
4648         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4649         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4650         pcis->A_II = A_IIn;
4651       }
4652     }
4653     if (pcbddc->local_mat->symmetric_set) {
4654       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4655     }
4656     /* Matrix for Dirichlet problem is pcis->A_II */
4657     n_D = pcis->n - pcis->n_B;
4658     if (!pcbddc->ksp_D) { /* create object if not yet build */
4659       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4660       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4661       /* default */
4662       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4663       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4664       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4665       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4666       if (issbaij) {
4667         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4668       } else {
4669         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4670       }
4671       /* Allow user's customization */
4672       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4673       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4674     }
4675     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4676     if (sub_schurs && sub_schurs->reuse_solver) {
4677       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4678 
4679       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4680     }
4681     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4682     if (!n_D) {
4683       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4684       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4685     }
4686     /* Set Up KSP for Dirichlet problem of BDDC */
4687     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4688     /* set ksp_D into pcis data */
4689     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4690     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4691     pcis->ksp_D = pcbddc->ksp_D;
4692   }
4693 
4694   /* NEUMANN PROBLEM */
4695   A_RR = 0;
4696   if (neumann) {
4697     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4698     PetscInt        ibs,mbs;
4699     PetscBool       issbaij;
4700     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4701     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4702     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4703     if (pcbddc->ksp_R) { /* already created ksp */
4704       PetscInt nn_R;
4705       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4706       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4707       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4708       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4709         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4710         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4711         reuse = MAT_INITIAL_MATRIX;
4712       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4713         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4714           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4715           reuse = MAT_INITIAL_MATRIX;
4716         } else { /* safe to reuse the matrix */
4717           reuse = MAT_REUSE_MATRIX;
4718         }
4719       }
4720       /* last check */
4721       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4722         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4723         reuse = MAT_INITIAL_MATRIX;
4724       }
4725     } else { /* first time, so we need to create the matrix */
4726       reuse = MAT_INITIAL_MATRIX;
4727     }
4728     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4729     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4730     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4731     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4732     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4733       if (matis->A == pcbddc->local_mat) {
4734         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4735         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4736       } else {
4737         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4738       }
4739     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4740       if (matis->A == pcbddc->local_mat) {
4741         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4742         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4743       } else {
4744         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4745       }
4746     }
4747     /* extract A_RR */
4748     if (sub_schurs && sub_schurs->reuse_solver) {
4749       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4750 
4751       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4752         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4753         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4754           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4755         } else {
4756           ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4757         }
4758       } else {
4759         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4760         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4761         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4762       }
4763     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4764       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4765     }
4766     if (pcbddc->local_mat->symmetric_set) {
4767       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4768     }
4769     if (!pcbddc->ksp_R) { /* create object if not present */
4770       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4771       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4772       /* default */
4773       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4774       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4775       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4776       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4777       if (issbaij) {
4778         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4779       } else {
4780         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4781       }
4782       /* Allow user's customization */
4783       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4784       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4785     }
4786     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4787     if (!n_R) {
4788       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4789       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4790     }
4791     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4792     /* Reuse solver if it is present */
4793     if (sub_schurs && sub_schurs->reuse_solver) {
4794       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4795 
4796       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4797     }
4798     /* Set Up KSP for Neumann problem of BDDC */
4799     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4800   }
4801 
4802   if (pcbddc->dbg_flag) {
4803     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4804     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4805     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4806   }
4807 
4808   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
4809   check_corr[0] = check_corr[1] = PETSC_FALSE;
4810   if (pcbddc->NullSpace_corr[0]) {
4811     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
4812   }
4813   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
4814     check_corr[0] = PETSC_TRUE;
4815     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
4816   }
4817   if (neumann && pcbddc->NullSpace_corr[2]) {
4818     check_corr[1] = PETSC_TRUE;
4819     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
4820   }
4821 
4822   /* check Dirichlet and Neumann solvers */
4823   if (pcbddc->dbg_flag) {
4824     if (dirichlet) { /* Dirichlet */
4825       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
4826       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
4827       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
4828       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
4829       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
4830       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);
4831       if (check_corr[0]) {
4832         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
4833       }
4834       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4835     }
4836     if (neumann) { /* Neumann */
4837       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
4838       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4839       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
4840       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
4841       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
4842       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);
4843       if (check_corr[1]) {
4844         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
4845       }
4846       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4847     }
4848   }
4849   /* free Neumann problem's matrix */
4850   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4851   PetscFunctionReturn(0);
4852 }
4853 
4854 #undef __FUNCT__
4855 #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
4856 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
4857 {
4858   PetscErrorCode  ierr;
4859   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4860   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4861   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
4862 
4863   PetscFunctionBegin;
4864   if (!reuse_solver) {
4865     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
4866   }
4867   if (!pcbddc->switch_static) {
4868     if (applytranspose && pcbddc->local_auxmat1) {
4869       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4870       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4871     }
4872     if (!reuse_solver) {
4873       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4874       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4875     } else {
4876       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4877 
4878       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4879       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4880     }
4881   } else {
4882     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4883     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4884     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4885     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4886     if (applytranspose && pcbddc->local_auxmat1) {
4887       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
4888       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4889       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4890       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4891     }
4892   }
4893   if (!reuse_solver || pcbddc->switch_static) {
4894     if (applytranspose) {
4895       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4896     } else {
4897       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4898     }
4899   } else {
4900     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4901 
4902     if (applytranspose) {
4903       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4904     } else {
4905       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4906     }
4907   }
4908   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
4909   if (!pcbddc->switch_static) {
4910     if (!reuse_solver) {
4911       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4912       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4913     } else {
4914       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4915 
4916       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4917       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4918     }
4919     if (!applytranspose && pcbddc->local_auxmat1) {
4920       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4921       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4922     }
4923   } else {
4924     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4925     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4926     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4927     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4928     if (!applytranspose && pcbddc->local_auxmat1) {
4929       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4930       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4931     }
4932     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4933     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4934     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4935     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4936   }
4937   PetscFunctionReturn(0);
4938 }
4939 
4940 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
4941 #undef __FUNCT__
4942 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
4943 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
4944 {
4945   PetscErrorCode ierr;
4946   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4947   PC_IS*            pcis = (PC_IS*)  (pc->data);
4948   const PetscScalar zero = 0.0;
4949 
4950   PetscFunctionBegin;
4951   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
4952   if (!pcbddc->benign_apply_coarse_only) {
4953     if (applytranspose) {
4954       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
4955       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
4956     } else {
4957       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
4958       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
4959     }
4960   } else {
4961     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
4962   }
4963 
4964   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
4965   if (pcbddc->benign_n) {
4966     PetscScalar *array;
4967     PetscInt    j;
4968 
4969     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
4970     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
4971     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
4972   }
4973 
4974   /* start communications from local primal nodes to rhs of coarse solver */
4975   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
4976   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4977   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4978 
4979   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
4980   if (pcbddc->coarse_ksp) {
4981     Mat          coarse_mat;
4982     Vec          rhs,sol;
4983     MatNullSpace nullsp;
4984     PetscBool    isbddc = PETSC_FALSE;
4985 
4986     if (pcbddc->benign_have_null) {
4987       PC        coarse_pc;
4988 
4989       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
4990       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
4991       /* we need to propagate to coarser levels the need for a possible benign correction */
4992       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
4993         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
4994         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
4995         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
4996       }
4997     }
4998     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
4999     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5000     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5001     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5002     if (nullsp) {
5003       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5004     }
5005     if (applytranspose) {
5006       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5007       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5008     } else {
5009       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5010         PC        coarse_pc;
5011 
5012         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5013         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5014         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5015         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5016       } else {
5017         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5018       }
5019     }
5020     /* we don't need the benign correction at coarser levels anymore */
5021     if (pcbddc->benign_have_null && isbddc) {
5022       PC        coarse_pc;
5023       PC_BDDC*  coarsepcbddc;
5024 
5025       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5026       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5027       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5028       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5029     }
5030     if (nullsp) {
5031       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5032     }
5033   }
5034 
5035   /* Local solution on R nodes */
5036   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5037     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5038   }
5039   /* communications from coarse sol to local primal nodes */
5040   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5041   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5042 
5043   /* Sum contributions from the two levels */
5044   if (!pcbddc->benign_apply_coarse_only) {
5045     if (applytranspose) {
5046       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5047       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5048     } else {
5049       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5050       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5051     }
5052     /* store p0 */
5053     if (pcbddc->benign_n) {
5054       PetscScalar *array;
5055       PetscInt    j;
5056 
5057       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5058       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5059       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5060     }
5061   } else { /* expand the coarse solution */
5062     if (applytranspose) {
5063       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5064     } else {
5065       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5066     }
5067   }
5068   PetscFunctionReturn(0);
5069 }
5070 
5071 #undef __FUNCT__
5072 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
5073 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5074 {
5075   PetscErrorCode ierr;
5076   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5077   PetscScalar    *array;
5078   Vec            from,to;
5079 
5080   PetscFunctionBegin;
5081   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5082     from = pcbddc->coarse_vec;
5083     to = pcbddc->vec1_P;
5084     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5085       Vec tvec;
5086 
5087       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5088       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5089       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5090       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5091       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5092       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5093     }
5094   } else { /* from local to global -> put data in coarse right hand side */
5095     from = pcbddc->vec1_P;
5096     to = pcbddc->coarse_vec;
5097   }
5098   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5099   PetscFunctionReturn(0);
5100 }
5101 
5102 #undef __FUNCT__
5103 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
5104 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5105 {
5106   PetscErrorCode ierr;
5107   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5108   PetscScalar    *array;
5109   Vec            from,to;
5110 
5111   PetscFunctionBegin;
5112   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5113     from = pcbddc->coarse_vec;
5114     to = pcbddc->vec1_P;
5115   } else { /* from local to global -> put data in coarse right hand side */
5116     from = pcbddc->vec1_P;
5117     to = pcbddc->coarse_vec;
5118   }
5119   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5120   if (smode == SCATTER_FORWARD) {
5121     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5122       Vec tvec;
5123 
5124       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5125       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5126       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5127       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5128     }
5129   } else {
5130     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5131      ierr = VecResetArray(from);CHKERRQ(ierr);
5132     }
5133   }
5134   PetscFunctionReturn(0);
5135 }
5136 
5137 /* uncomment for testing purposes */
5138 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5139 #undef __FUNCT__
5140 #define __FUNCT__ "PCBDDCConstraintsSetUp"
5141 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5142 {
5143   PetscErrorCode    ierr;
5144   PC_IS*            pcis = (PC_IS*)(pc->data);
5145   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5146   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5147   /* one and zero */
5148   PetscScalar       one=1.0,zero=0.0;
5149   /* space to store constraints and their local indices */
5150   PetscScalar       *constraints_data;
5151   PetscInt          *constraints_idxs,*constraints_idxs_B;
5152   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5153   PetscInt          *constraints_n;
5154   /* iterators */
5155   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5156   /* BLAS integers */
5157   PetscBLASInt      lwork,lierr;
5158   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5159   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5160   /* reuse */
5161   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5162   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5163   /* change of basis */
5164   PetscBool         qr_needed;
5165   PetscBT           change_basis,qr_needed_idx;
5166   /* auxiliary stuff */
5167   PetscInt          *nnz,*is_indices;
5168   PetscInt          ncc;
5169   /* some quantities */
5170   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5171   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5172 
5173   PetscFunctionBegin;
5174   /* Destroy Mat objects computed previously */
5175   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5176   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5177   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5178   /* save info on constraints from previous setup (if any) */
5179   olocal_primal_size = pcbddc->local_primal_size;
5180   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5181   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5182   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5183   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5184   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5185   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5186 
5187   if (!pcbddc->adaptive_selection) {
5188     IS           ISForVertices,*ISForFaces,*ISForEdges;
5189     MatNullSpace nearnullsp;
5190     const Vec    *nearnullvecs;
5191     Vec          *localnearnullsp;
5192     PetscScalar  *array;
5193     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5194     PetscBool    nnsp_has_cnst;
5195     /* LAPACK working arrays for SVD or POD */
5196     PetscBool    skip_lapack,boolforchange;
5197     PetscScalar  *work;
5198     PetscReal    *singular_vals;
5199 #if defined(PETSC_USE_COMPLEX)
5200     PetscReal    *rwork;
5201 #endif
5202 #if defined(PETSC_MISSING_LAPACK_GESVD)
5203     PetscScalar  *temp_basis,*correlation_mat;
5204 #else
5205     PetscBLASInt dummy_int=1;
5206     PetscScalar  dummy_scalar=1.;
5207 #endif
5208 
5209     /* Get index sets for faces, edges and vertices from graph */
5210     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5211     /* print some info */
5212     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5213       PetscInt nv;
5214 
5215       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5216       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5217       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5218       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5219       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5220       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5221       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5222       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5223       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5224     }
5225 
5226     /* free unneeded index sets */
5227     if (!pcbddc->use_vertices) {
5228       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5229     }
5230     if (!pcbddc->use_edges) {
5231       for (i=0;i<n_ISForEdges;i++) {
5232         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5233       }
5234       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5235       n_ISForEdges = 0;
5236     }
5237     if (!pcbddc->use_faces) {
5238       for (i=0;i<n_ISForFaces;i++) {
5239         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5240       }
5241       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5242       n_ISForFaces = 0;
5243     }
5244 
5245     /* check if near null space is attached to global mat */
5246     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5247     if (nearnullsp) {
5248       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5249       /* remove any stored info */
5250       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5251       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5252       /* store information for BDDC solver reuse */
5253       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5254       pcbddc->onearnullspace = nearnullsp;
5255       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5256       for (i=0;i<nnsp_size;i++) {
5257         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5258       }
5259     } else { /* if near null space is not provided BDDC uses constants by default */
5260       nnsp_size = 0;
5261       nnsp_has_cnst = PETSC_TRUE;
5262     }
5263     /* get max number of constraints on a single cc */
5264     max_constraints = nnsp_size;
5265     if (nnsp_has_cnst) max_constraints++;
5266 
5267     /*
5268          Evaluate maximum storage size needed by the procedure
5269          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5270          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5271          There can be multiple constraints per connected component
5272                                                                                                                                                            */
5273     n_vertices = 0;
5274     if (ISForVertices) {
5275       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5276     }
5277     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5278     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5279 
5280     total_counts = n_ISForFaces+n_ISForEdges;
5281     total_counts *= max_constraints;
5282     total_counts += n_vertices;
5283     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5284 
5285     total_counts = 0;
5286     max_size_of_constraint = 0;
5287     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5288       IS used_is;
5289       if (i<n_ISForEdges) {
5290         used_is = ISForEdges[i];
5291       } else {
5292         used_is = ISForFaces[i-n_ISForEdges];
5293       }
5294       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5295       total_counts += j;
5296       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5297     }
5298     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);
5299 
5300     /* get local part of global near null space vectors */
5301     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5302     for (k=0;k<nnsp_size;k++) {
5303       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5304       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5305       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5306     }
5307 
5308     /* whether or not to skip lapack calls */
5309     skip_lapack = PETSC_TRUE;
5310     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5311 
5312     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5313     if (!skip_lapack) {
5314       PetscScalar temp_work;
5315 
5316 #if defined(PETSC_MISSING_LAPACK_GESVD)
5317       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5318       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5319       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5320       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5321 #if defined(PETSC_USE_COMPLEX)
5322       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5323 #endif
5324       /* now we evaluate the optimal workspace using query with lwork=-1 */
5325       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5326       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5327       lwork = -1;
5328       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5329 #if !defined(PETSC_USE_COMPLEX)
5330       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5331 #else
5332       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5333 #endif
5334       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5335       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5336 #else /* on missing GESVD */
5337       /* SVD */
5338       PetscInt max_n,min_n;
5339       max_n = max_size_of_constraint;
5340       min_n = max_constraints;
5341       if (max_size_of_constraint < max_constraints) {
5342         min_n = max_size_of_constraint;
5343         max_n = max_constraints;
5344       }
5345       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5346 #if defined(PETSC_USE_COMPLEX)
5347       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5348 #endif
5349       /* now we evaluate the optimal workspace using query with lwork=-1 */
5350       lwork = -1;
5351       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5352       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5353       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5354       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5355 #if !defined(PETSC_USE_COMPLEX)
5356       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));
5357 #else
5358       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));
5359 #endif
5360       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5361       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5362 #endif /* on missing GESVD */
5363       /* Allocate optimal workspace */
5364       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5365       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5366     }
5367     /* Now we can loop on constraining sets */
5368     total_counts = 0;
5369     constraints_idxs_ptr[0] = 0;
5370     constraints_data_ptr[0] = 0;
5371     /* vertices */
5372     if (n_vertices) {
5373       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5374       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5375       for (i=0;i<n_vertices;i++) {
5376         constraints_n[total_counts] = 1;
5377         constraints_data[total_counts] = 1.0;
5378         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5379         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5380         total_counts++;
5381       }
5382       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5383       n_vertices = total_counts;
5384     }
5385 
5386     /* edges and faces */
5387     total_counts_cc = total_counts;
5388     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5389       IS        used_is;
5390       PetscBool idxs_copied = PETSC_FALSE;
5391 
5392       if (ncc<n_ISForEdges) {
5393         used_is = ISForEdges[ncc];
5394         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5395       } else {
5396         used_is = ISForFaces[ncc-n_ISForEdges];
5397         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5398       }
5399       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5400 
5401       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5402       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5403       /* change of basis should not be performed on local periodic nodes */
5404       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5405       if (nnsp_has_cnst) {
5406         PetscScalar quad_value;
5407 
5408         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5409         idxs_copied = PETSC_TRUE;
5410 
5411         if (!pcbddc->use_nnsp_true) {
5412           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5413         } else {
5414           quad_value = 1.0;
5415         }
5416         for (j=0;j<size_of_constraint;j++) {
5417           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5418         }
5419         temp_constraints++;
5420         total_counts++;
5421       }
5422       for (k=0;k<nnsp_size;k++) {
5423         PetscReal real_value;
5424         PetscScalar *ptr_to_data;
5425 
5426         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5427         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5428         for (j=0;j<size_of_constraint;j++) {
5429           ptr_to_data[j] = array[is_indices[j]];
5430         }
5431         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5432         /* check if array is null on the connected component */
5433         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5434         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5435         if (real_value > 0.0) { /* keep indices and values */
5436           temp_constraints++;
5437           total_counts++;
5438           if (!idxs_copied) {
5439             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5440             idxs_copied = PETSC_TRUE;
5441           }
5442         }
5443       }
5444       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5445       valid_constraints = temp_constraints;
5446       if (!pcbddc->use_nnsp_true && temp_constraints) {
5447         if (temp_constraints == 1) { /* just normalize the constraint */
5448           PetscScalar norm,*ptr_to_data;
5449 
5450           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5451           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5452           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5453           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5454           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5455         } else { /* perform SVD */
5456           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5457           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5458 
5459 #if defined(PETSC_MISSING_LAPACK_GESVD)
5460           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5461              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5462              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5463                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5464                 from that computed using LAPACKgesvd
5465              -> This is due to a different computation of eigenvectors in LAPACKheev
5466              -> The quality of the POD-computed basis will be the same */
5467           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5468           /* Store upper triangular part of correlation matrix */
5469           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5470           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5471           for (j=0;j<temp_constraints;j++) {
5472             for (k=0;k<j+1;k++) {
5473               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));
5474             }
5475           }
5476           /* compute eigenvalues and eigenvectors of correlation matrix */
5477           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5478           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5479 #if !defined(PETSC_USE_COMPLEX)
5480           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5481 #else
5482           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5483 #endif
5484           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5485           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5486           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5487           j = 0;
5488           while (j < temp_constraints && singular_vals[j] < tol) j++;
5489           total_counts = total_counts-j;
5490           valid_constraints = temp_constraints-j;
5491           /* scale and copy POD basis into used quadrature memory */
5492           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5493           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5494           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5495           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5496           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5497           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5498           if (j<temp_constraints) {
5499             PetscInt ii;
5500             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5501             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5502             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));
5503             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5504             for (k=0;k<temp_constraints-j;k++) {
5505               for (ii=0;ii<size_of_constraint;ii++) {
5506                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5507               }
5508             }
5509           }
5510 #else  /* on missing GESVD */
5511           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5512           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5513           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5514           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5515 #if !defined(PETSC_USE_COMPLEX)
5516           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));
5517 #else
5518           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));
5519 #endif
5520           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5521           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5522           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5523           k = temp_constraints;
5524           if (k > size_of_constraint) k = size_of_constraint;
5525           j = 0;
5526           while (j < k && singular_vals[k-j-1] < tol) j++;
5527           valid_constraints = k-j;
5528           total_counts = total_counts-temp_constraints+valid_constraints;
5529 #endif /* on missing GESVD */
5530         }
5531       }
5532       /* update pointers information */
5533       if (valid_constraints) {
5534         constraints_n[total_counts_cc] = valid_constraints;
5535         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5536         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5537         /* set change_of_basis flag */
5538         if (boolforchange) {
5539           PetscBTSet(change_basis,total_counts_cc);
5540         }
5541         total_counts_cc++;
5542       }
5543     }
5544     /* free workspace */
5545     if (!skip_lapack) {
5546       ierr = PetscFree(work);CHKERRQ(ierr);
5547 #if defined(PETSC_USE_COMPLEX)
5548       ierr = PetscFree(rwork);CHKERRQ(ierr);
5549 #endif
5550       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5551 #if defined(PETSC_MISSING_LAPACK_GESVD)
5552       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5553       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5554 #endif
5555     }
5556     for (k=0;k<nnsp_size;k++) {
5557       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5558     }
5559     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5560     /* free index sets of faces, edges and vertices */
5561     for (i=0;i<n_ISForFaces;i++) {
5562       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5563     }
5564     if (n_ISForFaces) {
5565       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5566     }
5567     for (i=0;i<n_ISForEdges;i++) {
5568       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5569     }
5570     if (n_ISForEdges) {
5571       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5572     }
5573     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5574   } else {
5575     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5576 
5577     total_counts = 0;
5578     n_vertices = 0;
5579     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5580       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5581     }
5582     max_constraints = 0;
5583     total_counts_cc = 0;
5584     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5585       total_counts += pcbddc->adaptive_constraints_n[i];
5586       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5587       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5588     }
5589     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5590     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5591     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5592     constraints_data = pcbddc->adaptive_constraints_data;
5593     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5594     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5595     total_counts_cc = 0;
5596     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5597       if (pcbddc->adaptive_constraints_n[i]) {
5598         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5599       }
5600     }
5601 #if 0
5602     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5603     for (i=0;i<total_counts_cc;i++) {
5604       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5605       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5606       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5607         printf(" %d",constraints_idxs[j]);
5608       }
5609       printf("\n");
5610       printf("number of cc: %d\n",constraints_n[i]);
5611     }
5612     for (i=0;i<n_vertices;i++) {
5613       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5614     }
5615     for (i=0;i<sub_schurs->n_subs;i++) {
5616       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]);
5617     }
5618 #endif
5619 
5620     max_size_of_constraint = 0;
5621     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]);
5622     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5623     /* Change of basis */
5624     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5625     if (pcbddc->use_change_of_basis) {
5626       for (i=0;i<sub_schurs->n_subs;i++) {
5627         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5628           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5629         }
5630       }
5631     }
5632   }
5633   pcbddc->local_primal_size = total_counts;
5634   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5635 
5636   /* map constraints_idxs in boundary numbering */
5637   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5638   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);
5639 
5640   /* Create constraint matrix */
5641   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5642   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5643   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5644 
5645   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5646   /* determine if a QR strategy is needed for change of basis */
5647   qr_needed = PETSC_FALSE;
5648   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5649   total_primal_vertices=0;
5650   pcbddc->local_primal_size_cc = 0;
5651   for (i=0;i<total_counts_cc;i++) {
5652     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5653     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5654       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5655       pcbddc->local_primal_size_cc += 1;
5656     } else if (PetscBTLookup(change_basis,i)) {
5657       for (k=0;k<constraints_n[i];k++) {
5658         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5659       }
5660       pcbddc->local_primal_size_cc += constraints_n[i];
5661       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5662         PetscBTSet(qr_needed_idx,i);
5663         qr_needed = PETSC_TRUE;
5664       }
5665     } else {
5666       pcbddc->local_primal_size_cc += 1;
5667     }
5668   }
5669   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5670   pcbddc->n_vertices = total_primal_vertices;
5671   /* permute indices in order to have a sorted set of vertices */
5672   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5673   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);
5674   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5675   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5676 
5677   /* nonzero structure of constraint matrix */
5678   /* and get reference dof for local constraints */
5679   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5680   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5681 
5682   j = total_primal_vertices;
5683   total_counts = total_primal_vertices;
5684   cum = total_primal_vertices;
5685   for (i=n_vertices;i<total_counts_cc;i++) {
5686     if (!PetscBTLookup(change_basis,i)) {
5687       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5688       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5689       cum++;
5690       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5691       for (k=0;k<constraints_n[i];k++) {
5692         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5693         nnz[j+k] = size_of_constraint;
5694       }
5695       j += constraints_n[i];
5696     }
5697   }
5698   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5699   ierr = PetscFree(nnz);CHKERRQ(ierr);
5700 
5701   /* set values in constraint matrix */
5702   for (i=0;i<total_primal_vertices;i++) {
5703     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5704   }
5705   total_counts = total_primal_vertices;
5706   for (i=n_vertices;i<total_counts_cc;i++) {
5707     if (!PetscBTLookup(change_basis,i)) {
5708       PetscInt *cols;
5709 
5710       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5711       cols = constraints_idxs+constraints_idxs_ptr[i];
5712       for (k=0;k<constraints_n[i];k++) {
5713         PetscInt    row = total_counts+k;
5714         PetscScalar *vals;
5715 
5716         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5717         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5718       }
5719       total_counts += constraints_n[i];
5720     }
5721   }
5722   /* assembling */
5723   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5724   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5725 
5726   /*
5727   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5728   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5729   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5730   */
5731   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5732   if (pcbddc->use_change_of_basis) {
5733     /* dual and primal dofs on a single cc */
5734     PetscInt     dual_dofs,primal_dofs;
5735     /* working stuff for GEQRF */
5736     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5737     PetscBLASInt lqr_work;
5738     /* working stuff for UNGQR */
5739     PetscScalar  *gqr_work,lgqr_work_t;
5740     PetscBLASInt lgqr_work;
5741     /* working stuff for TRTRS */
5742     PetscScalar  *trs_rhs;
5743     PetscBLASInt Blas_NRHS;
5744     /* pointers for values insertion into change of basis matrix */
5745     PetscInt     *start_rows,*start_cols;
5746     PetscScalar  *start_vals;
5747     /* working stuff for values insertion */
5748     PetscBT      is_primal;
5749     PetscInt     *aux_primal_numbering_B;
5750     /* matrix sizes */
5751     PetscInt     global_size,local_size;
5752     /* temporary change of basis */
5753     Mat          localChangeOfBasisMatrix;
5754     /* extra space for debugging */
5755     PetscScalar  *dbg_work;
5756 
5757     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5758     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5759     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5760     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5761     /* nonzeros for local mat */
5762     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5763     if (!pcbddc->benign_change || pcbddc->fake_change) {
5764       for (i=0;i<pcis->n;i++) nnz[i]=1;
5765     } else {
5766       const PetscInt *ii;
5767       PetscInt       n;
5768       PetscBool      flg_row;
5769       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5770       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5771       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5772     }
5773     for (i=n_vertices;i<total_counts_cc;i++) {
5774       if (PetscBTLookup(change_basis,i)) {
5775         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5776         if (PetscBTLookup(qr_needed_idx,i)) {
5777           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5778         } else {
5779           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5780           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5781         }
5782       }
5783     }
5784     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5785     ierr = PetscFree(nnz);CHKERRQ(ierr);
5786     /* Set interior change in the matrix */
5787     if (!pcbddc->benign_change || pcbddc->fake_change) {
5788       for (i=0;i<pcis->n;i++) {
5789         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5790       }
5791     } else {
5792       const PetscInt *ii,*jj;
5793       PetscScalar    *aa;
5794       PetscInt       n;
5795       PetscBool      flg_row;
5796       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5797       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5798       for (i=0;i<n;i++) {
5799         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5800       }
5801       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5802       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5803     }
5804 
5805     if (pcbddc->dbg_flag) {
5806       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5807       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5808     }
5809 
5810 
5811     /* Now we loop on the constraints which need a change of basis */
5812     /*
5813        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
5814        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
5815 
5816        Basic blocks of change of basis matrix T computed by
5817 
5818           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
5819 
5820             | 1        0   ...        0         s_1/S |
5821             | 0        1   ...        0         s_2/S |
5822             |              ...                        |
5823             | 0        ...            1     s_{n-1}/S |
5824             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
5825 
5826             with S = \sum_{i=1}^n s_i^2
5827             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
5828                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
5829 
5830           - QR decomposition of constraints otherwise
5831     */
5832     if (qr_needed) {
5833       /* space to store Q */
5834       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
5835       /* array to store scaling factors for reflectors */
5836       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
5837       /* first we issue queries for optimal work */
5838       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5839       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5840       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5841       lqr_work = -1;
5842       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
5843       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
5844       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
5845       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
5846       lgqr_work = -1;
5847       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5848       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
5849       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
5850       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5851       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
5852       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
5853       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
5854       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
5855       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
5856       /* array to store rhs and solution of triangular solver */
5857       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
5858       /* allocating workspace for check */
5859       if (pcbddc->dbg_flag) {
5860         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
5861       }
5862     }
5863     /* array to store whether a node is primal or not */
5864     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
5865     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
5866     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
5867     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);
5868     for (i=0;i<total_primal_vertices;i++) {
5869       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
5870     }
5871     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
5872 
5873     /* loop on constraints and see whether or not they need a change of basis and compute it */
5874     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
5875       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
5876       if (PetscBTLookup(change_basis,total_counts)) {
5877         /* get constraint info */
5878         primal_dofs = constraints_n[total_counts];
5879         dual_dofs = size_of_constraint-primal_dofs;
5880 
5881         if (pcbddc->dbg_flag) {
5882           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);
5883         }
5884 
5885         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
5886 
5887           /* copy quadrature constraints for change of basis check */
5888           if (pcbddc->dbg_flag) {
5889             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5890           }
5891           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
5892           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5893 
5894           /* compute QR decomposition of constraints */
5895           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5896           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5897           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5898           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5899           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
5900           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
5901           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5902 
5903           /* explictly compute R^-T */
5904           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
5905           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
5906           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5907           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
5908           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5909           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5910           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5911           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
5912           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
5913           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5914 
5915           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
5916           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5917           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5918           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5919           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5920           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5921           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
5922           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
5923           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5924 
5925           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
5926              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
5927              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
5928           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5929           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5930           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5931           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5932           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5933           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5934           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5935           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));
5936           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5937           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5938 
5939           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
5940           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
5941           /* insert cols for primal dofs */
5942           for (j=0;j<primal_dofs;j++) {
5943             start_vals = &qr_basis[j*size_of_constraint];
5944             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
5945             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
5946           }
5947           /* insert cols for dual dofs */
5948           for (j=0,k=0;j<dual_dofs;k++) {
5949             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
5950               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
5951               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
5952               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
5953               j++;
5954             }
5955           }
5956 
5957           /* check change of basis */
5958           if (pcbddc->dbg_flag) {
5959             PetscInt   ii,jj;
5960             PetscBool valid_qr=PETSC_TRUE;
5961             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
5962             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5963             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
5964             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5965             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
5966             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
5967             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5968             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));
5969             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5970             for (jj=0;jj<size_of_constraint;jj++) {
5971               for (ii=0;ii<primal_dofs;ii++) {
5972                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
5973                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
5974               }
5975             }
5976             if (!valid_qr) {
5977               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
5978               for (jj=0;jj<size_of_constraint;jj++) {
5979                 for (ii=0;ii<primal_dofs;ii++) {
5980                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
5981                     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]));
5982                   }
5983                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
5984                     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]));
5985                   }
5986                 }
5987               }
5988             } else {
5989               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
5990             }
5991           }
5992         } else { /* simple transformation block */
5993           PetscInt    row,col;
5994           PetscScalar val,norm;
5995 
5996           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5997           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
5998           for (j=0;j<size_of_constraint;j++) {
5999             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6000             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6001             if (!PetscBTLookup(is_primal,row_B)) {
6002               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6003               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6004               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6005             } else {
6006               for (k=0;k<size_of_constraint;k++) {
6007                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6008                 if (row != col) {
6009                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6010                 } else {
6011                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6012                 }
6013                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6014               }
6015             }
6016           }
6017           if (pcbddc->dbg_flag) {
6018             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6019           }
6020         }
6021       } else {
6022         if (pcbddc->dbg_flag) {
6023           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6024         }
6025       }
6026     }
6027 
6028     /* free workspace */
6029     if (qr_needed) {
6030       if (pcbddc->dbg_flag) {
6031         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6032       }
6033       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6034       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6035       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6036       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6037       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6038     }
6039     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6040     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6041     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6042 
6043     /* assembling of global change of variable */
6044     if (!pcbddc->fake_change) {
6045       Mat      tmat;
6046       PetscInt bs;
6047 
6048       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6049       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6050       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6051       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6052       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6053       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6054       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6055       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6056       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6057       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6058       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6059       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6060       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6061       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6062       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6063       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6064       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6065       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6066 
6067       /* check */
6068       if (pcbddc->dbg_flag) {
6069         PetscReal error;
6070         Vec       x,x_change;
6071 
6072         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6073         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6074         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6075         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6076         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6077         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6078         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6079         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6080         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6081         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6082         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6083         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6084         if (error > PETSC_SMALL) {
6085           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6086         }
6087         ierr = VecDestroy(&x);CHKERRQ(ierr);
6088         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6089       }
6090       /* adapt sub_schurs computed (if any) */
6091       if (pcbddc->use_deluxe_scaling) {
6092         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6093 
6094         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);
6095         if (sub_schurs && sub_schurs->S_Ej_all) {
6096           Mat                    S_new,tmat;
6097           IS                     is_all_N,is_V_Sall = NULL;
6098 
6099           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6100           ierr = MatGetSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6101           if (pcbddc->deluxe_zerorows) {
6102             ISLocalToGlobalMapping NtoSall;
6103             IS                     is_V;
6104             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6105             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6106             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6107             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6108             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6109           }
6110           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6111           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6112           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6113           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6114           if (pcbddc->deluxe_zerorows) {
6115             const PetscScalar *array;
6116             const PetscInt    *idxs_V,*idxs_all;
6117             PetscInt          i,n_V;
6118 
6119             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6120             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6121             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6122             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6123             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6124             for (i=0;i<n_V;i++) {
6125               PetscScalar val;
6126               PetscInt    idx;
6127 
6128               idx = idxs_V[i];
6129               val = array[idxs_all[idxs_V[i]]];
6130               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6131             }
6132             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6133             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6134             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6135             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6136             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6137           }
6138           sub_schurs->S_Ej_all = S_new;
6139           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6140           if (sub_schurs->sum_S_Ej_all) {
6141             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6142             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6143             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6144             if (pcbddc->deluxe_zerorows) {
6145               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6146             }
6147             sub_schurs->sum_S_Ej_all = S_new;
6148             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6149           }
6150           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6151           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6152         }
6153         /* destroy any change of basis context in sub_schurs */
6154         if (sub_schurs && sub_schurs->change) {
6155           PetscInt i;
6156 
6157           for (i=0;i<sub_schurs->n_subs;i++) {
6158             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6159           }
6160           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6161         }
6162       }
6163       if (pcbddc->switch_static) { /* need to save the local change */
6164         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6165       } else {
6166         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6167       }
6168       /* determine if any process has changed the pressures locally */
6169       pcbddc->change_interior = pcbddc->benign_have_null;
6170     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6171       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6172       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6173       pcbddc->use_qr_single = qr_needed;
6174     }
6175   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6176     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6177       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6178       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6179     } else {
6180       Mat benign_global = NULL;
6181       if (pcbddc->benign_have_null) {
6182         Mat tmat;
6183 
6184         pcbddc->change_interior = PETSC_TRUE;
6185         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6186         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6187         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6188         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6189         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6190         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6191         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6192         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6193         if (pcbddc->benign_change) {
6194           Mat M;
6195 
6196           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6197           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6198           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6199           ierr = MatDestroy(&M);CHKERRQ(ierr);
6200         } else {
6201           Mat         eye;
6202           PetscScalar *array;
6203 
6204           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6205           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6206           for (i=0;i<pcis->n;i++) {
6207             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6208           }
6209           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6210           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6211           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6212           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6213           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6214         }
6215         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6216         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6217       }
6218       if (pcbddc->user_ChangeOfBasisMatrix) {
6219         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6220         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6221       } else if (pcbddc->benign_have_null) {
6222         pcbddc->ChangeOfBasisMatrix = benign_global;
6223       }
6224     }
6225     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6226       IS             is_global;
6227       const PetscInt *gidxs;
6228 
6229       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6230       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6231       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6232       ierr = MatGetSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6233       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6234     }
6235   }
6236   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6237     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6238   }
6239 
6240   if (!pcbddc->fake_change) {
6241     /* add pressure dofs to set of primal nodes for numbering purposes */
6242     for (i=0;i<pcbddc->benign_n;i++) {
6243       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6244       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6245       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6246       pcbddc->local_primal_size_cc++;
6247       pcbddc->local_primal_size++;
6248     }
6249 
6250     /* check if a new primal space has been introduced (also take into account benign trick) */
6251     pcbddc->new_primal_space_local = PETSC_TRUE;
6252     if (olocal_primal_size == pcbddc->local_primal_size) {
6253       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6254       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6255       if (!pcbddc->new_primal_space_local) {
6256         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6257         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6258       }
6259     }
6260     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6261     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6262   }
6263   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6264 
6265   /* flush dbg viewer */
6266   if (pcbddc->dbg_flag) {
6267     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6268   }
6269 
6270   /* free workspace */
6271   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6272   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6273   if (!pcbddc->adaptive_selection) {
6274     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6275     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6276   } else {
6277     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6278                       pcbddc->adaptive_constraints_idxs_ptr,
6279                       pcbddc->adaptive_constraints_data_ptr,
6280                       pcbddc->adaptive_constraints_idxs,
6281                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6282     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6283     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6284   }
6285   PetscFunctionReturn(0);
6286 }
6287 
6288 #undef __FUNCT__
6289 #define __FUNCT__ "PCBDDCAnalyzeInterface"
6290 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6291 {
6292   ISLocalToGlobalMapping map;
6293   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6294   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6295   PetscInt               ierr,i,N;
6296 
6297   PetscFunctionBegin;
6298   if (pcbddc->recompute_topography) {
6299     pcbddc->graphanalyzed = PETSC_FALSE;
6300     /* Reset previously computed graph */
6301     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6302     /* Init local Graph struct */
6303     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6304     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6305     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6306 
6307     /* Check validity of the csr graph passed in by the user */
6308     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);
6309 
6310     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6311     if ( (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) && pcbddc->use_local_adj) {
6312       PetscInt  *xadj,*adjncy;
6313       PetscInt  nvtxs;
6314       PetscBool flg_row=PETSC_FALSE;
6315 
6316       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6317       if (flg_row) {
6318         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6319         pcbddc->computed_rowadj = PETSC_TRUE;
6320       }
6321       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6322     }
6323     if (pcbddc->dbg_flag) {
6324       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6325     }
6326 
6327     /* Setup of Graph */
6328     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6329     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6330 
6331     /* attach info on disconnected subdomains if present */
6332     if (pcbddc->n_local_subs) {
6333       PetscInt *local_subs;
6334 
6335       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6336       for (i=0;i<pcbddc->n_local_subs;i++) {
6337         const PetscInt *idxs;
6338         PetscInt       nl,j;
6339 
6340         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6341         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6342         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6343         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6344       }
6345       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6346       pcbddc->mat_graph->local_subs = local_subs;
6347     }
6348   }
6349 
6350   if (!pcbddc->graphanalyzed) {
6351     /* Graph's connected components analysis */
6352     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6353     pcbddc->graphanalyzed = PETSC_TRUE;
6354   }
6355   PetscFunctionReturn(0);
6356 }
6357 
6358 #undef __FUNCT__
6359 #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
6360 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6361 {
6362   PetscInt       i,j;
6363   PetscScalar    *alphas;
6364   PetscErrorCode ierr;
6365 
6366   PetscFunctionBegin;
6367   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6368   for (i=0;i<n;i++) {
6369     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6370     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6371     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6372     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6373   }
6374   ierr = PetscFree(alphas);CHKERRQ(ierr);
6375   PetscFunctionReturn(0);
6376 }
6377 
6378 #undef __FUNCT__
6379 #define __FUNCT__ "MatISGetSubassemblingPattern"
6380 PetscErrorCode MatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6381 {
6382   Mat            A;
6383   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6384   PetscMPIInt    size,rank,color;
6385   PetscInt       *xadj,*adjncy;
6386   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6387   PetscInt       im_active,active_procs,n,i,j,local_size,threshold = 2;
6388   PetscInt       void_procs,*procs_candidates = NULL;
6389   PetscInt       xadj_count, *count;
6390   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6391   PetscSubcomm   psubcomm;
6392   MPI_Comm       subcomm;
6393   PetscErrorCode ierr;
6394 
6395   PetscFunctionBegin;
6396   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6397   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6398   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6399   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6400   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6401   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6402 
6403   if (have_void) *have_void = PETSC_FALSE;
6404   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6405   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6406   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6407   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6408   im_active = !!(n);
6409   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6410   void_procs = size - active_procs;
6411   /* get ranks of of non-active processes in mat communicator */
6412   if (void_procs) {
6413     PetscInt ncand;
6414 
6415     if (have_void) *have_void = PETSC_TRUE;
6416     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6417     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6418     for (i=0,ncand=0;i<size;i++) {
6419       if (!procs_candidates[i]) {
6420         procs_candidates[ncand++] = i;
6421       }
6422     }
6423     /* force n_subdomains to be not greater that the number of non-active processes */
6424     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6425   }
6426 
6427   /* number of subdomains requested greater than active processes -> just shift the matrix
6428      number of subdomains requested 1 -> send to master or first candidate in voids  */
6429   if (active_procs < *n_subdomains || *n_subdomains == 1) {
6430     PetscInt issize,isidx,dest;
6431     if (*n_subdomains == 1) dest = 0;
6432     else dest = rank;
6433     if (im_active) {
6434       issize = 1;
6435       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6436         isidx = procs_candidates[dest];
6437       } else {
6438         isidx = dest;
6439       }
6440     } else {
6441       issize = 0;
6442       isidx = -1;
6443     }
6444     *n_subdomains = active_procs;
6445     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6446     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6447     PetscFunctionReturn(0);
6448   }
6449   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6450   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6451   threshold = PetscMax(threshold,2);
6452 
6453   /* Get info on mapping */
6454   ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&local_size);CHKERRQ(ierr);
6455   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6456 
6457   /* build local CSR graph of subdomains' connectivity */
6458   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6459   xadj[0] = 0;
6460   xadj[1] = PetscMax(n_neighs-1,0);
6461   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6462   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6463   ierr = PetscCalloc1(local_size,&count);CHKERRQ(ierr);
6464   for (i=1;i<n_neighs;i++)
6465     for (j=0;j<n_shared[i];j++)
6466       count[shared[i][j]] += 1;
6467 
6468   xadj_count = 0;
6469   for (i=1;i<n_neighs;i++) {
6470     for (j=0;j<n_shared[i];j++) {
6471       if (count[shared[i][j]] < threshold) {
6472         adjncy[xadj_count] = neighs[i];
6473         adjncy_wgt[xadj_count] = n_shared[i];
6474         xadj_count++;
6475         break;
6476       }
6477     }
6478   }
6479   xadj[1] = xadj_count;
6480   ierr = PetscFree(count);CHKERRQ(ierr);
6481   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6482   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6483 
6484   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6485 
6486   /* Restrict work on active processes only */
6487   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6488   if (void_procs) {
6489     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6490     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6491     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6492     subcomm = PetscSubcommChild(psubcomm);
6493   } else {
6494     psubcomm = NULL;
6495     subcomm = PetscObjectComm((PetscObject)mat);
6496   }
6497 
6498   v_wgt = NULL;
6499   if (!color) {
6500     ierr = PetscFree(xadj);CHKERRQ(ierr);
6501     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6502     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6503   } else {
6504     Mat             subdomain_adj;
6505     IS              new_ranks,new_ranks_contig;
6506     MatPartitioning partitioner;
6507     PetscInt        rstart=0,rend=0;
6508     PetscInt        *is_indices,*oldranks;
6509     PetscMPIInt     size;
6510     PetscBool       aggregate;
6511 
6512     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6513     if (void_procs) {
6514       PetscInt prank = rank;
6515       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6516       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6517       for (i=0;i<xadj[1];i++) {
6518         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6519       }
6520       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6521     } else {
6522       oldranks = NULL;
6523     }
6524     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6525     if (aggregate) { /* TODO: all this part could be made more efficient */
6526       PetscInt    lrows,row,ncols,*cols;
6527       PetscMPIInt nrank;
6528       PetscScalar *vals;
6529 
6530       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6531       lrows = 0;
6532       if (nrank<redprocs) {
6533         lrows = size/redprocs;
6534         if (nrank<size%redprocs) lrows++;
6535       }
6536       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6537       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6538       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6539       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6540       row = nrank;
6541       ncols = xadj[1]-xadj[0];
6542       cols = adjncy;
6543       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6544       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6545       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6546       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6547       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6548       ierr = PetscFree(xadj);CHKERRQ(ierr);
6549       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6550       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6551       ierr = PetscFree(vals);CHKERRQ(ierr);
6552       if (use_vwgt) {
6553         Vec               v;
6554         const PetscScalar *array;
6555         PetscInt          nl;
6556 
6557         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6558         ierr = VecSetValue(v,row,(PetscScalar)local_size,INSERT_VALUES);CHKERRQ(ierr);
6559         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6560         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6561         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6562         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6563         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6564         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6565         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6566         ierr = VecDestroy(&v);CHKERRQ(ierr);
6567       }
6568     } else {
6569       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6570       if (use_vwgt) {
6571         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6572         v_wgt[0] = local_size;
6573       }
6574     }
6575     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6576 
6577     /* Partition */
6578     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6579     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6580     if (v_wgt) {
6581       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6582     }
6583     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6584     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6585     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6586     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6587     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6588 
6589     /* renumber new_ranks to avoid "holes" in new set of processors */
6590     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6591     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6592     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6593     if (!aggregate) {
6594       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6595 #if defined(PETSC_USE_DEBUG)
6596         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6597 #endif
6598         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6599       } else if (oldranks) {
6600         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6601       } else {
6602         ranks_send_to_idx[0] = is_indices[0];
6603       }
6604     } else {
6605       PetscInt    idxs[1];
6606       PetscMPIInt tag;
6607       MPI_Request *reqs;
6608 
6609       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6610       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6611       for (i=rstart;i<rend;i++) {
6612         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6613       }
6614       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6615       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6616       ierr = PetscFree(reqs);CHKERRQ(ierr);
6617       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6618 #if defined(PETSC_USE_DEBUG)
6619         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6620 #endif
6621         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6622       } else if (oldranks) {
6623         ranks_send_to_idx[0] = oldranks[idxs[0]];
6624       } else {
6625         ranks_send_to_idx[0] = idxs[0];
6626       }
6627     }
6628     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6629     /* clean up */
6630     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6631     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6632     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6633     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6634   }
6635   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6636   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6637 
6638   /* assemble parallel IS for sends */
6639   i = 1;
6640   if (!color) i=0;
6641   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6642   PetscFunctionReturn(0);
6643 }
6644 
6645 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6646 
6647 #undef __FUNCT__
6648 #define __FUNCT__ "PCBDDCMatISSubassemble"
6649 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[])
6650 {
6651   Mat                    local_mat;
6652   IS                     is_sends_internal;
6653   PetscInt               rows,cols,new_local_rows;
6654   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6655   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6656   ISLocalToGlobalMapping l2gmap;
6657   PetscInt*              l2gmap_indices;
6658   const PetscInt*        is_indices;
6659   MatType                new_local_type;
6660   /* buffers */
6661   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6662   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6663   PetscInt               *recv_buffer_idxs_local;
6664   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6665   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6666   /* MPI */
6667   MPI_Comm               comm,comm_n;
6668   PetscSubcomm           subcomm;
6669   PetscMPIInt            n_sends,n_recvs,commsize;
6670   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6671   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6672   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6673   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6674   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6675   PetscErrorCode         ierr;
6676 
6677   PetscFunctionBegin;
6678   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6679   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6680   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6681   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6682   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6683   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6684   PetscValidLogicalCollectiveBool(mat,reuse,6);
6685   PetscValidLogicalCollectiveInt(mat,nis,8);
6686   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6687   if (nvecs) {
6688     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6689     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6690   }
6691   /* further checks */
6692   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6693   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6694   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6695   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6696   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6697   if (reuse && *mat_n) {
6698     PetscInt mrows,mcols,mnrows,mncols;
6699     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6700     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6701     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6702     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6703     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6704     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6705     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6706   }
6707   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6708   PetscValidLogicalCollectiveInt(mat,bs,0);
6709 
6710   /* prepare IS for sending if not provided */
6711   if (!is_sends) {
6712     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6713     ierr = MatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6714   } else {
6715     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6716     is_sends_internal = is_sends;
6717   }
6718 
6719   /* get comm */
6720   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6721 
6722   /* compute number of sends */
6723   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6724   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6725 
6726   /* compute number of receives */
6727   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6728   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6729   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6730   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6731   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6732   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6733   ierr = PetscFree(iflags);CHKERRQ(ierr);
6734 
6735   /* restrict comm if requested */
6736   subcomm = 0;
6737   destroy_mat = PETSC_FALSE;
6738   if (restrict_comm) {
6739     PetscMPIInt color,subcommsize;
6740 
6741     color = 0;
6742     if (restrict_full) {
6743       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6744     } else {
6745       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6746     }
6747     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6748     subcommsize = commsize - subcommsize;
6749     /* check if reuse has been requested */
6750     if (reuse) {
6751       if (*mat_n) {
6752         PetscMPIInt subcommsize2;
6753         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6754         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6755         comm_n = PetscObjectComm((PetscObject)*mat_n);
6756       } else {
6757         comm_n = PETSC_COMM_SELF;
6758       }
6759     } else { /* MAT_INITIAL_MATRIX */
6760       PetscMPIInt rank;
6761 
6762       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6763       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6764       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6765       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6766       comm_n = PetscSubcommChild(subcomm);
6767     }
6768     /* flag to destroy *mat_n if not significative */
6769     if (color) destroy_mat = PETSC_TRUE;
6770   } else {
6771     comm_n = comm;
6772   }
6773 
6774   /* prepare send/receive buffers */
6775   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6776   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6777   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6778   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6779   if (nis) {
6780     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6781   }
6782 
6783   /* Get data from local matrices */
6784   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6785     /* TODO: See below some guidelines on how to prepare the local buffers */
6786     /*
6787        send_buffer_vals should contain the raw values of the local matrix
6788        send_buffer_idxs should contain:
6789        - MatType_PRIVATE type
6790        - PetscInt        size_of_l2gmap
6791        - PetscInt        global_row_indices[size_of_l2gmap]
6792        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6793     */
6794   else {
6795     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6796     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6797     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6798     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6799     send_buffer_idxs[1] = i;
6800     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6801     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6802     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6803     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6804     for (i=0;i<n_sends;i++) {
6805       ilengths_vals[is_indices[i]] = len*len;
6806       ilengths_idxs[is_indices[i]] = len+2;
6807     }
6808   }
6809   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6810   /* additional is (if any) */
6811   if (nis) {
6812     PetscMPIInt psum;
6813     PetscInt j;
6814     for (j=0,psum=0;j<nis;j++) {
6815       PetscInt plen;
6816       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6817       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
6818       psum += len+1; /* indices + lenght */
6819     }
6820     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
6821     for (j=0,psum=0;j<nis;j++) {
6822       PetscInt plen;
6823       const PetscInt *is_array_idxs;
6824       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6825       send_buffer_idxs_is[psum] = plen;
6826       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6827       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
6828       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6829       psum += plen+1; /* indices + lenght */
6830     }
6831     for (i=0;i<n_sends;i++) {
6832       ilengths_idxs_is[is_indices[i]] = psum;
6833     }
6834     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
6835   }
6836 
6837   buf_size_idxs = 0;
6838   buf_size_vals = 0;
6839   buf_size_idxs_is = 0;
6840   buf_size_vecs = 0;
6841   for (i=0;i<n_recvs;i++) {
6842     buf_size_idxs += (PetscInt)olengths_idxs[i];
6843     buf_size_vals += (PetscInt)olengths_vals[i];
6844     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
6845     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
6846   }
6847   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
6848   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
6849   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
6850   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
6851 
6852   /* get new tags for clean communications */
6853   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
6854   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
6855   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
6856   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
6857 
6858   /* allocate for requests */
6859   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
6860   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
6861   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
6862   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
6863   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
6864   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
6865   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
6866   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
6867 
6868   /* communications */
6869   ptr_idxs = recv_buffer_idxs;
6870   ptr_vals = recv_buffer_vals;
6871   ptr_idxs_is = recv_buffer_idxs_is;
6872   ptr_vecs = recv_buffer_vecs;
6873   for (i=0;i<n_recvs;i++) {
6874     source_dest = onodes[i];
6875     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
6876     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
6877     ptr_idxs += olengths_idxs[i];
6878     ptr_vals += olengths_vals[i];
6879     if (nis) {
6880       source_dest = onodes_is[i];
6881       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);
6882       ptr_idxs_is += olengths_idxs_is[i];
6883     }
6884     if (nvecs) {
6885       source_dest = onodes[i];
6886       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
6887       ptr_vecs += olengths_idxs[i]-2;
6888     }
6889   }
6890   for (i=0;i<n_sends;i++) {
6891     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
6892     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
6893     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
6894     if (nis) {
6895       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);
6896     }
6897     if (nvecs) {
6898       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
6899       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
6900     }
6901   }
6902   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6903   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
6904 
6905   /* assemble new l2g map */
6906   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6907   ptr_idxs = recv_buffer_idxs;
6908   new_local_rows = 0;
6909   for (i=0;i<n_recvs;i++) {
6910     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6911     ptr_idxs += olengths_idxs[i];
6912   }
6913   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
6914   ptr_idxs = recv_buffer_idxs;
6915   new_local_rows = 0;
6916   for (i=0;i<n_recvs;i++) {
6917     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
6918     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6919     ptr_idxs += olengths_idxs[i];
6920   }
6921   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
6922   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
6923   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
6924 
6925   /* infer new local matrix type from received local matrices type */
6926   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
6927   /* 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) */
6928   if (n_recvs) {
6929     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
6930     ptr_idxs = recv_buffer_idxs;
6931     for (i=0;i<n_recvs;i++) {
6932       if ((PetscInt)new_local_type_private != *ptr_idxs) {
6933         new_local_type_private = MATAIJ_PRIVATE;
6934         break;
6935       }
6936       ptr_idxs += olengths_idxs[i];
6937     }
6938     switch (new_local_type_private) {
6939       case MATDENSE_PRIVATE:
6940         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
6941           new_local_type = MATSEQAIJ;
6942           bs = 1;
6943         } else { /* if I receive only 1 dense matrix */
6944           new_local_type = MATSEQDENSE;
6945           bs = 1;
6946         }
6947         break;
6948       case MATAIJ_PRIVATE:
6949         new_local_type = MATSEQAIJ;
6950         bs = 1;
6951         break;
6952       case MATBAIJ_PRIVATE:
6953         new_local_type = MATSEQBAIJ;
6954         break;
6955       case MATSBAIJ_PRIVATE:
6956         new_local_type = MATSEQSBAIJ;
6957         break;
6958       default:
6959         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
6960         break;
6961     }
6962   } else { /* by default, new_local_type is seqdense */
6963     new_local_type = MATSEQDENSE;
6964     bs = 1;
6965   }
6966 
6967   /* create MATIS object if needed */
6968   if (!reuse) {
6969     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
6970     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
6971   } else {
6972     /* it also destroys the local matrices */
6973     if (*mat_n) {
6974       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
6975     } else { /* this is a fake object */
6976       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
6977     }
6978   }
6979   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
6980   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
6981 
6982   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6983 
6984   /* Global to local map of received indices */
6985   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
6986   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
6987   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
6988 
6989   /* restore attributes -> type of incoming data and its size */
6990   buf_size_idxs = 0;
6991   for (i=0;i<n_recvs;i++) {
6992     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
6993     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
6994     buf_size_idxs += (PetscInt)olengths_idxs[i];
6995   }
6996   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
6997 
6998   /* set preallocation */
6999   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7000   if (!newisdense) {
7001     PetscInt *new_local_nnz=0;
7002 
7003     ptr_idxs = recv_buffer_idxs_local;
7004     if (n_recvs) {
7005       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7006     }
7007     for (i=0;i<n_recvs;i++) {
7008       PetscInt j;
7009       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7010         for (j=0;j<*(ptr_idxs+1);j++) {
7011           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7012         }
7013       } else {
7014         /* TODO */
7015       }
7016       ptr_idxs += olengths_idxs[i];
7017     }
7018     if (new_local_nnz) {
7019       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7020       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7021       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7022       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7023       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7024       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7025     } else {
7026       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7027     }
7028     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7029   } else {
7030     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7031   }
7032 
7033   /* set values */
7034   ptr_vals = recv_buffer_vals;
7035   ptr_idxs = recv_buffer_idxs_local;
7036   for (i=0;i<n_recvs;i++) {
7037     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7038       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7039       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7040       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7041       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7042       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7043     } else {
7044       /* TODO */
7045     }
7046     ptr_idxs += olengths_idxs[i];
7047     ptr_vals += olengths_vals[i];
7048   }
7049   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7050   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7051   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7052   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7053   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7054 
7055 #if 0
7056   if (!restrict_comm) { /* check */
7057     Vec       lvec,rvec;
7058     PetscReal infty_error;
7059 
7060     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7061     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7062     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7063     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7064     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7065     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7066     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7067     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7068     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7069   }
7070 #endif
7071 
7072   /* assemble new additional is (if any) */
7073   if (nis) {
7074     PetscInt **temp_idxs,*count_is,j,psum;
7075 
7076     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7077     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7078     ptr_idxs = recv_buffer_idxs_is;
7079     psum = 0;
7080     for (i=0;i<n_recvs;i++) {
7081       for (j=0;j<nis;j++) {
7082         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7083         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7084         psum += plen;
7085         ptr_idxs += plen+1; /* shift pointer to received data */
7086       }
7087     }
7088     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7089     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7090     for (i=1;i<nis;i++) {
7091       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7092     }
7093     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7094     ptr_idxs = recv_buffer_idxs_is;
7095     for (i=0;i<n_recvs;i++) {
7096       for (j=0;j<nis;j++) {
7097         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7098         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7099         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7100         ptr_idxs += plen+1; /* shift pointer to received data */
7101       }
7102     }
7103     for (i=0;i<nis;i++) {
7104       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7105       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7106       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7107     }
7108     ierr = PetscFree(count_is);CHKERRQ(ierr);
7109     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7110     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7111   }
7112   /* free workspace */
7113   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7114   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7115   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7116   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7117   if (isdense) {
7118     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7119     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7120   } else {
7121     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7122   }
7123   if (nis) {
7124     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7125     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7126   }
7127 
7128   if (nvecs) {
7129     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7130     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7131     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7132     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7133     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7134     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7135     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7136     /* set values */
7137     ptr_vals = recv_buffer_vecs;
7138     ptr_idxs = recv_buffer_idxs_local;
7139     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7140     for (i=0;i<n_recvs;i++) {
7141       PetscInt j;
7142       for (j=0;j<*(ptr_idxs+1);j++) {
7143         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7144       }
7145       ptr_idxs += olengths_idxs[i];
7146       ptr_vals += olengths_idxs[i]-2;
7147     }
7148     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7149     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7150     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7151   }
7152 
7153   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7154   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7155   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7156   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7157   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7158   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7159   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7160   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7161   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7162   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7163   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7164   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7165   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7166   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7167   ierr = PetscFree(onodes);CHKERRQ(ierr);
7168   if (nis) {
7169     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7170     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7171     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7172   }
7173   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7174   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7175     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7176     for (i=0;i<nis;i++) {
7177       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7178     }
7179     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7180       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7181     }
7182     *mat_n = NULL;
7183   }
7184   PetscFunctionReturn(0);
7185 }
7186 
7187 /* temporary hack into ksp private data structure */
7188 #include <petsc/private/kspimpl.h>
7189 
7190 #undef __FUNCT__
7191 #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
7192 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7193 {
7194   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7195   PC_IS                  *pcis = (PC_IS*)pc->data;
7196   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7197   Mat                    coarsedivudotp = NULL;
7198   Mat                    coarseG,t_coarse_mat_is;
7199   MatNullSpace           CoarseNullSpace = NULL;
7200   ISLocalToGlobalMapping coarse_islg;
7201   IS                     coarse_is,*isarray;
7202   PetscInt               i,im_active=-1,active_procs=-1;
7203   PetscInt               nis,nisdofs,nisneu,nisvert;
7204   PC                     pc_temp;
7205   PCType                 coarse_pc_type;
7206   KSPType                coarse_ksp_type;
7207   PetscBool              multilevel_requested,multilevel_allowed;
7208   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7209   PetscInt               ncoarse,nedcfield;
7210   PetscBool              compute_vecs = PETSC_FALSE;
7211   PetscScalar            *array;
7212   MatReuse               coarse_mat_reuse;
7213   PetscBool              restr, full_restr, have_void;
7214   PetscErrorCode         ierr;
7215 
7216   PetscFunctionBegin;
7217   /* Assign global numbering to coarse dofs */
7218   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 */
7219     PetscInt ocoarse_size;
7220     compute_vecs = PETSC_TRUE;
7221     ocoarse_size = pcbddc->coarse_size;
7222     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7223     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7224     /* see if we can avoid some work */
7225     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7226       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7227       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7228         PC        pc;
7229         PetscBool isbddc;
7230 
7231         /* temporary workaround since PCBDDC does not have a reset method so far */
7232         ierr = KSPGetPC(pcbddc->coarse_ksp,&pc);CHKERRQ(ierr);
7233         ierr = PetscObjectTypeCompare((PetscObject)pc,PCBDDC,&isbddc);CHKERRQ(ierr);
7234         if (isbddc) {
7235           ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
7236         } else {
7237           ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7238         }
7239         coarse_reuse = PETSC_FALSE;
7240       } else { /* we can safely reuse already computed coarse matrix */
7241         coarse_reuse = PETSC_TRUE;
7242       }
7243     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7244       coarse_reuse = PETSC_FALSE;
7245     }
7246     /* reset any subassembling information */
7247     if (!coarse_reuse || pcbddc->recompute_topography) {
7248       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7249     }
7250   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7251     coarse_reuse = PETSC_TRUE;
7252   }
7253   /* assemble coarse matrix */
7254   if (coarse_reuse && pcbddc->coarse_ksp) {
7255     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7256     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7257     coarse_mat_reuse = MAT_REUSE_MATRIX;
7258   } else {
7259     coarse_mat = NULL;
7260     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7261   }
7262 
7263   /* creates temporary l2gmap and IS for coarse indexes */
7264   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7265   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7266 
7267   /* creates temporary MATIS object for coarse matrix */
7268   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7269   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7270   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7271   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7272   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);
7273   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7274   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7275   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7276   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7277 
7278   /* count "active" (i.e. with positive local size) and "void" processes */
7279   im_active = !!(pcis->n);
7280   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7281 
7282   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7283   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7284   /* full_restr : just use the receivers from the subassembling pattern */
7285   coarse_mat_is = NULL;
7286   multilevel_allowed = PETSC_FALSE;
7287   multilevel_requested = PETSC_FALSE;
7288   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7289   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7290   if (multilevel_requested) {
7291     ncoarse = active_procs/pcbddc->coarsening_ratio;
7292     restr = PETSC_FALSE;
7293     full_restr = PETSC_FALSE;
7294   } else {
7295     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7296     restr = PETSC_TRUE;
7297     full_restr = PETSC_TRUE;
7298   }
7299   if (!pcbddc->coarse_size) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7300   ncoarse = PetscMax(1,ncoarse);
7301   if (!pcbddc->coarse_subassembling) {
7302     if (pcbddc->coarsening_ratio > 1) {
7303       ierr = MatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7304     } else {
7305       PetscMPIInt size,rank;
7306       ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7307       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7308       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7309       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7310     }
7311   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7312     PetscInt    psum;
7313     PetscMPIInt size;
7314     if (pcbddc->coarse_ksp) psum = 1;
7315     else psum = 0;
7316     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7317     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7318     if (ncoarse < size) have_void = PETSC_TRUE;
7319   }
7320   /* determine if we can go multilevel */
7321   if (multilevel_requested) {
7322     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7323     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7324   }
7325   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7326 
7327   /* dump subassembling pattern */
7328   if (pcbddc->dbg_flag && multilevel_allowed) {
7329     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7330   }
7331 
7332   /* compute dofs splitting and neumann boundaries for coarse dofs */
7333   nedcfield = -1;
7334   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7335     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7336     const PetscInt         *idxs;
7337     ISLocalToGlobalMapping tmap;
7338 
7339     /* create map between primal indices (in local representative ordering) and local primal numbering */
7340     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7341     /* allocate space for temporary storage */
7342     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7343     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7344     /* allocate for IS array */
7345     nisdofs = pcbddc->n_ISForDofsLocal;
7346     if (pcbddc->nedclocal) {
7347       if (pcbddc->nedfield > -1) {
7348         nedcfield = pcbddc->nedfield;
7349       } else {
7350         nedcfield = 0;
7351         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7352         nisdofs = 1;
7353       }
7354     }
7355     nisneu = !!pcbddc->NeumannBoundariesLocal;
7356     nisvert = 0; /* nisvert is not used */
7357     nis = nisdofs + nisneu + nisvert;
7358     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7359     /* dofs splitting */
7360     for (i=0;i<nisdofs;i++) {
7361       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7362       if (nedcfield != i) {
7363         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7364         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7365         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7366         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7367       } else {
7368         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7369         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7370         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7371         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7372         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7373       }
7374       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7375       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7376       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7377     }
7378     /* neumann boundaries */
7379     if (pcbddc->NeumannBoundariesLocal) {
7380       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7381       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7382       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7383       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7384       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7385       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7386       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7387       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7388     }
7389     /* free memory */
7390     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7391     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7392     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7393   } else {
7394     nis = 0;
7395     nisdofs = 0;
7396     nisneu = 0;
7397     nisvert = 0;
7398     isarray = NULL;
7399   }
7400   /* destroy no longer needed map */
7401   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7402 
7403   /* subassemble */
7404   if (multilevel_allowed) {
7405     Vec       vp[1];
7406     PetscInt  nvecs = 0;
7407     PetscBool reuse,reuser;
7408 
7409     if (coarse_mat) reuse = PETSC_TRUE;
7410     else reuse = PETSC_FALSE;
7411     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7412     vp[0] = NULL;
7413     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7414       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7415       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7416       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7417       nvecs = 1;
7418 
7419       if (pcbddc->divudotp) {
7420         Mat      B,loc_divudotp;
7421         Vec      v,p;
7422         IS       dummy;
7423         PetscInt np;
7424 
7425         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7426         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7427         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7428         ierr = MatGetSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7429         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7430         ierr = VecSet(p,1.);CHKERRQ(ierr);
7431         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7432         ierr = VecDestroy(&p);CHKERRQ(ierr);
7433         ierr = MatDestroy(&B);CHKERRQ(ierr);
7434         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7435         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7436         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7437         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7438         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7439         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7440         ierr = VecDestroy(&v);CHKERRQ(ierr);
7441       }
7442     }
7443     if (reuser) {
7444       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7445     } else {
7446       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7447     }
7448     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7449       PetscScalar *arraym,*arrayv;
7450       PetscInt    nl;
7451       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7452       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7453       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7454       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7455       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7456       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7457       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7458       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7459     } else {
7460       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7461     }
7462   } else {
7463     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7464   }
7465   if (coarse_mat_is || coarse_mat) {
7466     PetscMPIInt size;
7467     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7468     if (!multilevel_allowed) {
7469       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7470     } else {
7471       Mat A;
7472 
7473       /* if this matrix is present, it means we are not reusing the coarse matrix */
7474       if (coarse_mat_is) {
7475         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7476         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7477         coarse_mat = coarse_mat_is;
7478       }
7479       /* be sure we don't have MatSeqDENSE as local mat */
7480       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7481       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7482     }
7483   }
7484   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7485   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7486 
7487   /* create local to global scatters for coarse problem */
7488   if (compute_vecs) {
7489     PetscInt lrows;
7490     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7491     if (coarse_mat) {
7492       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7493     } else {
7494       lrows = 0;
7495     }
7496     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7497     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7498     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7499     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7500     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7501   }
7502   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7503 
7504   /* set defaults for coarse KSP and PC */
7505   if (multilevel_allowed) {
7506     coarse_ksp_type = KSPRICHARDSON;
7507     coarse_pc_type = PCBDDC;
7508   } else {
7509     coarse_ksp_type = KSPPREONLY;
7510     coarse_pc_type = PCREDUNDANT;
7511   }
7512 
7513   /* print some info if requested */
7514   if (pcbddc->dbg_flag) {
7515     if (!multilevel_allowed) {
7516       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7517       if (multilevel_requested) {
7518         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);
7519       } else if (pcbddc->max_levels) {
7520         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7521       }
7522       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7523     }
7524   }
7525 
7526   /* communicate coarse discrete gradient */
7527   coarseG = NULL;
7528   if (pcbddc->nedcG && multilevel_allowed) {
7529     MPI_Comm ccomm;
7530     if (coarse_mat) {
7531       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7532     } else {
7533       ccomm = MPI_COMM_NULL;
7534     }
7535     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7536   }
7537 
7538   /* create the coarse KSP object only once with defaults */
7539   if (coarse_mat) {
7540     PetscViewer dbg_viewer = NULL;
7541     if (pcbddc->dbg_flag) {
7542       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7543       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7544     }
7545     if (!pcbddc->coarse_ksp) {
7546       char prefix[256],str_level[16];
7547       size_t len;
7548 
7549       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7550       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7551       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7552       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7553       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7554       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7555       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7556       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7557       /* TODO is this logic correct? should check for coarse_mat type */
7558       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7559       /* prefix */
7560       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7561       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7562       if (!pcbddc->current_level) {
7563         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7564         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7565       } else {
7566         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7567         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7568         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7569         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7570         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7571         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7572       }
7573       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7574       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7575       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7576       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7577       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7578       /* allow user customization */
7579       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7580     }
7581     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7582     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7583     if (nisdofs) {
7584       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7585       for (i=0;i<nisdofs;i++) {
7586         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7587       }
7588     }
7589     if (nisneu) {
7590       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7591       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7592     }
7593     if (nisvert) {
7594       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7595       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7596     }
7597     if (coarseG) {
7598       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7599     }
7600 
7601     /* get some info after set from options */
7602     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7603     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7604     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7605     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
7606       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7607       isbddc = PETSC_FALSE;
7608     }
7609     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7610     if (isredundant) {
7611       KSP inner_ksp;
7612       PC  inner_pc;
7613       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7614       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7615       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7616     }
7617 
7618     /* parameters which miss an API */
7619     if (isbddc) {
7620       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7621       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7622       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7623       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7624       if (pcbddc_coarse->benign_saddle_point) {
7625         Mat                    coarsedivudotp_is;
7626         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7627         IS                     row,col;
7628         const PetscInt         *gidxs;
7629         PetscInt               n,st,M,N;
7630 
7631         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7632         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7633         st = st-n;
7634         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7635         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7636         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7637         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7638         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7639         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7640         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7641         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7642         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7643         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7644         ierr = ISDestroy(&row);CHKERRQ(ierr);
7645         ierr = ISDestroy(&col);CHKERRQ(ierr);
7646         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7647         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7648         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7649         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7650         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7651         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7652         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7653         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7654         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7655         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7656         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7657         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7658       }
7659     }
7660 
7661     /* propagate symmetry info of coarse matrix */
7662     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7663     if (pc->pmat->symmetric_set) {
7664       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7665     }
7666     if (pc->pmat->hermitian_set) {
7667       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7668     }
7669     if (pc->pmat->spd_set) {
7670       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7671     }
7672     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7673       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7674     }
7675     /* set operators */
7676     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7677     if (pcbddc->dbg_flag) {
7678       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7679     }
7680   }
7681   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7682   ierr = PetscFree(isarray);CHKERRQ(ierr);
7683 #if 0
7684   {
7685     PetscViewer viewer;
7686     char filename[256];
7687     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7688     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7689     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7690     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7691     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7692     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7693   }
7694 #endif
7695 
7696   if (pcbddc->coarse_ksp) {
7697     Vec crhs,csol;
7698 
7699     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7700     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7701     if (!csol) {
7702       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7703     }
7704     if (!crhs) {
7705       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7706     }
7707   }
7708   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7709 
7710   /* compute null space for coarse solver if the benign trick has been requested */
7711   if (pcbddc->benign_null) {
7712 
7713     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7714     for (i=0;i<pcbddc->benign_n;i++) {
7715       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7716     }
7717     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7718     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7719     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7720     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7721     if (coarse_mat) {
7722       Vec         nullv;
7723       PetscScalar *array,*array2;
7724       PetscInt    nl;
7725 
7726       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7727       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7728       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7729       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7730       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7731       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7732       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7733       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7734       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7735       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7736     }
7737   }
7738 
7739   if (pcbddc->coarse_ksp) {
7740     PetscBool ispreonly;
7741 
7742     if (CoarseNullSpace) {
7743       PetscBool isnull;
7744       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7745       if (isnull) {
7746         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7747       }
7748       /* TODO: add local nullspaces (if any) */
7749     }
7750     /* setup coarse ksp */
7751     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7752     /* Check coarse problem if in debug mode or if solving with an iterative method */
7753     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7754     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7755       KSP       check_ksp;
7756       KSPType   check_ksp_type;
7757       PC        check_pc;
7758       Vec       check_vec,coarse_vec;
7759       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7760       PetscInt  its;
7761       PetscBool compute_eigs;
7762       PetscReal *eigs_r,*eigs_c;
7763       PetscInt  neigs;
7764       const char *prefix;
7765 
7766       /* Create ksp object suitable for estimation of extreme eigenvalues */
7767       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7768       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7769       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7770       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7771       /* prevent from setup unneeded object */
7772       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7773       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7774       if (ispreonly) {
7775         check_ksp_type = KSPPREONLY;
7776         compute_eigs = PETSC_FALSE;
7777       } else {
7778         check_ksp_type = KSPGMRES;
7779         compute_eigs = PETSC_TRUE;
7780       }
7781       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7782       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7783       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7784       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7785       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7786       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7787       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7788       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7789       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7790       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7791       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7792       /* create random vec */
7793       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7794       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7795       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7796       /* solve coarse problem */
7797       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7798       /* set eigenvalue estimation if preonly has not been requested */
7799       if (compute_eigs) {
7800         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7801         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7802         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7803         if (neigs) {
7804           lambda_max = eigs_r[neigs-1];
7805           lambda_min = eigs_r[0];
7806           if (pcbddc->use_coarse_estimates) {
7807             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7808               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7809               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7810             }
7811           }
7812         }
7813       }
7814 
7815       /* check coarse problem residual error */
7816       if (pcbddc->dbg_flag) {
7817         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
7818         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7819         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
7820         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7821         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7822         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
7823         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
7824         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
7825         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
7826         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
7827         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
7828         if (CoarseNullSpace) {
7829           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
7830         }
7831         if (compute_eigs) {
7832           PetscReal          lambda_max_s,lambda_min_s;
7833           KSPConvergedReason reason;
7834           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
7835           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
7836           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
7837           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
7838           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);
7839           for (i=0;i<neigs;i++) {
7840             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
7841           }
7842         }
7843         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
7844         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7845       }
7846       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
7847       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
7848       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
7849       if (compute_eigs) {
7850         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
7851         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
7852       }
7853     }
7854   }
7855   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
7856   /* print additional info */
7857   if (pcbddc->dbg_flag) {
7858     /* waits until all processes reaches this point */
7859     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
7860     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
7861     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7862   }
7863 
7864   /* free memory */
7865   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
7866   PetscFunctionReturn(0);
7867 }
7868 
7869 #undef __FUNCT__
7870 #define __FUNCT__ "PCBDDCComputePrimalNumbering"
7871 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
7872 {
7873   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7874   PC_IS*         pcis = (PC_IS*)pc->data;
7875   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
7876   IS             subset,subset_mult,subset_n;
7877   PetscInt       local_size,coarse_size=0;
7878   PetscInt       *local_primal_indices=NULL;
7879   const PetscInt *t_local_primal_indices;
7880   PetscErrorCode ierr;
7881 
7882   PetscFunctionBegin;
7883   /* Compute global number of coarse dofs */
7884   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
7885   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
7886   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
7887   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7888   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
7889   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
7890   ierr = ISDestroy(&subset);CHKERRQ(ierr);
7891   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
7892   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
7893   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);
7894   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
7895   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7896   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
7897   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7898   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7899 
7900   /* check numbering */
7901   if (pcbddc->dbg_flag) {
7902     PetscScalar coarsesum,*array,*array2;
7903     PetscInt    i;
7904     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
7905 
7906     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7907     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7908     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
7909     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7910     /* counter */
7911     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7912     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
7913     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7914     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7915     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7916     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7917     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
7918     for (i=0;i<pcbddc->local_primal_size;i++) {
7919       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
7920     }
7921     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
7922     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
7923     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7924     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7925     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7926     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7927     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7928     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
7929     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
7930     for (i=0;i<pcis->n;i++) {
7931       if (array[i] != 0.0 && array[i] != array2[i]) {
7932         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
7933         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
7934         set_error = PETSC_TRUE;
7935         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
7936         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);
7937       }
7938     }
7939     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
7940     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7941     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7942     for (i=0;i<pcis->n;i++) {
7943       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
7944     }
7945     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
7946     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7947     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7948     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7949     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
7950     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
7951     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
7952       PetscInt *gidxs;
7953 
7954       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
7955       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
7956       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
7957       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7958       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
7959       for (i=0;i<pcbddc->local_primal_size;i++) {
7960         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);
7961       }
7962       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7963       ierr = PetscFree(gidxs);CHKERRQ(ierr);
7964     }
7965     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7966     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7967     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
7968   }
7969   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
7970   /* get back data */
7971   *coarse_size_n = coarse_size;
7972   *local_primal_indices_n = local_primal_indices;
7973   PetscFunctionReturn(0);
7974 }
7975 
7976 #undef __FUNCT__
7977 #define __FUNCT__ "PCBDDCGlobalToLocal"
7978 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
7979 {
7980   IS             localis_t;
7981   PetscInt       i,lsize,*idxs,n;
7982   PetscScalar    *vals;
7983   PetscErrorCode ierr;
7984 
7985   PetscFunctionBegin;
7986   /* get indices in local ordering exploiting local to global map */
7987   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
7988   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
7989   for (i=0;i<lsize;i++) vals[i] = 1.0;
7990   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
7991   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
7992   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
7993   if (idxs) { /* multilevel guard */
7994     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
7995   }
7996   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
7997   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
7998   ierr = PetscFree(vals);CHKERRQ(ierr);
7999   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8000   /* now compute set in local ordering */
8001   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8002   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8003   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8004   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8005   for (i=0,lsize=0;i<n;i++) {
8006     if (PetscRealPart(vals[i]) > 0.5) {
8007       lsize++;
8008     }
8009   }
8010   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8011   for (i=0,lsize=0;i<n;i++) {
8012     if (PetscRealPart(vals[i]) > 0.5) {
8013       idxs[lsize++] = i;
8014     }
8015   }
8016   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8017   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8018   *localis = localis_t;
8019   PetscFunctionReturn(0);
8020 }
8021 
8022 #undef __FUNCT__
8023 #define __FUNCT__ "PCBDDCSetUpSubSchurs"
8024 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8025 {
8026   PC_IS               *pcis=(PC_IS*)pc->data;
8027   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8028   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8029   Mat                 S_j;
8030   PetscInt            *used_xadj,*used_adjncy;
8031   PetscBool           free_used_adj;
8032   PetscErrorCode      ierr;
8033 
8034   PetscFunctionBegin;
8035   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8036   free_used_adj = PETSC_FALSE;
8037   if (pcbddc->sub_schurs_layers == -1) {
8038     used_xadj = NULL;
8039     used_adjncy = NULL;
8040   } else {
8041     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8042       used_xadj = pcbddc->mat_graph->xadj;
8043       used_adjncy = pcbddc->mat_graph->adjncy;
8044     } else if (pcbddc->computed_rowadj) {
8045       used_xadj = pcbddc->mat_graph->xadj;
8046       used_adjncy = pcbddc->mat_graph->adjncy;
8047     } else {
8048       PetscBool      flg_row=PETSC_FALSE;
8049       const PetscInt *xadj,*adjncy;
8050       PetscInt       nvtxs;
8051 
8052       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8053       if (flg_row) {
8054         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8055         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8056         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8057         free_used_adj = PETSC_TRUE;
8058       } else {
8059         pcbddc->sub_schurs_layers = -1;
8060         used_xadj = NULL;
8061         used_adjncy = NULL;
8062       }
8063       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8064     }
8065   }
8066 
8067   /* setup sub_schurs data */
8068   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8069   if (!sub_schurs->schur_explicit) {
8070     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8071     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8072     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);
8073   } else {
8074     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8075     PetscBool isseqaij,need_change = PETSC_FALSE;
8076     PetscInt  benign_n;
8077     Mat       change = NULL;
8078     Vec       scaling = NULL;
8079     IS        change_primal = NULL;
8080 
8081     if (!pcbddc->use_vertices && reuse_solvers) {
8082       PetscInt n_vertices;
8083 
8084       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8085       reuse_solvers = (PetscBool)!n_vertices;
8086     }
8087     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8088     if (!isseqaij) {
8089       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8090       if (matis->A == pcbddc->local_mat) {
8091         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8092         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8093       } else {
8094         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8095       }
8096     }
8097     if (!pcbddc->benign_change_explicit) {
8098       benign_n = pcbddc->benign_n;
8099     } else {
8100       benign_n = 0;
8101     }
8102     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8103        We need a global reduction to avoid possible deadlocks.
8104        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8105     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8106       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8107       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8108       need_change = (PetscBool)(!need_change);
8109     }
8110     /* If the user defines additional constraints, we import them here.
8111        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 */
8112     if (need_change) {
8113       PC_IS   *pcisf;
8114       PC_BDDC *pcbddcf;
8115       PC      pcf;
8116 
8117       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8118       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8119       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8120       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8121       /* hacks */
8122       pcisf = (PC_IS*)pcf->data;
8123       pcisf->is_B_local = pcis->is_B_local;
8124       pcisf->vec1_N = pcis->vec1_N;
8125       pcisf->BtoNmap = pcis->BtoNmap;
8126       pcisf->n = pcis->n;
8127       pcisf->n_B = pcis->n_B;
8128       pcbddcf = (PC_BDDC*)pcf->data;
8129       ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8130       pcbddcf->mat_graph = pcbddc->mat_graph;
8131       pcbddcf->use_faces = PETSC_TRUE;
8132       pcbddcf->use_change_of_basis = PETSC_TRUE;
8133       pcbddcf->use_change_on_faces = PETSC_TRUE;
8134       pcbddcf->use_qr_single = PETSC_TRUE;
8135       pcbddcf->fake_change = PETSC_TRUE;
8136       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8137       /* store information on primal vertices and change of basis (in local numbering) */
8138       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8139       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8140       change = pcbddcf->ConstraintMatrix;
8141       pcbddcf->ConstraintMatrix = NULL;
8142       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8143       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8144       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8145       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8146       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8147       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8148       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8149       pcf->ops->destroy = NULL;
8150       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8151     }
8152     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8153     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);
8154     ierr = MatDestroy(&change);CHKERRQ(ierr);
8155     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8156   }
8157   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8158 
8159   /* free adjacency */
8160   if (free_used_adj) {
8161     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8162   }
8163   PetscFunctionReturn(0);
8164 }
8165 
8166 #undef __FUNCT__
8167 #define __FUNCT__ "PCBDDCInitSubSchurs"
8168 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8169 {
8170   PC_IS               *pcis=(PC_IS*)pc->data;
8171   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8172   PCBDDCGraph         graph;
8173   PetscErrorCode      ierr;
8174 
8175   PetscFunctionBegin;
8176   /* attach interface graph for determining subsets */
8177   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8178     IS       verticesIS,verticescomm;
8179     PetscInt vsize,*idxs;
8180 
8181     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8182     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8183     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8184     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8185     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8186     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8187     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8188     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8189     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8190     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8191     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8192   } else {
8193     graph = pcbddc->mat_graph;
8194   }
8195   /* print some info */
8196   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8197     IS       vertices;
8198     PetscInt nv,nedges,nfaces;
8199     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8200     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8201     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8202     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8203     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8204     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8205     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8206     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8207     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8208     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8209     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8210   }
8211 
8212   /* sub_schurs init */
8213   if (!pcbddc->sub_schurs) {
8214     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8215   }
8216   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8217 
8218   /* free graph struct */
8219   if (pcbddc->sub_schurs_rebuild) {
8220     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8221   }
8222   PetscFunctionReturn(0);
8223 }
8224 
8225 #undef __FUNCT__
8226 #define __FUNCT__ "PCBDDCCheckOperator"
8227 PetscErrorCode PCBDDCCheckOperator(PC pc)
8228 {
8229   PC_IS               *pcis=(PC_IS*)pc->data;
8230   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8231   PetscErrorCode      ierr;
8232 
8233   PetscFunctionBegin;
8234   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8235     IS             zerodiag = NULL;
8236     Mat            S_j,B0_B=NULL;
8237     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8238     PetscScalar    *p0_check,*array,*array2;
8239     PetscReal      norm;
8240     PetscInt       i;
8241 
8242     /* B0 and B0_B */
8243     if (zerodiag) {
8244       IS       dummy;
8245 
8246       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8247       ierr = MatGetSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8248       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8249       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8250     }
8251     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8252     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8253     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8254     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8255     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8256     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8257     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8258     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8259     /* S_j */
8260     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8261     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8262 
8263     /* mimic vector in \widetilde{W}_\Gamma */
8264     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8265     /* continuous in primal space */
8266     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8267     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8268     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8269     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8270     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8271     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8272     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8273     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8274     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8275     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8276     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8277     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8278     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8279     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8280 
8281     /* assemble rhs for coarse problem */
8282     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8283     /* local with Schur */
8284     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8285     if (zerodiag) {
8286       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8287       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8288       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8289       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8290     }
8291     /* sum on primal nodes the local contributions */
8292     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8293     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8294     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8295     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8296     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8297     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8298     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8299     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8300     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8301     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8302     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8303     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8304     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8305     /* scale primal nodes (BDDC sums contibutions) */
8306     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8307     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8308     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8309     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8310     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8311     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8312     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8313     /* global: \widetilde{B0}_B w_\Gamma */
8314     if (zerodiag) {
8315       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8316       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8317       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8318       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8319     }
8320     /* BDDC */
8321     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8322     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8323 
8324     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8325     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8326     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8327     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8328     for (i=0;i<pcbddc->benign_n;i++) {
8329       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8330     }
8331     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8332     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8333     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8334     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8335     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8336     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8337   }
8338   PetscFunctionReturn(0);
8339 }
8340 
8341 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8342 #undef __FUNCT__
8343 #define __FUNCT__ "MatMPIAIJRestrict"
8344 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8345 {
8346   Mat            At;
8347   IS             rows;
8348   PetscInt       rst,ren;
8349   PetscErrorCode ierr;
8350   PetscLayout    rmap;
8351 
8352   PetscFunctionBegin;
8353   rst = ren = 0;
8354   if (ccomm != MPI_COMM_NULL) {
8355     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8356     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8357     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8358     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8359     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8360   }
8361   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8362   ierr = MatGetSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8363   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8364 
8365   if (ccomm != MPI_COMM_NULL) {
8366     Mat_MPIAIJ *a,*b;
8367     IS         from,to;
8368     Vec        gvec;
8369     PetscInt   lsize;
8370 
8371     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8372     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8373     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8374     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8375     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8376     a    = (Mat_MPIAIJ*)At->data;
8377     b    = (Mat_MPIAIJ*)(*B)->data;
8378     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8379     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8380     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8381     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8382     b->A = a->A;
8383     b->B = a->B;
8384 
8385     b->donotstash      = a->donotstash;
8386     b->roworiented     = a->roworiented;
8387     b->rowindices      = 0;
8388     b->rowvalues       = 0;
8389     b->getrowactive    = PETSC_FALSE;
8390 
8391     (*B)->rmap         = rmap;
8392     (*B)->factortype   = A->factortype;
8393     (*B)->assembled    = PETSC_TRUE;
8394     (*B)->insertmode   = NOT_SET_VALUES;
8395     (*B)->preallocated = PETSC_TRUE;
8396 
8397     if (a->colmap) {
8398 #if defined(PETSC_USE_CTABLE)
8399       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8400 #else
8401       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8402       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8403       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8404 #endif
8405     } else b->colmap = 0;
8406     if (a->garray) {
8407       PetscInt len;
8408       len  = a->B->cmap->n;
8409       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8410       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8411       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8412     } else b->garray = 0;
8413 
8414     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8415     b->lvec = a->lvec;
8416     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8417 
8418     /* cannot use VecScatterCopy */
8419     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8420     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8421     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8422     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8423     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8424     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8425     ierr = ISDestroy(&from);CHKERRQ(ierr);
8426     ierr = ISDestroy(&to);CHKERRQ(ierr);
8427     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8428   }
8429   ierr = MatDestroy(&At);CHKERRQ(ierr);
8430   PetscFunctionReturn(0);
8431 }
8432