xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision e363d98ac5cbd12c5df5b85ab726db5bdaa1c9d4)
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   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3247   n_R = pcis->n - pcbddc->n_vertices;
3248   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3249   /* local work vectors (try to avoid unneeded work)*/
3250   /* R nodes */
3251   old_size = -1;
3252   if (pcbddc->vec1_R) {
3253     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3254   }
3255   if (n_R != old_size) {
3256     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3257     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3258     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3259     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3260     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3261     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3262   }
3263   /* local primal dofs */
3264   old_size = -1;
3265   if (pcbddc->vec1_P) {
3266     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3267   }
3268   if (pcbddc->local_primal_size != old_size) {
3269     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3270     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3271     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3272     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3273   }
3274   /* local explicit constraints */
3275   old_size = -1;
3276   if (pcbddc->vec1_C) {
3277     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3278   }
3279   if (n_constraints && n_constraints != old_size) {
3280     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3281     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3282     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3283     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3284   }
3285   PetscFunctionReturn(0);
3286 }
3287 
3288 #undef __FUNCT__
3289 #define __FUNCT__ "PCBDDCSetUpCorrection"
3290 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3291 {
3292   PetscErrorCode  ierr;
3293   /* pointers to pcis and pcbddc */
3294   PC_IS*          pcis = (PC_IS*)pc->data;
3295   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3296   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3297   /* submatrices of local problem */
3298   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3299   /* submatrices of local coarse problem */
3300   Mat             S_VV,S_CV,S_VC,S_CC;
3301   /* working matrices */
3302   Mat             C_CR;
3303   /* additional working stuff */
3304   PC              pc_R;
3305   Mat             F;
3306   Vec             dummy_vec;
3307   PetscBool       isLU,isCHOL,isILU,need_benign_correction;
3308   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3309   PetscScalar     *work;
3310   PetscInt        *idx_V_B;
3311   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3312   PetscInt        i,n_R,n_D,n_B;
3313 
3314   /* some shortcuts to scalars */
3315   PetscScalar     one=1.0,m_one=-1.0;
3316 
3317   PetscFunctionBegin;
3318   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");
3319 
3320   /* Set Non-overlapping dimensions */
3321   n_vertices = pcbddc->n_vertices;
3322   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3323   n_B = pcis->n_B;
3324   n_D = pcis->n - n_B;
3325   n_R = pcis->n - n_vertices;
3326 
3327   /* vertices in boundary numbering */
3328   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3329   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3330   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3331 
3332   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3333   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3334   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3335   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3336   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3337   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3338   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3339   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3340   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3341   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3342 
3343   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3344   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3345   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3346   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3347   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3348   lda_rhs = n_R;
3349   need_benign_correction = PETSC_FALSE;
3350   if (isLU || isILU || isCHOL) {
3351     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3352   } else if (sub_schurs && sub_schurs->reuse_solver) {
3353     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3354     MatFactorType      type;
3355 
3356     F = reuse_solver->F;
3357     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3358     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3359     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3360     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3361   } else {
3362     F = NULL;
3363   }
3364 
3365   /* allocate workspace */
3366   n = 0;
3367   if (n_constraints) {
3368     n += lda_rhs*n_constraints;
3369   }
3370   if (n_vertices) {
3371     n = PetscMax(2*lda_rhs*n_vertices,n);
3372     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3373   }
3374   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3375 
3376   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3377   dummy_vec = NULL;
3378   if (need_benign_correction && lda_rhs != n_R && F) {
3379     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3380   }
3381 
3382   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3383   if (n_constraints) {
3384     Mat         M1,M2,M3,C_B;
3385     IS          is_aux;
3386     PetscScalar *array,*array2;
3387 
3388     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3389     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3390 
3391     /* Extract constraints on R nodes: C_{CR}  */
3392     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3393     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3394     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3395 
3396     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3397     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3398     ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3399     for (i=0;i<n_constraints;i++) {
3400       const PetscScalar *row_cmat_values;
3401       const PetscInt    *row_cmat_indices;
3402       PetscInt          size_of_constraint,j;
3403 
3404       ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3405       for (j=0;j<size_of_constraint;j++) {
3406         work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3407       }
3408       ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3409     }
3410     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3411     if (F) {
3412       Mat B;
3413 
3414       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3415       if (need_benign_correction) {
3416         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3417 
3418         /* rhs is already zero on interior dofs, no need to change the rhs */
3419         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3420       }
3421       ierr = MatMatSolve(F,B,local_auxmat2_R);CHKERRQ(ierr);
3422       if (need_benign_correction) {
3423         PetscScalar        *marr;
3424         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3425 
3426         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3427         if (lda_rhs != n_R) {
3428           for (i=0;i<n_constraints;i++) {
3429             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3430             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3431             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3432           }
3433         } else {
3434           for (i=0;i<n_constraints;i++) {
3435             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3436             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3437             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3438           }
3439         }
3440         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3441       }
3442       ierr = MatDestroy(&B);CHKERRQ(ierr);
3443     } else {
3444       PetscScalar *marr;
3445 
3446       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3447       for (i=0;i<n_constraints;i++) {
3448         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3449         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3450         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3451         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3452         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3453       }
3454       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3455     }
3456     if (!pcbddc->switch_static) {
3457       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3458       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3459       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3460       for (i=0;i<n_constraints;i++) {
3461         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3462         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3463         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3464         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3465         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3466         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3467       }
3468       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3469       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3470       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3471     } else {
3472       if (lda_rhs != n_R) {
3473         IS dummy;
3474 
3475         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3476         ierr = MatGetSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3477         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3478       } else {
3479         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3480         pcbddc->local_auxmat2 = local_auxmat2_R;
3481       }
3482       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3483     }
3484     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3485     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3486     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3487     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M1);CHKERRQ(ierr);
3488     ierr = MatDuplicate(M3,MAT_DO_NOT_COPY_VALUES,&M2);CHKERRQ(ierr);
3489     if (isCHOL) {
3490       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3491     } else {
3492       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3493     }
3494     ierr = VecSet(pcbddc->vec1_C,one);CHKERRQ(ierr);
3495     ierr = MatDiagonalSet(M2,pcbddc->vec1_C,INSERT_VALUES);CHKERRQ(ierr);
3496     ierr = MatMatSolve(M3,M2,M1);CHKERRQ(ierr);
3497     ierr = MatDestroy(&M2);CHKERRQ(ierr);
3498     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3499     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3500     ierr = MatMatMult(M1,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3501     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3502     ierr = MatCopy(M1,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3503     ierr = MatDestroy(&M1);CHKERRQ(ierr);
3504   }
3505 
3506   /* Get submatrices from subdomain matrix */
3507   if (n_vertices) {
3508     IS is_aux;
3509 
3510     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
3511       IS tis;
3512 
3513       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
3514       ierr = ISSort(tis);CHKERRQ(ierr);
3515       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
3516       ierr = ISDestroy(&tis);CHKERRQ(ierr);
3517     } else {
3518       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
3519     }
3520     ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
3521     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
3522     ierr = MatGetSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
3523     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3524   }
3525 
3526   /* Matrix of coarse basis functions (local) */
3527   if (pcbddc->coarse_phi_B) {
3528     PetscInt on_B,on_primal,on_D=n_D;
3529     if (pcbddc->coarse_phi_D) {
3530       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
3531     }
3532     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
3533     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
3534       PetscScalar *marray;
3535 
3536       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
3537       ierr = PetscFree(marray);CHKERRQ(ierr);
3538       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3539       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3540       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3541       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3542     }
3543   }
3544 
3545   if (!pcbddc->coarse_phi_B) {
3546     PetscScalar *marray;
3547 
3548     n = n_B*pcbddc->local_primal_size;
3549     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3550       n += n_D*pcbddc->local_primal_size;
3551     }
3552     if (!pcbddc->symmetric_primal) {
3553       n *= 2;
3554     }
3555     ierr = PetscCalloc1(n,&marray);CHKERRQ(ierr);
3556     ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3557     n = n_B*pcbddc->local_primal_size;
3558     if (pcbddc->switch_static || pcbddc->dbg_flag) {
3559       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3560       n += n_D*pcbddc->local_primal_size;
3561     }
3562     if (!pcbddc->symmetric_primal) {
3563       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3564       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3565         n = n_B*pcbddc->local_primal_size;
3566         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marray+n,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3567       }
3568     } else {
3569       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
3570       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
3571       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3572         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
3573         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
3574       }
3575     }
3576   }
3577 
3578   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
3579   p0_lidx_I = NULL;
3580   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
3581     const PetscInt *idxs;
3582 
3583     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3584     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
3585     for (i=0;i<pcbddc->benign_n;i++) {
3586       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
3587     }
3588     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
3589   }
3590 
3591   /* vertices */
3592   if (n_vertices) {
3593 
3594     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
3595 
3596     if (n_R) {
3597       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
3598       PetscBLASInt B_N,B_one = 1;
3599       PetscScalar  *x,*y;
3600       PetscBool    isseqaij;
3601 
3602       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
3603       if (need_benign_correction) {
3604         ISLocalToGlobalMapping RtoN;
3605         IS                     is_p0;
3606         PetscInt               *idxs_p0,n;
3607 
3608         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
3609         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
3610         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
3611         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);
3612         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
3613         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
3614         ierr = MatGetSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
3615         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
3616       }
3617 
3618       if (lda_rhs == n_R) {
3619         ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3620       } else {
3621         PetscScalar    *av,*array;
3622         const PetscInt *xadj,*adjncy;
3623         PetscInt       n;
3624         PetscBool      flg_row;
3625 
3626         array = work+lda_rhs*n_vertices;
3627         ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3628         ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
3629         ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3630         ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
3631         for (i=0;i<n;i++) {
3632           PetscInt j;
3633           for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
3634         }
3635         ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3636         ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3637         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
3638       }
3639       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3640       if (need_benign_correction) {
3641         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3642         PetscScalar        *marr;
3643 
3644         ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3645         /* need \Phi^T A_RV = (I+L)A_RV, L given by
3646 
3647                | 0 0  0 | (V)
3648            L = | 0 0 -1 | (P-p0)
3649                | 0 0 -1 | (p0)
3650 
3651         */
3652         for (i=0;i<reuse_solver->benign_n;i++) {
3653           const PetscScalar *vals;
3654           const PetscInt    *idxs,*idxs_zero;
3655           PetscInt          n,j,nz;
3656 
3657           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3658           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3659           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3660           for (j=0;j<n;j++) {
3661             PetscScalar val = vals[j];
3662             PetscInt    k,col = idxs[j];
3663             for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
3664           }
3665           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3666           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3667         }
3668         ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3669       }
3670       if (F) {
3671         /* need to correct the rhs */
3672         if (need_benign_correction) {
3673           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3674           PetscScalar        *marr;
3675 
3676           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
3677           if (lda_rhs != n_R) {
3678             for (i=0;i<n_vertices;i++) {
3679               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3680               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3681               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3682             }
3683           } else {
3684             for (i=0;i<n_vertices;i++) {
3685               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3686               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3687               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3688             }
3689           }
3690           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
3691         }
3692         ierr = MatMatSolve(F,A_RV,A_RRmA_RV);CHKERRQ(ierr);
3693         /* need to correct the solution */
3694         if (need_benign_correction) {
3695           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3696           PetscScalar        *marr;
3697 
3698           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3699           if (lda_rhs != n_R) {
3700             for (i=0;i<n_vertices;i++) {
3701               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3702               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3703               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3704             }
3705           } else {
3706             for (i=0;i<n_vertices;i++) {
3707               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3708               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3709               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3710             }
3711           }
3712           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
3713         }
3714       } else {
3715         ierr = MatDenseGetArray(A_RV,&y);CHKERRQ(ierr);
3716         for (i=0;i<n_vertices;i++) {
3717           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
3718           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
3719           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3720           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3721           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3722         }
3723         ierr = MatDenseRestoreArray(A_RV,&y);CHKERRQ(ierr);
3724       }
3725       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3726       /* S_VV and S_CV */
3727       if (n_constraints) {
3728         Mat B;
3729 
3730         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
3731         for (i=0;i<n_vertices;i++) {
3732           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3733           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
3734           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3735           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3736           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3737           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3738         }
3739         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3740         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
3741         ierr = MatDestroy(&B);CHKERRQ(ierr);
3742         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
3743         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3744         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
3745         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
3746         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
3747         ierr = MatDestroy(&B);CHKERRQ(ierr);
3748       }
3749       ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
3750       if (!isseqaij) { /* MatMatMult with SEQ(S)BAIJ below will raise an error */
3751         ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3752       }
3753       if (lda_rhs != n_R) {
3754         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3755         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
3756         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
3757       }
3758       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
3759       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
3760       if (need_benign_correction) {
3761         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3762         PetscScalar      *marr,*sums;
3763 
3764         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
3765         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
3766         for (i=0;i<reuse_solver->benign_n;i++) {
3767           const PetscScalar *vals;
3768           const PetscInt    *idxs,*idxs_zero;
3769           PetscInt          n,j,nz;
3770 
3771           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
3772           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3773           for (j=0;j<n_vertices;j++) {
3774             PetscInt k;
3775             sums[j] = 0.;
3776             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
3777           }
3778           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3779           for (j=0;j<n;j++) {
3780             PetscScalar val = vals[j];
3781             PetscInt k;
3782             for (k=0;k<n_vertices;k++) {
3783               marr[idxs[j]+k*n_vertices] += val*sums[k];
3784             }
3785           }
3786           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
3787           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
3788         }
3789         ierr = PetscFree(sums);CHKERRQ(ierr);
3790         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
3791         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
3792       }
3793       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
3794       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
3795       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
3796       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
3797       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
3798       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
3799       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
3800       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3801       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
3802     } else {
3803       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3804     }
3805     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
3806 
3807     /* coarse basis functions */
3808     for (i=0;i<n_vertices;i++) {
3809       PetscScalar *y;
3810 
3811       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3812       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3813       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3814       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3815       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3816       y[n_B*i+idx_V_B[i]] = 1.0;
3817       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3818       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3819 
3820       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3821         PetscInt j;
3822 
3823         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3824         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3825         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3826         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3827         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3828         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3829         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3830       }
3831       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3832     }
3833     /* if n_R == 0 the object is not destroyed */
3834     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
3835   }
3836   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
3837 
3838   if (n_constraints) {
3839     Mat B;
3840 
3841     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
3842     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3843     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
3844     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
3845     if (n_vertices) {
3846       if (isCHOL) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
3847         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
3848       } else {
3849         Mat S_VCt;
3850 
3851         if (lda_rhs != n_R) {
3852           ierr = MatDestroy(&B);CHKERRQ(ierr);
3853           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
3854           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
3855         }
3856         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
3857         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3858         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
3859       }
3860     }
3861     ierr = MatDestroy(&B);CHKERRQ(ierr);
3862     /* coarse basis functions */
3863     for (i=0;i<n_constraints;i++) {
3864       PetscScalar *y;
3865 
3866       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
3867       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3868       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
3869       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3870       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3871       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
3872       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3873       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3874         PetscInt j;
3875 
3876         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3877         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
3878         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3879         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3880         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
3881         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
3882         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
3883       }
3884       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3885     }
3886   }
3887   if (n_constraints) {
3888     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
3889   }
3890   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
3891 
3892   /* coarse matrix entries relative to B_0 */
3893   if (pcbddc->benign_n) {
3894     Mat         B0_B,B0_BPHI;
3895     IS          is_dummy;
3896     PetscScalar *data;
3897     PetscInt    j;
3898 
3899     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
3900     ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
3901     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
3902     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
3903     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
3904     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
3905     for (j=0;j<pcbddc->benign_n;j++) {
3906       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
3907       for (i=0;i<pcbddc->local_primal_size;i++) {
3908         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
3909         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
3910       }
3911     }
3912     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
3913     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
3914     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
3915   }
3916 
3917   /* compute other basis functions for non-symmetric problems */
3918   if (!pcbddc->symmetric_primal) {
3919     Mat         B_V=NULL,B_C=NULL;
3920     PetscScalar *marray;
3921 
3922     if (n_constraints) {
3923       Mat S_CCT,C_CRT;
3924 
3925       ierr = MatTranspose(C_CR,MAT_INPLACE_MATRIX,&C_CRT);CHKERRQ(ierr);
3926       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
3927       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
3928       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
3929       if (n_vertices) {
3930         Mat S_VCT;
3931 
3932         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
3933         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
3934         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
3935       }
3936       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
3937     } else {
3938       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
3939     }
3940     if (n_vertices && n_R) {
3941       PetscScalar    *av,*marray;
3942       const PetscInt *xadj,*adjncy;
3943       PetscInt       n;
3944       PetscBool      flg_row;
3945 
3946       /* B_V = B_V - A_VR^T */
3947       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
3948       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3949       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
3950       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
3951       for (i=0;i<n;i++) {
3952         PetscInt j;
3953         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
3954       }
3955       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
3956       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
3957       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
3958     }
3959 
3960     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
3961     ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
3962     for (i=0;i<n_vertices;i++) {
3963       ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
3964       ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
3965       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3966       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3967       ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3968     }
3969     ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
3970     if (B_C) {
3971       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
3972       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
3973         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
3974         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
3975         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3976         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3977         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3978       }
3979       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
3980     }
3981     /* coarse basis functions */
3982     for (i=0;i<pcbddc->local_primal_size;i++) {
3983       PetscScalar *y;
3984 
3985       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
3986       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
3987       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
3988       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3989       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3990       if (i<n_vertices) {
3991         y[n_B*i+idx_V_B[i]] = 1.0;
3992       }
3993       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
3994       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3995 
3996       if (pcbddc->switch_static || pcbddc->dbg_flag) {
3997         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
3998         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
3999         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4000         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4001         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4002         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4003       }
4004       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4005     }
4006     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4007     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4008   }
4009   /* free memory */
4010   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4011   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4012   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4013   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4014   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4015   ierr = PetscFree(work);CHKERRQ(ierr);
4016   if (n_vertices) {
4017     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4018   }
4019   if (n_constraints) {
4020     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4021   }
4022   /* Checking coarse_sub_mat and coarse basis functios */
4023   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4024   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4025   if (pcbddc->dbg_flag) {
4026     Mat         coarse_sub_mat;
4027     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4028     Mat         coarse_phi_D,coarse_phi_B;
4029     Mat         coarse_psi_D,coarse_psi_B;
4030     Mat         A_II,A_BB,A_IB,A_BI;
4031     Mat         C_B,CPHI;
4032     IS          is_dummy;
4033     Vec         mones;
4034     MatType     checkmattype=MATSEQAIJ;
4035     PetscReal   real_value;
4036 
4037     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4038       Mat A;
4039       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4040       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4041       ierr = MatGetSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4042       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4043       ierr = MatGetSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4044       ierr = MatDestroy(&A);CHKERRQ(ierr);
4045     } else {
4046       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4047       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4048       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4049       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4050     }
4051     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4052     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4053     if (!pcbddc->symmetric_primal) {
4054       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4055       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4056     }
4057     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4058 
4059     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4060     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4061     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4062     if (!pcbddc->symmetric_primal) {
4063       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4064       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4065       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4066       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4067       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4068       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4069       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4070       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4071       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4072       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4073       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4074       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4075     } else {
4076       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4077       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4078       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4079       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4080       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4081       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4082       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4083       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4084     }
4085     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4086     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4087     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4088     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4089     if (pcbddc->benign_n) {
4090       Mat         B0_B,B0_BPHI;
4091       PetscScalar *data,*data2;
4092       PetscInt    j;
4093 
4094       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4095       ierr = MatGetSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4096       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4097       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4098       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4099       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4100       for (j=0;j<pcbddc->benign_n;j++) {
4101         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4102         for (i=0;i<pcbddc->local_primal_size;i++) {
4103           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4104           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4105         }
4106       }
4107       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4108       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4109       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4110       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4111       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4112     }
4113 #if 0
4114   {
4115     PetscViewer viewer;
4116     char filename[256];
4117     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4118     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4119     ierr = PetscViewerSetFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4120     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4121     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4122     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4123     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4124     if (save_change) {
4125       Mat phi_B;
4126       ierr = MatMatMult(save_change,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&phi_B);CHKERRQ(ierr);
4127       ierr = PetscObjectSetName((PetscObject)phi_B,"phi_B");CHKERRQ(ierr);
4128       ierr = MatView(phi_B,viewer);CHKERRQ(ierr);
4129       ierr = MatDestroy(&phi_B);CHKERRQ(ierr);
4130     } else {
4131       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4132       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4133     }
4134     if (pcbddc->coarse_phi_D) {
4135       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4136       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4137     }
4138     if (pcbddc->coarse_psi_B) {
4139       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4140       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4141     }
4142     if (pcbddc->coarse_psi_D) {
4143       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4144       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4145     }
4146     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4147   }
4148 #endif
4149     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4150     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4151     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4152     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4153 
4154     /* check constraints */
4155     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4156     ierr = MatGetSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4157     if (!pcbddc->benign_n) { /* TODO: add benign case */
4158       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4159     } else {
4160       PetscScalar *data;
4161       Mat         tmat;
4162       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4163       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4164       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4165       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4166       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4167     }
4168     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4169     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4170     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4171     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4172     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4173     if (!pcbddc->symmetric_primal) {
4174       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4175       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4176       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4177       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4178       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4179     }
4180     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4181     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4182     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4183     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4184     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4185     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4186     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4187     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4188     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4189     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4190     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4191     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4192     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4193     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4194     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4195     if (!pcbddc->symmetric_primal) {
4196       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4197       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4198     }
4199     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4200   }
4201   /* get back data */
4202   *coarse_submat_vals_n = coarse_submat_vals;
4203   PetscFunctionReturn(0);
4204 }
4205 
4206 #undef __FUNCT__
4207 #define __FUNCT__ "MatGetSubMatrixUnsorted"
4208 PetscErrorCode MatGetSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4209 {
4210   Mat            *work_mat;
4211   IS             isrow_s,iscol_s;
4212   PetscBool      rsorted,csorted;
4213   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4214   PetscErrorCode ierr;
4215 
4216   PetscFunctionBegin;
4217   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4218   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4219   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4220   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4221 
4222   if (!rsorted) {
4223     const PetscInt *idxs;
4224     PetscInt *idxs_sorted,i;
4225 
4226     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4227     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4228     for (i=0;i<rsize;i++) {
4229       idxs_perm_r[i] = i;
4230     }
4231     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4232     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4233     for (i=0;i<rsize;i++) {
4234       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4235     }
4236     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4237     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4238   } else {
4239     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4240     isrow_s = isrow;
4241   }
4242 
4243   if (!csorted) {
4244     if (isrow == iscol) {
4245       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4246       iscol_s = isrow_s;
4247     } else {
4248       const PetscInt *idxs;
4249       PetscInt       *idxs_sorted,i;
4250 
4251       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4252       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4253       for (i=0;i<csize;i++) {
4254         idxs_perm_c[i] = i;
4255       }
4256       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4257       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4258       for (i=0;i<csize;i++) {
4259         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4260       }
4261       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4262       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4263     }
4264   } else {
4265     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4266     iscol_s = iscol;
4267   }
4268 
4269   ierr = MatGetSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4270 
4271   if (!rsorted || !csorted) {
4272     Mat      new_mat;
4273     IS       is_perm_r,is_perm_c;
4274 
4275     if (!rsorted) {
4276       PetscInt *idxs_r,i;
4277       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4278       for (i=0;i<rsize;i++) {
4279         idxs_r[idxs_perm_r[i]] = i;
4280       }
4281       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4282       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4283     } else {
4284       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4285     }
4286     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4287 
4288     if (!csorted) {
4289       if (isrow_s == iscol_s) {
4290         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4291         is_perm_c = is_perm_r;
4292       } else {
4293         PetscInt *idxs_c,i;
4294         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4295         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4296         for (i=0;i<csize;i++) {
4297           idxs_c[idxs_perm_c[i]] = i;
4298         }
4299         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4300         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4301       }
4302     } else {
4303       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4304     }
4305     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4306 
4307     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4308     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4309     work_mat[0] = new_mat;
4310     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4311     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4312   }
4313 
4314   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4315   *B = work_mat[0];
4316   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4317   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4318   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4319   PetscFunctionReturn(0);
4320 }
4321 
4322 #undef __FUNCT__
4323 #define __FUNCT__ "PCBDDCComputeLocalMatrix"
4324 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4325 {
4326   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4327   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4328   Mat            new_mat;
4329   IS             is_local,is_global;
4330   PetscInt       local_size;
4331   PetscBool      isseqaij;
4332   PetscErrorCode ierr;
4333 
4334   PetscFunctionBegin;
4335   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4336   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4337   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4338   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4339   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4340   ierr = MatGetSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4341   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4342 
4343   /* check */
4344   if (pcbddc->dbg_flag) {
4345     Vec       x,x_change;
4346     PetscReal error;
4347 
4348     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4349     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4350     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4351     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4352     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4353     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4354     if (!pcbddc->change_interior) {
4355       const PetscScalar *x,*y,*v;
4356       PetscReal         lerror = 0.;
4357       PetscInt          i;
4358 
4359       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4360       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4361       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4362       for (i=0;i<local_size;i++)
4363         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4364           lerror = PetscAbsScalar(x[i]-y[i]);
4365       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4366       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4367       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4368       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4369       if (error > PETSC_SMALL) {
4370         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4371           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4372         } else {
4373           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4374         }
4375       }
4376     }
4377     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4378     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4379     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4380     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4381     if (error > PETSC_SMALL) {
4382       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4383         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4384       } else {
4385         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4386       }
4387     }
4388     ierr = VecDestroy(&x);CHKERRQ(ierr);
4389     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4390   }
4391 
4392   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4393   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4394   if (isseqaij) {
4395     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4396     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4397   } else {
4398     Mat work_mat;
4399 
4400     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4401     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4402     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4403     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4404   }
4405   if (matis->A->symmetric_set) {
4406     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4407 #if !defined(PETSC_USE_COMPLEX)
4408     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4409 #endif
4410   }
4411   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4412   PetscFunctionReturn(0);
4413 }
4414 
4415 #undef __FUNCT__
4416 #define __FUNCT__ "PCBDDCSetUpLocalScatters"
4417 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4418 {
4419   PC_IS*          pcis = (PC_IS*)(pc->data);
4420   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4421   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4422   PetscInt        *idx_R_local=NULL;
4423   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4424   PetscInt        vbs,bs;
4425   PetscBT         bitmask=NULL;
4426   PetscErrorCode  ierr;
4427 
4428   PetscFunctionBegin;
4429   /*
4430     No need to setup local scatters if
4431       - primal space is unchanged
4432         AND
4433       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4434         AND
4435       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4436   */
4437   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4438     PetscFunctionReturn(0);
4439   }
4440   /* destroy old objects */
4441   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4442   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4443   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4444   /* Set Non-overlapping dimensions */
4445   n_B = pcis->n_B;
4446   n_D = pcis->n - n_B;
4447   n_vertices = pcbddc->n_vertices;
4448 
4449   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4450 
4451   /* create auxiliary bitmask and allocate workspace */
4452   if (!sub_schurs || !sub_schurs->reuse_solver) {
4453     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4454     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
4455     for (i=0;i<n_vertices;i++) {
4456       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
4457     }
4458 
4459     for (i=0, n_R=0; i<pcis->n; i++) {
4460       if (!PetscBTLookup(bitmask,i)) {
4461         idx_R_local[n_R++] = i;
4462       }
4463     }
4464   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
4465     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4466 
4467     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4468     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
4469   }
4470 
4471   /* Block code */
4472   vbs = 1;
4473   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
4474   if (bs>1 && !(n_vertices%bs)) {
4475     PetscBool is_blocked = PETSC_TRUE;
4476     PetscInt  *vary;
4477     if (!sub_schurs || !sub_schurs->reuse_solver) {
4478       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
4479       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
4480       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
4481       /* 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 */
4482       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
4483       for (i=0; i<pcis->n/bs; i++) {
4484         if (vary[i]!=0 && vary[i]!=bs) {
4485           is_blocked = PETSC_FALSE;
4486           break;
4487         }
4488       }
4489       ierr = PetscFree(vary);CHKERRQ(ierr);
4490     } else {
4491       /* Verify directly the R set */
4492       for (i=0; i<n_R/bs; i++) {
4493         PetscInt j,node=idx_R_local[bs*i];
4494         for (j=1; j<bs; j++) {
4495           if (node != idx_R_local[bs*i+j]-j) {
4496             is_blocked = PETSC_FALSE;
4497             break;
4498           }
4499         }
4500       }
4501     }
4502     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
4503       vbs = bs;
4504       for (i=0;i<n_R/vbs;i++) {
4505         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
4506       }
4507     }
4508   }
4509   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
4510   if (sub_schurs && sub_schurs->reuse_solver) {
4511     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4512 
4513     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4514     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
4515     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
4516     reuse_solver->is_R = pcbddc->is_R_local;
4517   } else {
4518     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
4519   }
4520 
4521   /* print some info if requested */
4522   if (pcbddc->dbg_flag) {
4523     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4524     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4525     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4526     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
4527     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
4528     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);
4529     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4530   }
4531 
4532   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
4533   if (!sub_schurs || !sub_schurs->reuse_solver) {
4534     IS       is_aux1,is_aux2;
4535     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
4536 
4537     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4538     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
4539     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
4540     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4541     for (i=0; i<n_D; i++) {
4542       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
4543     }
4544     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4545     for (i=0, j=0; i<n_R; i++) {
4546       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
4547         aux_array1[j++] = i;
4548       }
4549     }
4550     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4551     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4552     for (i=0, j=0; i<n_B; i++) {
4553       if (!PetscBTLookup(bitmask,is_indices[i])) {
4554         aux_array2[j++] = i;
4555       }
4556     }
4557     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
4558     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
4559     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
4560     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4561     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
4562 
4563     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4564       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
4565       for (i=0, j=0; i<n_R; i++) {
4566         if (PetscBTLookup(bitmask,idx_R_local[i])) {
4567           aux_array1[j++] = i;
4568         }
4569       }
4570       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
4571       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4572       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
4573     }
4574     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
4575     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
4576   } else {
4577     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4578     IS                 tis;
4579     PetscInt           schur_size;
4580 
4581     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
4582     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
4583     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
4584     ierr = ISDestroy(&tis);CHKERRQ(ierr);
4585     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4586       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
4587       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
4588       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4589     }
4590   }
4591   PetscFunctionReturn(0);
4592 }
4593 
4594 
4595 #undef __FUNCT__
4596 #define __FUNCT__ "PCBDDCSetUpLocalSolvers"
4597 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
4598 {
4599   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
4600   PC_IS          *pcis = (PC_IS*)pc->data;
4601   PC             pc_temp;
4602   Mat            A_RR;
4603   MatReuse       reuse;
4604   PetscScalar    m_one = -1.0;
4605   PetscReal      value;
4606   PetscInt       n_D,n_R;
4607   PetscBool      check_corr[2],issbaij;
4608   PetscErrorCode ierr;
4609   /* prefixes stuff */
4610   char           dir_prefix[256],neu_prefix[256],str_level[16];
4611   size_t         len;
4612 
4613   PetscFunctionBegin;
4614 
4615   /* compute prefixes */
4616   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
4617   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
4618   if (!pcbddc->current_level) {
4619     ierr = PetscStrcpy(dir_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4620     ierr = PetscStrcpy(neu_prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
4621     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4622     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4623   } else {
4624     ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
4625     sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
4626     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
4627     len -= 15; /* remove "pc_bddc_coarse_" */
4628     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
4629     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
4630     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4631     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
4632     ierr = PetscStrcat(dir_prefix,"pc_bddc_dirichlet_");CHKERRQ(ierr);
4633     ierr = PetscStrcat(neu_prefix,"pc_bddc_neumann_");CHKERRQ(ierr);
4634     ierr = PetscStrcat(dir_prefix,str_level);CHKERRQ(ierr);
4635     ierr = PetscStrcat(neu_prefix,str_level);CHKERRQ(ierr);
4636   }
4637 
4638   /* DIRICHLET PROBLEM */
4639   if (dirichlet) {
4640     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4641     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4642       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
4643       if (pcbddc->dbg_flag) {
4644         Mat    A_IIn;
4645 
4646         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
4647         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
4648         pcis->A_II = A_IIn;
4649       }
4650     }
4651     if (pcbddc->local_mat->symmetric_set) {
4652       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4653     }
4654     /* Matrix for Dirichlet problem is pcis->A_II */
4655     n_D = pcis->n - pcis->n_B;
4656     if (!pcbddc->ksp_D) { /* create object if not yet build */
4657       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
4658       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
4659       /* default */
4660       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
4661       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
4662       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4663       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4664       if (issbaij) {
4665         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4666       } else {
4667         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4668       }
4669       /* Allow user's customization */
4670       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
4671       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4672     }
4673     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
4674     if (sub_schurs && sub_schurs->reuse_solver) {
4675       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4676 
4677       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
4678     }
4679     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4680     if (!n_D) {
4681       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
4682       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4683     }
4684     /* Set Up KSP for Dirichlet problem of BDDC */
4685     ierr = KSPSetUp(pcbddc->ksp_D);CHKERRQ(ierr);
4686     /* set ksp_D into pcis data */
4687     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
4688     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
4689     pcis->ksp_D = pcbddc->ksp_D;
4690   }
4691 
4692   /* NEUMANN PROBLEM */
4693   A_RR = 0;
4694   if (neumann) {
4695     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4696     PetscInt        ibs,mbs;
4697     PetscBool       issbaij;
4698     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
4699     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
4700     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
4701     if (pcbddc->ksp_R) { /* already created ksp */
4702       PetscInt nn_R;
4703       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
4704       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4705       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
4706       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
4707         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
4708         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4709         reuse = MAT_INITIAL_MATRIX;
4710       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
4711         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
4712           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4713           reuse = MAT_INITIAL_MATRIX;
4714         } else { /* safe to reuse the matrix */
4715           reuse = MAT_REUSE_MATRIX;
4716         }
4717       }
4718       /* last check */
4719       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
4720         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4721         reuse = MAT_INITIAL_MATRIX;
4722       }
4723     } else { /* first time, so we need to create the matrix */
4724       reuse = MAT_INITIAL_MATRIX;
4725     }
4726     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
4727     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
4728     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
4729     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4730     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
4731       if (matis->A == pcbddc->local_mat) {
4732         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4733         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4734       } else {
4735         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4736       }
4737     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
4738       if (matis->A == pcbddc->local_mat) {
4739         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4740         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4741       } else {
4742         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
4743       }
4744     }
4745     /* extract A_RR */
4746     if (sub_schurs && sub_schurs->reuse_solver) {
4747       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4748 
4749       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
4750         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4751         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
4752           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
4753         } else {
4754           ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
4755         }
4756       } else {
4757         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4758         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
4759         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
4760       }
4761     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
4762       ierr = MatGetSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
4763     }
4764     if (pcbddc->local_mat->symmetric_set) {
4765       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
4766     }
4767     if (!pcbddc->ksp_R) { /* create object if not present */
4768       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
4769       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
4770       /* default */
4771       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
4772       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
4773       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4774       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
4775       if (issbaij) {
4776         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
4777       } else {
4778         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
4779       }
4780       /* Allow user's customization */
4781       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
4782       ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
4783     }
4784     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
4785     if (!n_R) {
4786       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
4787       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
4788     }
4789     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
4790     /* Reuse solver if it is present */
4791     if (sub_schurs && sub_schurs->reuse_solver) {
4792       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4793 
4794       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
4795     }
4796     /* Set Up KSP for Neumann problem of BDDC */
4797     ierr = KSPSetUp(pcbddc->ksp_R);CHKERRQ(ierr);
4798   }
4799 
4800   if (pcbddc->dbg_flag) {
4801     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4802     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4803     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4804   }
4805 
4806   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
4807   check_corr[0] = check_corr[1] = PETSC_FALSE;
4808   if (pcbddc->NullSpace_corr[0]) {
4809     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
4810   }
4811   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
4812     check_corr[0] = PETSC_TRUE;
4813     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
4814   }
4815   if (neumann && pcbddc->NullSpace_corr[2]) {
4816     check_corr[1] = PETSC_TRUE;
4817     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
4818   }
4819 
4820   /* check Dirichlet and Neumann solvers */
4821   if (pcbddc->dbg_flag) {
4822     if (dirichlet) { /* Dirichlet */
4823       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
4824       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
4825       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
4826       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
4827       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
4828       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);
4829       if (check_corr[0]) {
4830         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
4831       }
4832       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4833     }
4834     if (neumann) { /* Neumann */
4835       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
4836       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4837       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
4838       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
4839       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
4840       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);
4841       if (check_corr[1]) {
4842         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
4843       }
4844       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4845     }
4846   }
4847   /* free Neumann problem's matrix */
4848   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
4849   PetscFunctionReturn(0);
4850 }
4851 
4852 #undef __FUNCT__
4853 #define __FUNCT__ "PCBDDCSolveSubstructureCorrection"
4854 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
4855 {
4856   PetscErrorCode  ierr;
4857   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4858   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4859   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
4860 
4861   PetscFunctionBegin;
4862   if (!reuse_solver) {
4863     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
4864   }
4865   if (!pcbddc->switch_static) {
4866     if (applytranspose && pcbddc->local_auxmat1) {
4867       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4868       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4869     }
4870     if (!reuse_solver) {
4871       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4872       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4873     } else {
4874       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4875 
4876       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4877       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4878     }
4879   } else {
4880     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4881     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4882     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4883     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4884     if (applytranspose && pcbddc->local_auxmat1) {
4885       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
4886       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4887       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4888       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4889     }
4890   }
4891   if (!reuse_solver || pcbddc->switch_static) {
4892     if (applytranspose) {
4893       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4894     } else {
4895       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4896     }
4897   } else {
4898     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4899 
4900     if (applytranspose) {
4901       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4902     } else {
4903       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
4904     }
4905   }
4906   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
4907   if (!pcbddc->switch_static) {
4908     if (!reuse_solver) {
4909       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4910       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4911     } else {
4912       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4913 
4914       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4915       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4916     }
4917     if (!applytranspose && pcbddc->local_auxmat1) {
4918       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4919       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
4920     }
4921   } else {
4922     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4923     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4924     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4925     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4926     if (!applytranspose && pcbddc->local_auxmat1) {
4927       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
4928       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
4929     }
4930     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4931     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4932     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4933     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4934   }
4935   PetscFunctionReturn(0);
4936 }
4937 
4938 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
4939 #undef __FUNCT__
4940 #define __FUNCT__ "PCBDDCApplyInterfacePreconditioner"
4941 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
4942 {
4943   PetscErrorCode ierr;
4944   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
4945   PC_IS*            pcis = (PC_IS*)  (pc->data);
4946   const PetscScalar zero = 0.0;
4947 
4948   PetscFunctionBegin;
4949   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
4950   if (!pcbddc->benign_apply_coarse_only) {
4951     if (applytranspose) {
4952       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
4953       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
4954     } else {
4955       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
4956       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
4957     }
4958   } else {
4959     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
4960   }
4961 
4962   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
4963   if (pcbddc->benign_n) {
4964     PetscScalar *array;
4965     PetscInt    j;
4966 
4967     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
4968     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
4969     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
4970   }
4971 
4972   /* start communications from local primal nodes to rhs of coarse solver */
4973   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
4974   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4975   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4976 
4977   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
4978   if (pcbddc->coarse_ksp) {
4979     Mat          coarse_mat;
4980     Vec          rhs,sol;
4981     MatNullSpace nullsp;
4982     PetscBool    isbddc = PETSC_FALSE;
4983 
4984     if (pcbddc->benign_have_null) {
4985       PC        coarse_pc;
4986 
4987       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
4988       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
4989       /* we need to propagate to coarser levels the need for a possible benign correction */
4990       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
4991         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
4992         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
4993         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
4994       }
4995     }
4996     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
4997     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
4998     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
4999     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5000     if (nullsp) {
5001       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5002     }
5003     if (applytranspose) {
5004       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5005       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5006     } else {
5007       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5008         PC        coarse_pc;
5009 
5010         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5011         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5012         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5013         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5014       } else {
5015         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5016       }
5017     }
5018     /* we don't need the benign correction at coarser levels anymore */
5019     if (pcbddc->benign_have_null && isbddc) {
5020       PC        coarse_pc;
5021       PC_BDDC*  coarsepcbddc;
5022 
5023       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5024       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5025       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5026       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5027     }
5028     if (nullsp) {
5029       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5030     }
5031   }
5032 
5033   /* Local solution on R nodes */
5034   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5035     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5036   }
5037   /* communications from coarse sol to local primal nodes */
5038   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5039   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5040 
5041   /* Sum contributions from the two levels */
5042   if (!pcbddc->benign_apply_coarse_only) {
5043     if (applytranspose) {
5044       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5045       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5046     } else {
5047       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5048       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5049     }
5050     /* store p0 */
5051     if (pcbddc->benign_n) {
5052       PetscScalar *array;
5053       PetscInt    j;
5054 
5055       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5056       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5057       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5058     }
5059   } else { /* expand the coarse solution */
5060     if (applytranspose) {
5061       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5062     } else {
5063       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5064     }
5065   }
5066   PetscFunctionReturn(0);
5067 }
5068 
5069 #undef __FUNCT__
5070 #define __FUNCT__ "PCBDDCScatterCoarseDataBegin"
5071 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5072 {
5073   PetscErrorCode ierr;
5074   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5075   PetscScalar    *array;
5076   Vec            from,to;
5077 
5078   PetscFunctionBegin;
5079   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5080     from = pcbddc->coarse_vec;
5081     to = pcbddc->vec1_P;
5082     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5083       Vec tvec;
5084 
5085       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5086       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5087       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5088       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5089       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5090       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5091     }
5092   } else { /* from local to global -> put data in coarse right hand side */
5093     from = pcbddc->vec1_P;
5094     to = pcbddc->coarse_vec;
5095   }
5096   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5097   PetscFunctionReturn(0);
5098 }
5099 
5100 #undef __FUNCT__
5101 #define __FUNCT__ "PCBDDCScatterCoarseDataEnd"
5102 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5103 {
5104   PetscErrorCode ierr;
5105   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5106   PetscScalar    *array;
5107   Vec            from,to;
5108 
5109   PetscFunctionBegin;
5110   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5111     from = pcbddc->coarse_vec;
5112     to = pcbddc->vec1_P;
5113   } else { /* from local to global -> put data in coarse right hand side */
5114     from = pcbddc->vec1_P;
5115     to = pcbddc->coarse_vec;
5116   }
5117   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5118   if (smode == SCATTER_FORWARD) {
5119     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5120       Vec tvec;
5121 
5122       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5123       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5124       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5125       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5126     }
5127   } else {
5128     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5129      ierr = VecResetArray(from);CHKERRQ(ierr);
5130     }
5131   }
5132   PetscFunctionReturn(0);
5133 }
5134 
5135 /* uncomment for testing purposes */
5136 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5137 #undef __FUNCT__
5138 #define __FUNCT__ "PCBDDCConstraintsSetUp"
5139 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5140 {
5141   PetscErrorCode    ierr;
5142   PC_IS*            pcis = (PC_IS*)(pc->data);
5143   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5144   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5145   /* one and zero */
5146   PetscScalar       one=1.0,zero=0.0;
5147   /* space to store constraints and their local indices */
5148   PetscScalar       *constraints_data;
5149   PetscInt          *constraints_idxs,*constraints_idxs_B;
5150   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5151   PetscInt          *constraints_n;
5152   /* iterators */
5153   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5154   /* BLAS integers */
5155   PetscBLASInt      lwork,lierr;
5156   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5157   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5158   /* reuse */
5159   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5160   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5161   /* change of basis */
5162   PetscBool         qr_needed;
5163   PetscBT           change_basis,qr_needed_idx;
5164   /* auxiliary stuff */
5165   PetscInt          *nnz,*is_indices;
5166   PetscInt          ncc;
5167   /* some quantities */
5168   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5169   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5170 
5171   PetscFunctionBegin;
5172   /* Destroy Mat objects computed previously */
5173   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5174   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5175   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5176   /* save info on constraints from previous setup (if any) */
5177   olocal_primal_size = pcbddc->local_primal_size;
5178   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5179   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5180   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5181   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5182   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5183   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5184 
5185   if (!pcbddc->adaptive_selection) {
5186     IS           ISForVertices,*ISForFaces,*ISForEdges;
5187     MatNullSpace nearnullsp;
5188     const Vec    *nearnullvecs;
5189     Vec          *localnearnullsp;
5190     PetscScalar  *array;
5191     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5192     PetscBool    nnsp_has_cnst;
5193     /* LAPACK working arrays for SVD or POD */
5194     PetscBool    skip_lapack,boolforchange;
5195     PetscScalar  *work;
5196     PetscReal    *singular_vals;
5197 #if defined(PETSC_USE_COMPLEX)
5198     PetscReal    *rwork;
5199 #endif
5200 #if defined(PETSC_MISSING_LAPACK_GESVD)
5201     PetscScalar  *temp_basis,*correlation_mat;
5202 #else
5203     PetscBLASInt dummy_int=1;
5204     PetscScalar  dummy_scalar=1.;
5205 #endif
5206 
5207     /* Get index sets for faces, edges and vertices from graph */
5208     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5209     /* print some info */
5210     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5211       PetscInt nv;
5212 
5213       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5214       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5215       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5216       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5217       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5218       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5219       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5220       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5221       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5222     }
5223 
5224     /* free unneeded index sets */
5225     if (!pcbddc->use_vertices) {
5226       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5227     }
5228     if (!pcbddc->use_edges) {
5229       for (i=0;i<n_ISForEdges;i++) {
5230         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5231       }
5232       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5233       n_ISForEdges = 0;
5234     }
5235     if (!pcbddc->use_faces) {
5236       for (i=0;i<n_ISForFaces;i++) {
5237         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5238       }
5239       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5240       n_ISForFaces = 0;
5241     }
5242 
5243     /* check if near null space is attached to global mat */
5244     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5245     if (nearnullsp) {
5246       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5247       /* remove any stored info */
5248       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5249       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5250       /* store information for BDDC solver reuse */
5251       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5252       pcbddc->onearnullspace = nearnullsp;
5253       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5254       for (i=0;i<nnsp_size;i++) {
5255         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5256       }
5257     } else { /* if near null space is not provided BDDC uses constants by default */
5258       nnsp_size = 0;
5259       nnsp_has_cnst = PETSC_TRUE;
5260     }
5261     /* get max number of constraints on a single cc */
5262     max_constraints = nnsp_size;
5263     if (nnsp_has_cnst) max_constraints++;
5264 
5265     /*
5266          Evaluate maximum storage size needed by the procedure
5267          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5268          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5269          There can be multiple constraints per connected component
5270                                                                                                                                                            */
5271     n_vertices = 0;
5272     if (ISForVertices) {
5273       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5274     }
5275     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5276     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5277 
5278     total_counts = n_ISForFaces+n_ISForEdges;
5279     total_counts *= max_constraints;
5280     total_counts += n_vertices;
5281     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5282 
5283     total_counts = 0;
5284     max_size_of_constraint = 0;
5285     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5286       IS used_is;
5287       if (i<n_ISForEdges) {
5288         used_is = ISForEdges[i];
5289       } else {
5290         used_is = ISForFaces[i-n_ISForEdges];
5291       }
5292       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5293       total_counts += j;
5294       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5295     }
5296     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);
5297 
5298     /* get local part of global near null space vectors */
5299     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5300     for (k=0;k<nnsp_size;k++) {
5301       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5302       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5303       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5304     }
5305 
5306     /* whether or not to skip lapack calls */
5307     skip_lapack = PETSC_TRUE;
5308     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5309 
5310     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5311     if (!skip_lapack) {
5312       PetscScalar temp_work;
5313 
5314 #if defined(PETSC_MISSING_LAPACK_GESVD)
5315       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5316       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5317       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5318       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5319 #if defined(PETSC_USE_COMPLEX)
5320       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5321 #endif
5322       /* now we evaluate the optimal workspace using query with lwork=-1 */
5323       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5324       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5325       lwork = -1;
5326       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5327 #if !defined(PETSC_USE_COMPLEX)
5328       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5329 #else
5330       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5331 #endif
5332       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5333       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5334 #else /* on missing GESVD */
5335       /* SVD */
5336       PetscInt max_n,min_n;
5337       max_n = max_size_of_constraint;
5338       min_n = max_constraints;
5339       if (max_size_of_constraint < max_constraints) {
5340         min_n = max_size_of_constraint;
5341         max_n = max_constraints;
5342       }
5343       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5344 #if defined(PETSC_USE_COMPLEX)
5345       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5346 #endif
5347       /* now we evaluate the optimal workspace using query with lwork=-1 */
5348       lwork = -1;
5349       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5350       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5351       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5352       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5353 #if !defined(PETSC_USE_COMPLEX)
5354       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));
5355 #else
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,rwork,&lierr));
5357 #endif
5358       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5359       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5360 #endif /* on missing GESVD */
5361       /* Allocate optimal workspace */
5362       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5363       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5364     }
5365     /* Now we can loop on constraining sets */
5366     total_counts = 0;
5367     constraints_idxs_ptr[0] = 0;
5368     constraints_data_ptr[0] = 0;
5369     /* vertices */
5370     if (n_vertices) {
5371       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5372       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5373       for (i=0;i<n_vertices;i++) {
5374         constraints_n[total_counts] = 1;
5375         constraints_data[total_counts] = 1.0;
5376         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5377         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5378         total_counts++;
5379       }
5380       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5381       n_vertices = total_counts;
5382     }
5383 
5384     /* edges and faces */
5385     total_counts_cc = total_counts;
5386     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5387       IS        used_is;
5388       PetscBool idxs_copied = PETSC_FALSE;
5389 
5390       if (ncc<n_ISForEdges) {
5391         used_is = ISForEdges[ncc];
5392         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5393       } else {
5394         used_is = ISForFaces[ncc-n_ISForEdges];
5395         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5396       }
5397       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5398 
5399       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5400       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5401       /* change of basis should not be performed on local periodic nodes */
5402       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5403       if (nnsp_has_cnst) {
5404         PetscScalar quad_value;
5405 
5406         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5407         idxs_copied = PETSC_TRUE;
5408 
5409         if (!pcbddc->use_nnsp_true) {
5410           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5411         } else {
5412           quad_value = 1.0;
5413         }
5414         for (j=0;j<size_of_constraint;j++) {
5415           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5416         }
5417         temp_constraints++;
5418         total_counts++;
5419       }
5420       for (k=0;k<nnsp_size;k++) {
5421         PetscReal real_value;
5422         PetscScalar *ptr_to_data;
5423 
5424         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5425         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
5426         for (j=0;j<size_of_constraint;j++) {
5427           ptr_to_data[j] = array[is_indices[j]];
5428         }
5429         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
5430         /* check if array is null on the connected component */
5431         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5432         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
5433         if (real_value > 0.0) { /* keep indices and values */
5434           temp_constraints++;
5435           total_counts++;
5436           if (!idxs_copied) {
5437             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5438             idxs_copied = PETSC_TRUE;
5439           }
5440         }
5441       }
5442       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5443       valid_constraints = temp_constraints;
5444       if (!pcbddc->use_nnsp_true && temp_constraints) {
5445         if (temp_constraints == 1) { /* just normalize the constraint */
5446           PetscScalar norm,*ptr_to_data;
5447 
5448           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5449           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5450           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
5451           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
5452           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
5453         } else { /* perform SVD */
5454           PetscReal   tol = 1.0e-8; /* tolerance for retaining eigenmodes */
5455           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
5456 
5457 #if defined(PETSC_MISSING_LAPACK_GESVD)
5458           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
5459              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
5460              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
5461                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
5462                 from that computed using LAPACKgesvd
5463              -> This is due to a different computation of eigenvectors in LAPACKheev
5464              -> The quality of the POD-computed basis will be the same */
5465           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
5466           /* Store upper triangular part of correlation matrix */
5467           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5468           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5469           for (j=0;j<temp_constraints;j++) {
5470             for (k=0;k<j+1;k++) {
5471               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));
5472             }
5473           }
5474           /* compute eigenvalues and eigenvectors of correlation matrix */
5475           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5476           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
5477 #if !defined(PETSC_USE_COMPLEX)
5478           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
5479 #else
5480           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
5481 #endif
5482           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5483           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
5484           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
5485           j = 0;
5486           while (j < temp_constraints && singular_vals[j] < tol) j++;
5487           total_counts = total_counts-j;
5488           valid_constraints = temp_constraints-j;
5489           /* scale and copy POD basis into used quadrature memory */
5490           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5491           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5492           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
5493           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5494           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
5495           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5496           if (j<temp_constraints) {
5497             PetscInt ii;
5498             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
5499             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5500             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));
5501             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5502             for (k=0;k<temp_constraints-j;k++) {
5503               for (ii=0;ii<size_of_constraint;ii++) {
5504                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
5505               }
5506             }
5507           }
5508 #else  /* on missing GESVD */
5509           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5510           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
5511           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5512           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5513 #if !defined(PETSC_USE_COMPLEX)
5514           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));
5515 #else
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,rwork,&lierr));
5517 #endif
5518           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
5519           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5520           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
5521           k = temp_constraints;
5522           if (k > size_of_constraint) k = size_of_constraint;
5523           j = 0;
5524           while (j < k && singular_vals[k-j-1] < tol) j++;
5525           valid_constraints = k-j;
5526           total_counts = total_counts-temp_constraints+valid_constraints;
5527 #endif /* on missing GESVD */
5528         }
5529       }
5530       /* update pointers information */
5531       if (valid_constraints) {
5532         constraints_n[total_counts_cc] = valid_constraints;
5533         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
5534         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
5535         /* set change_of_basis flag */
5536         if (boolforchange) {
5537           PetscBTSet(change_basis,total_counts_cc);
5538         }
5539         total_counts_cc++;
5540       }
5541     }
5542     /* free workspace */
5543     if (!skip_lapack) {
5544       ierr = PetscFree(work);CHKERRQ(ierr);
5545 #if defined(PETSC_USE_COMPLEX)
5546       ierr = PetscFree(rwork);CHKERRQ(ierr);
5547 #endif
5548       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
5549 #if defined(PETSC_MISSING_LAPACK_GESVD)
5550       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
5551       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
5552 #endif
5553     }
5554     for (k=0;k<nnsp_size;k++) {
5555       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
5556     }
5557     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
5558     /* free index sets of faces, edges and vertices */
5559     for (i=0;i<n_ISForFaces;i++) {
5560       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5561     }
5562     if (n_ISForFaces) {
5563       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5564     }
5565     for (i=0;i<n_ISForEdges;i++) {
5566       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5567     }
5568     if (n_ISForEdges) {
5569       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5570     }
5571     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5572   } else {
5573     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5574 
5575     total_counts = 0;
5576     n_vertices = 0;
5577     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
5578       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
5579     }
5580     max_constraints = 0;
5581     total_counts_cc = 0;
5582     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5583       total_counts += pcbddc->adaptive_constraints_n[i];
5584       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
5585       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
5586     }
5587     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
5588     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
5589     constraints_idxs = pcbddc->adaptive_constraints_idxs;
5590     constraints_data = pcbddc->adaptive_constraints_data;
5591     /* constraints_n differs from pcbddc->adaptive_constraints_n */
5592     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
5593     total_counts_cc = 0;
5594     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
5595       if (pcbddc->adaptive_constraints_n[i]) {
5596         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
5597       }
5598     }
5599 #if 0
5600     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
5601     for (i=0;i<total_counts_cc;i++) {
5602       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
5603       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
5604       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
5605         printf(" %d",constraints_idxs[j]);
5606       }
5607       printf("\n");
5608       printf("number of cc: %d\n",constraints_n[i]);
5609     }
5610     for (i=0;i<n_vertices;i++) {
5611       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
5612     }
5613     for (i=0;i<sub_schurs->n_subs;i++) {
5614       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]);
5615     }
5616 #endif
5617 
5618     max_size_of_constraint = 0;
5619     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]);
5620     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
5621     /* Change of basis */
5622     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
5623     if (pcbddc->use_change_of_basis) {
5624       for (i=0;i<sub_schurs->n_subs;i++) {
5625         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
5626           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
5627         }
5628       }
5629     }
5630   }
5631   pcbddc->local_primal_size = total_counts;
5632   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5633 
5634   /* map constraints_idxs in boundary numbering */
5635   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
5636   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);
5637 
5638   /* Create constraint matrix */
5639   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5640   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
5641   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
5642 
5643   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
5644   /* determine if a QR strategy is needed for change of basis */
5645   qr_needed = PETSC_FALSE;
5646   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
5647   total_primal_vertices=0;
5648   pcbddc->local_primal_size_cc = 0;
5649   for (i=0;i<total_counts_cc;i++) {
5650     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5651     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
5652       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
5653       pcbddc->local_primal_size_cc += 1;
5654     } else if (PetscBTLookup(change_basis,i)) {
5655       for (k=0;k<constraints_n[i];k++) {
5656         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5657       }
5658       pcbddc->local_primal_size_cc += constraints_n[i];
5659       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
5660         PetscBTSet(qr_needed_idx,i);
5661         qr_needed = PETSC_TRUE;
5662       }
5663     } else {
5664       pcbddc->local_primal_size_cc += 1;
5665     }
5666   }
5667   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
5668   pcbddc->n_vertices = total_primal_vertices;
5669   /* permute indices in order to have a sorted set of vertices */
5670   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5671   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);
5672   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5673   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
5674 
5675   /* nonzero structure of constraint matrix */
5676   /* and get reference dof for local constraints */
5677   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
5678   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
5679 
5680   j = total_primal_vertices;
5681   total_counts = total_primal_vertices;
5682   cum = total_primal_vertices;
5683   for (i=n_vertices;i<total_counts_cc;i++) {
5684     if (!PetscBTLookup(change_basis,i)) {
5685       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
5686       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
5687       cum++;
5688       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5689       for (k=0;k<constraints_n[i];k++) {
5690         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
5691         nnz[j+k] = size_of_constraint;
5692       }
5693       j += constraints_n[i];
5694     }
5695   }
5696   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
5697   ierr = PetscFree(nnz);CHKERRQ(ierr);
5698 
5699   /* set values in constraint matrix */
5700   for (i=0;i<total_primal_vertices;i++) {
5701     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
5702   }
5703   total_counts = total_primal_vertices;
5704   for (i=n_vertices;i<total_counts_cc;i++) {
5705     if (!PetscBTLookup(change_basis,i)) {
5706       PetscInt *cols;
5707 
5708       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5709       cols = constraints_idxs+constraints_idxs_ptr[i];
5710       for (k=0;k<constraints_n[i];k++) {
5711         PetscInt    row = total_counts+k;
5712         PetscScalar *vals;
5713 
5714         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
5715         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
5716       }
5717       total_counts += constraints_n[i];
5718     }
5719   }
5720   /* assembling */
5721   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5722   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
5723 
5724   /*
5725   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
5726   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
5727   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
5728   */
5729   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
5730   if (pcbddc->use_change_of_basis) {
5731     /* dual and primal dofs on a single cc */
5732     PetscInt     dual_dofs,primal_dofs;
5733     /* working stuff for GEQRF */
5734     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
5735     PetscBLASInt lqr_work;
5736     /* working stuff for UNGQR */
5737     PetscScalar  *gqr_work,lgqr_work_t;
5738     PetscBLASInt lgqr_work;
5739     /* working stuff for TRTRS */
5740     PetscScalar  *trs_rhs;
5741     PetscBLASInt Blas_NRHS;
5742     /* pointers for values insertion into change of basis matrix */
5743     PetscInt     *start_rows,*start_cols;
5744     PetscScalar  *start_vals;
5745     /* working stuff for values insertion */
5746     PetscBT      is_primal;
5747     PetscInt     *aux_primal_numbering_B;
5748     /* matrix sizes */
5749     PetscInt     global_size,local_size;
5750     /* temporary change of basis */
5751     Mat          localChangeOfBasisMatrix;
5752     /* extra space for debugging */
5753     PetscScalar  *dbg_work;
5754 
5755     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
5756     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
5757     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
5758     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
5759     /* nonzeros for local mat */
5760     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
5761     if (!pcbddc->benign_change || pcbddc->fake_change) {
5762       for (i=0;i<pcis->n;i++) nnz[i]=1;
5763     } else {
5764       const PetscInt *ii;
5765       PetscInt       n;
5766       PetscBool      flg_row;
5767       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5768       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
5769       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
5770     }
5771     for (i=n_vertices;i<total_counts_cc;i++) {
5772       if (PetscBTLookup(change_basis,i)) {
5773         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
5774         if (PetscBTLookup(qr_needed_idx,i)) {
5775           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
5776         } else {
5777           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
5778           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
5779         }
5780       }
5781     }
5782     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
5783     ierr = PetscFree(nnz);CHKERRQ(ierr);
5784     /* Set interior change in the matrix */
5785     if (!pcbddc->benign_change || pcbddc->fake_change) {
5786       for (i=0;i<pcis->n;i++) {
5787         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
5788       }
5789     } else {
5790       const PetscInt *ii,*jj;
5791       PetscScalar    *aa;
5792       PetscInt       n;
5793       PetscBool      flg_row;
5794       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5795       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5796       for (i=0;i<n;i++) {
5797         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
5798       }
5799       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
5800       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
5801     }
5802 
5803     if (pcbddc->dbg_flag) {
5804       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5805       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
5806     }
5807 
5808 
5809     /* Now we loop on the constraints which need a change of basis */
5810     /*
5811        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
5812        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
5813 
5814        Basic blocks of change of basis matrix T computed by
5815 
5816           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
5817 
5818             | 1        0   ...        0         s_1/S |
5819             | 0        1   ...        0         s_2/S |
5820             |              ...                        |
5821             | 0        ...            1     s_{n-1}/S |
5822             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
5823 
5824             with S = \sum_{i=1}^n s_i^2
5825             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
5826                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
5827 
5828           - QR decomposition of constraints otherwise
5829     */
5830     if (qr_needed) {
5831       /* space to store Q */
5832       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
5833       /* array to store scaling factors for reflectors */
5834       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
5835       /* first we issue queries for optimal work */
5836       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5837       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5838       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5839       lqr_work = -1;
5840       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
5841       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
5842       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
5843       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
5844       lgqr_work = -1;
5845       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
5846       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
5847       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
5848       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5849       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
5850       PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
5851       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to UNGQR Lapack routine %d",(int)lierr);
5852       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
5853       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
5854       /* array to store rhs and solution of triangular solver */
5855       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
5856       /* allocating workspace for check */
5857       if (pcbddc->dbg_flag) {
5858         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
5859       }
5860     }
5861     /* array to store whether a node is primal or not */
5862     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
5863     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
5864     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
5865     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);
5866     for (i=0;i<total_primal_vertices;i++) {
5867       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
5868     }
5869     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
5870 
5871     /* loop on constraints and see whether or not they need a change of basis and compute it */
5872     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
5873       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
5874       if (PetscBTLookup(change_basis,total_counts)) {
5875         /* get constraint info */
5876         primal_dofs = constraints_n[total_counts];
5877         dual_dofs = size_of_constraint-primal_dofs;
5878 
5879         if (pcbddc->dbg_flag) {
5880           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);
5881         }
5882 
5883         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
5884 
5885           /* copy quadrature constraints for change of basis check */
5886           if (pcbddc->dbg_flag) {
5887             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5888           }
5889           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
5890           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5891 
5892           /* compute QR decomposition of constraints */
5893           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5894           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5895           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5896           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5897           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
5898           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
5899           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5900 
5901           /* explictly compute R^-T */
5902           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
5903           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
5904           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5905           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
5906           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5907           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5908           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5909           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
5910           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
5911           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5912 
5913           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
5914           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5915           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5916           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5917           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5918           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5919           PetscStackCallBLAS("LAPACKungqr",LAPACKungqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
5920           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in UNGQR Lapack routine %d",(int)lierr);
5921           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5922 
5923           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
5924              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
5925              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
5926           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
5927           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
5928           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
5929           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5930           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
5931           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
5932           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5933           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));
5934           ierr = PetscFPTrapPop();CHKERRQ(ierr);
5935           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
5936 
5937           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
5938           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
5939           /* insert cols for primal dofs */
5940           for (j=0;j<primal_dofs;j++) {
5941             start_vals = &qr_basis[j*size_of_constraint];
5942             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
5943             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
5944           }
5945           /* insert cols for dual dofs */
5946           for (j=0,k=0;j<dual_dofs;k++) {
5947             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
5948               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
5949               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
5950               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
5951               j++;
5952             }
5953           }
5954 
5955           /* check change of basis */
5956           if (pcbddc->dbg_flag) {
5957             PetscInt   ii,jj;
5958             PetscBool valid_qr=PETSC_TRUE;
5959             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
5960             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5961             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
5962             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
5963             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
5964             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
5965             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5966             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));
5967             ierr = PetscFPTrapPop();CHKERRQ(ierr);
5968             for (jj=0;jj<size_of_constraint;jj++) {
5969               for (ii=0;ii<primal_dofs;ii++) {
5970                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
5971                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) valid_qr = PETSC_FALSE;
5972               }
5973             }
5974             if (!valid_qr) {
5975               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
5976               for (jj=0;jj<size_of_constraint;jj++) {
5977                 for (ii=0;ii<primal_dofs;ii++) {
5978                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
5979                     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]));
5980                   }
5981                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-1.0) > 1.e-12) {
5982                     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]));
5983                   }
5984                 }
5985               }
5986             } else {
5987               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
5988             }
5989           }
5990         } else { /* simple transformation block */
5991           PetscInt    row,col;
5992           PetscScalar val,norm;
5993 
5994           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
5995           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
5996           for (j=0;j<size_of_constraint;j++) {
5997             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
5998             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
5999             if (!PetscBTLookup(is_primal,row_B)) {
6000               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6001               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6002               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6003             } else {
6004               for (k=0;k<size_of_constraint;k++) {
6005                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6006                 if (row != col) {
6007                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6008                 } else {
6009                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6010                 }
6011                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6012               }
6013             }
6014           }
6015           if (pcbddc->dbg_flag) {
6016             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6017           }
6018         }
6019       } else {
6020         if (pcbddc->dbg_flag) {
6021           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6022         }
6023       }
6024     }
6025 
6026     /* free workspace */
6027     if (qr_needed) {
6028       if (pcbddc->dbg_flag) {
6029         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6030       }
6031       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6032       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6033       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6034       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6035       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6036     }
6037     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6038     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6039     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6040 
6041     /* assembling of global change of variable */
6042     if (!pcbddc->fake_change) {
6043       Mat      tmat;
6044       PetscInt bs;
6045 
6046       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6047       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6048       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6049       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6050       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6051       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6052       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6053       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6054       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6055       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6056       ierr = MatISGetMPIXAIJ(tmat,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6057       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6058       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6059       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6060       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6061       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6062       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6063       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6064 
6065       /* check */
6066       if (pcbddc->dbg_flag) {
6067         PetscReal error;
6068         Vec       x,x_change;
6069 
6070         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6071         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6072         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6073         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6074         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6075         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6076         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6077         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6078         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6079         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6080         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6081         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6082         if (error > PETSC_SMALL) {
6083           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6084         }
6085         ierr = VecDestroy(&x);CHKERRQ(ierr);
6086         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6087       }
6088       /* adapt sub_schurs computed (if any) */
6089       if (pcbddc->use_deluxe_scaling) {
6090         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6091 
6092         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);
6093         if (sub_schurs && sub_schurs->S_Ej_all) {
6094           Mat                    S_new,tmat;
6095           IS                     is_all_N,is_V_Sall = NULL;
6096 
6097           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6098           ierr = MatGetSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6099           if (pcbddc->deluxe_zerorows) {
6100             ISLocalToGlobalMapping NtoSall;
6101             IS                     is_V;
6102             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6103             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6104             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6105             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6106             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6107           }
6108           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6109           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6110           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6111           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6112           if (pcbddc->deluxe_zerorows) {
6113             const PetscScalar *array;
6114             const PetscInt    *idxs_V,*idxs_all;
6115             PetscInt          i,n_V;
6116 
6117             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6118             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6119             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6120             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6121             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6122             for (i=0;i<n_V;i++) {
6123               PetscScalar val;
6124               PetscInt    idx;
6125 
6126               idx = idxs_V[i];
6127               val = array[idxs_all[idxs_V[i]]];
6128               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6129             }
6130             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6131             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6132             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6133             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6134             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6135           }
6136           sub_schurs->S_Ej_all = S_new;
6137           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6138           if (sub_schurs->sum_S_Ej_all) {
6139             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6140             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6141             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6142             if (pcbddc->deluxe_zerorows) {
6143               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6144             }
6145             sub_schurs->sum_S_Ej_all = S_new;
6146             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6147           }
6148           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6149           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6150         }
6151         /* destroy any change of basis context in sub_schurs */
6152         if (sub_schurs && sub_schurs->change) {
6153           PetscInt i;
6154 
6155           for (i=0;i<sub_schurs->n_subs;i++) {
6156             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6157           }
6158           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6159         }
6160       }
6161       if (pcbddc->switch_static) { /* need to save the local change */
6162         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6163       } else {
6164         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6165       }
6166       /* determine if any process has changed the pressures locally */
6167       pcbddc->change_interior = pcbddc->benign_have_null;
6168     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6169       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6170       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6171       pcbddc->use_qr_single = qr_needed;
6172     }
6173   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6174     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6175       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6176       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6177     } else {
6178       Mat benign_global = NULL;
6179       if (pcbddc->benign_have_null) {
6180         Mat tmat;
6181 
6182         pcbddc->change_interior = PETSC_TRUE;
6183         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6184         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6185         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6186         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6187         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6188         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6189         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6190         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6191         if (pcbddc->benign_change) {
6192           Mat M;
6193 
6194           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6195           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6196           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6197           ierr = MatDestroy(&M);CHKERRQ(ierr);
6198         } else {
6199           Mat         eye;
6200           PetscScalar *array;
6201 
6202           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6203           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6204           for (i=0;i<pcis->n;i++) {
6205             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6206           }
6207           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6208           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6209           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6210           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6211           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6212         }
6213         ierr = MatISGetMPIXAIJ(tmat,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6214         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6215       }
6216       if (pcbddc->user_ChangeOfBasisMatrix) {
6217         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6218         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6219       } else if (pcbddc->benign_have_null) {
6220         pcbddc->ChangeOfBasisMatrix = benign_global;
6221       }
6222     }
6223     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6224       IS             is_global;
6225       const PetscInt *gidxs;
6226 
6227       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6228       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6229       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6230       ierr = MatGetSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6231       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6232     }
6233   }
6234   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6235     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6236   }
6237 
6238   if (!pcbddc->fake_change) {
6239     /* add pressure dofs to set of primal nodes for numbering purposes */
6240     for (i=0;i<pcbddc->benign_n;i++) {
6241       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6242       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6243       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6244       pcbddc->local_primal_size_cc++;
6245       pcbddc->local_primal_size++;
6246     }
6247 
6248     /* check if a new primal space has been introduced (also take into account benign trick) */
6249     pcbddc->new_primal_space_local = PETSC_TRUE;
6250     if (olocal_primal_size == pcbddc->local_primal_size) {
6251       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6252       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6253       if (!pcbddc->new_primal_space_local) {
6254         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6255         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6256       }
6257     }
6258     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6259     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6260   }
6261   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6262 
6263   /* flush dbg viewer */
6264   if (pcbddc->dbg_flag) {
6265     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6266   }
6267 
6268   /* free workspace */
6269   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6270   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6271   if (!pcbddc->adaptive_selection) {
6272     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6273     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6274   } else {
6275     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6276                       pcbddc->adaptive_constraints_idxs_ptr,
6277                       pcbddc->adaptive_constraints_data_ptr,
6278                       pcbddc->adaptive_constraints_idxs,
6279                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6280     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6281     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6282   }
6283   PetscFunctionReturn(0);
6284 }
6285 
6286 #undef __FUNCT__
6287 #define __FUNCT__ "PCBDDCAnalyzeInterface"
6288 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6289 {
6290   ISLocalToGlobalMapping map;
6291   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6292   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6293   PetscInt               ierr,i,N;
6294 
6295   PetscFunctionBegin;
6296   if (pcbddc->recompute_topography) {
6297     pcbddc->graphanalyzed = PETSC_FALSE;
6298     /* Reset previously computed graph */
6299     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6300     /* Init local Graph struct */
6301     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6302     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6303     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6304 
6305     /* Check validity of the csr graph passed in by the user */
6306     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);
6307 
6308     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6309     if ( (!pcbddc->mat_graph->xadj || !pcbddc->mat_graph->adjncy) && pcbddc->use_local_adj) {
6310       PetscInt  *xadj,*adjncy;
6311       PetscInt  nvtxs;
6312       PetscBool flg_row=PETSC_FALSE;
6313 
6314       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6315       if (flg_row) {
6316         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6317         pcbddc->computed_rowadj = PETSC_TRUE;
6318       }
6319       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6320     }
6321     if (pcbddc->dbg_flag) {
6322       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6323     }
6324 
6325     /* Setup of Graph */
6326     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6327     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6328 
6329     /* attach info on disconnected subdomains if present */
6330     if (pcbddc->n_local_subs) {
6331       PetscInt *local_subs;
6332 
6333       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6334       for (i=0;i<pcbddc->n_local_subs;i++) {
6335         const PetscInt *idxs;
6336         PetscInt       nl,j;
6337 
6338         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6339         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6340         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6341         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6342       }
6343       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6344       pcbddc->mat_graph->local_subs = local_subs;
6345     }
6346   }
6347 
6348   if (!pcbddc->graphanalyzed) {
6349     /* Graph's connected components analysis */
6350     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6351     pcbddc->graphanalyzed = PETSC_TRUE;
6352   }
6353   PetscFunctionReturn(0);
6354 }
6355 
6356 #undef __FUNCT__
6357 #define __FUNCT__ "PCBDDCOrthonormalizeVecs"
6358 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6359 {
6360   PetscInt       i,j;
6361   PetscScalar    *alphas;
6362   PetscErrorCode ierr;
6363 
6364   PetscFunctionBegin;
6365   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6366   for (i=0;i<n;i++) {
6367     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6368     ierr = VecMDot(vecs[i],n-i-1,&vecs[i+1],alphas);CHKERRQ(ierr);
6369     for (j=0;j<n-i-1;j++) alphas[j] = PetscConj(-alphas[j]);
6370     ierr = VecMAXPY(vecs[j],n-i-1,alphas,vecs+i);CHKERRQ(ierr);
6371   }
6372   ierr = PetscFree(alphas);CHKERRQ(ierr);
6373   PetscFunctionReturn(0);
6374 }
6375 
6376 #undef __FUNCT__
6377 #define __FUNCT__ "PCBDDCMatISGetSubassemblingPattern"
6378 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6379 {
6380   Mat            A;
6381   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6382   PetscMPIInt    size,rank,color;
6383   PetscInt       *xadj,*adjncy;
6384   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6385   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6386   PetscInt       void_procs,*procs_candidates = NULL;
6387   PetscInt       xadj_count,*count;
6388   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6389   PetscSubcomm   psubcomm;
6390   MPI_Comm       subcomm;
6391   PetscErrorCode ierr;
6392 
6393   PetscFunctionBegin;
6394   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6395   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6396   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6397   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
6398   PetscValidLogicalCollectiveInt(mat,redprocs,3);
6399   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
6400 
6401   if (have_void) *have_void = PETSC_FALSE;
6402   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
6403   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
6404   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
6405   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
6406   im_active = !!n;
6407   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6408   void_procs = size - active_procs;
6409   /* get ranks of of non-active processes in mat communicator */
6410   if (void_procs) {
6411     PetscInt ncand;
6412 
6413     if (have_void) *have_void = PETSC_TRUE;
6414     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
6415     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
6416     for (i=0,ncand=0;i<size;i++) {
6417       if (!procs_candidates[i]) {
6418         procs_candidates[ncand++] = i;
6419       }
6420     }
6421     /* force n_subdomains to be not greater that the number of non-active processes */
6422     *n_subdomains = PetscMin(void_procs,*n_subdomains);
6423   }
6424 
6425   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
6426      number of subdomains requested 1 -> send to master or first candidate in voids  */
6427   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
6428   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
6429     PetscInt issize,isidx,dest;
6430     if (*n_subdomains == 1) dest = 0;
6431     else dest = rank;
6432     if (im_active) {
6433       issize = 1;
6434       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6435         isidx = procs_candidates[dest];
6436       } else {
6437         isidx = dest;
6438       }
6439     } else {
6440       issize = 0;
6441       isidx = -1;
6442     }
6443     if (*n_subdomains != 1) *n_subdomains = active_procs;
6444     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
6445     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6446     PetscFunctionReturn(0);
6447   }
6448   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
6449   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
6450   threshold = PetscMax(threshold,2);
6451 
6452   /* Get info on mapping */
6453   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6454 
6455   /* build local CSR graph of subdomains' connectivity */
6456   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
6457   xadj[0] = 0;
6458   xadj[1] = PetscMax(n_neighs-1,0);
6459   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
6460   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
6461   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
6462   for (i=1;i<n_neighs;i++)
6463     for (j=0;j<n_shared[i];j++)
6464       count[shared[i][j]] += 1;
6465 
6466   xadj_count = 0;
6467   for (i=1;i<n_neighs;i++) {
6468     for (j=0;j<n_shared[i];j++) {
6469       if (count[shared[i][j]] < threshold) {
6470         adjncy[xadj_count] = neighs[i];
6471         adjncy_wgt[xadj_count] = n_shared[i];
6472         xadj_count++;
6473         break;
6474       }
6475     }
6476   }
6477   xadj[1] = xadj_count;
6478   ierr = PetscFree(count);CHKERRQ(ierr);
6479   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
6480   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6481 
6482   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
6483 
6484   /* Restrict work on active processes only */
6485   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
6486   if (void_procs) {
6487     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
6488     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
6489     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
6490     subcomm = PetscSubcommChild(psubcomm);
6491   } else {
6492     psubcomm = NULL;
6493     subcomm = PetscObjectComm((PetscObject)mat);
6494   }
6495 
6496   v_wgt = NULL;
6497   if (!color) {
6498     ierr = PetscFree(xadj);CHKERRQ(ierr);
6499     ierr = PetscFree(adjncy);CHKERRQ(ierr);
6500     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6501   } else {
6502     Mat             subdomain_adj;
6503     IS              new_ranks,new_ranks_contig;
6504     MatPartitioning partitioner;
6505     PetscInt        rstart=0,rend=0;
6506     PetscInt        *is_indices,*oldranks;
6507     PetscMPIInt     size;
6508     PetscBool       aggregate;
6509 
6510     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
6511     if (void_procs) {
6512       PetscInt prank = rank;
6513       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
6514       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
6515       for (i=0;i<xadj[1];i++) {
6516         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
6517       }
6518       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
6519     } else {
6520       oldranks = NULL;
6521     }
6522     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
6523     if (aggregate) { /* TODO: all this part could be made more efficient */
6524       PetscInt    lrows,row,ncols,*cols;
6525       PetscMPIInt nrank;
6526       PetscScalar *vals;
6527 
6528       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
6529       lrows = 0;
6530       if (nrank<redprocs) {
6531         lrows = size/redprocs;
6532         if (nrank<size%redprocs) lrows++;
6533       }
6534       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
6535       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
6536       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6537       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
6538       row = nrank;
6539       ncols = xadj[1]-xadj[0];
6540       cols = adjncy;
6541       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
6542       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
6543       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6544       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6545       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6546       ierr = PetscFree(xadj);CHKERRQ(ierr);
6547       ierr = PetscFree(adjncy);CHKERRQ(ierr);
6548       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
6549       ierr = PetscFree(vals);CHKERRQ(ierr);
6550       if (use_vwgt) {
6551         Vec               v;
6552         const PetscScalar *array;
6553         PetscInt          nl;
6554 
6555         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
6556         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
6557         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
6558         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
6559         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
6560         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
6561         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
6562         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
6563         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
6564         ierr = VecDestroy(&v);CHKERRQ(ierr);
6565       }
6566     } else {
6567       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
6568       if (use_vwgt) {
6569         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
6570         v_wgt[0] = n;
6571       }
6572     }
6573     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
6574 
6575     /* Partition */
6576     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
6577     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
6578     if (v_wgt) {
6579       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
6580     }
6581     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
6582     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
6583     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
6584     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
6585     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
6586 
6587     /* renumber new_ranks to avoid "holes" in new set of processors */
6588     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
6589     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
6590     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6591     if (!aggregate) {
6592       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6593 #if defined(PETSC_USE_DEBUG)
6594         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6595 #endif
6596         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
6597       } else if (oldranks) {
6598         ranks_send_to_idx[0] = oldranks[is_indices[0]];
6599       } else {
6600         ranks_send_to_idx[0] = is_indices[0];
6601       }
6602     } else {
6603       PetscInt    idxs[1];
6604       PetscMPIInt tag;
6605       MPI_Request *reqs;
6606 
6607       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
6608       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
6609       for (i=rstart;i<rend;i++) {
6610         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
6611       }
6612       ierr = MPI_Recv(idxs,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
6613       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6614       ierr = PetscFree(reqs);CHKERRQ(ierr);
6615       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
6616 #if defined(PETSC_USE_DEBUG)
6617         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
6618 #endif
6619         ranks_send_to_idx[0] = procs_candidates[oldranks[idxs[0]]];
6620       } else if (oldranks) {
6621         ranks_send_to_idx[0] = oldranks[idxs[0]];
6622       } else {
6623         ranks_send_to_idx[0] = idxs[0];
6624       }
6625     }
6626     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6627     /* clean up */
6628     ierr = PetscFree(oldranks);CHKERRQ(ierr);
6629     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
6630     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
6631     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
6632   }
6633   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
6634   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
6635 
6636   /* assemble parallel IS for sends */
6637   i = 1;
6638   if (!color) i=0;
6639   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
6640   PetscFunctionReturn(0);
6641 }
6642 
6643 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
6644 
6645 #undef __FUNCT__
6646 #define __FUNCT__ "PCBDDCMatISSubassemble"
6647 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[])
6648 {
6649   Mat                    local_mat;
6650   IS                     is_sends_internal;
6651   PetscInt               rows,cols,new_local_rows;
6652   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
6653   PetscBool              ismatis,isdense,newisdense,destroy_mat;
6654   ISLocalToGlobalMapping l2gmap;
6655   PetscInt*              l2gmap_indices;
6656   const PetscInt*        is_indices;
6657   MatType                new_local_type;
6658   /* buffers */
6659   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
6660   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
6661   PetscInt               *recv_buffer_idxs_local;
6662   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
6663   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
6664   /* MPI */
6665   MPI_Comm               comm,comm_n;
6666   PetscSubcomm           subcomm;
6667   PetscMPIInt            n_sends,n_recvs,commsize;
6668   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
6669   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
6670   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
6671   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
6672   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
6673   PetscErrorCode         ierr;
6674 
6675   PetscFunctionBegin;
6676   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
6677   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
6678   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",__FUNCT__);
6679   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
6680   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
6681   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
6682   PetscValidLogicalCollectiveBool(mat,reuse,6);
6683   PetscValidLogicalCollectiveInt(mat,nis,8);
6684   PetscValidLogicalCollectiveInt(mat,nvecs,10);
6685   if (nvecs) {
6686     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
6687     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
6688   }
6689   /* further checks */
6690   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
6691   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
6692   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
6693   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
6694   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
6695   if (reuse && *mat_n) {
6696     PetscInt mrows,mcols,mnrows,mncols;
6697     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
6698     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
6699     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
6700     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
6701     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
6702     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
6703     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
6704   }
6705   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
6706   PetscValidLogicalCollectiveInt(mat,bs,0);
6707 
6708   /* prepare IS for sending if not provided */
6709   if (!is_sends) {
6710     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
6711     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
6712   } else {
6713     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
6714     is_sends_internal = is_sends;
6715   }
6716 
6717   /* get comm */
6718   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
6719 
6720   /* compute number of sends */
6721   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
6722   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
6723 
6724   /* compute number of receives */
6725   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
6726   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
6727   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
6728   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6729   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
6730   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
6731   ierr = PetscFree(iflags);CHKERRQ(ierr);
6732 
6733   /* restrict comm if requested */
6734   subcomm = 0;
6735   destroy_mat = PETSC_FALSE;
6736   if (restrict_comm) {
6737     PetscMPIInt color,subcommsize;
6738 
6739     color = 0;
6740     if (restrict_full) {
6741       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
6742     } else {
6743       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
6744     }
6745     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
6746     subcommsize = commsize - subcommsize;
6747     /* check if reuse has been requested */
6748     if (reuse) {
6749       if (*mat_n) {
6750         PetscMPIInt subcommsize2;
6751         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
6752         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
6753         comm_n = PetscObjectComm((PetscObject)*mat_n);
6754       } else {
6755         comm_n = PETSC_COMM_SELF;
6756       }
6757     } else { /* MAT_INITIAL_MATRIX */
6758       PetscMPIInt rank;
6759 
6760       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
6761       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
6762       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
6763       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
6764       comm_n = PetscSubcommChild(subcomm);
6765     }
6766     /* flag to destroy *mat_n if not significative */
6767     if (color) destroy_mat = PETSC_TRUE;
6768   } else {
6769     comm_n = comm;
6770   }
6771 
6772   /* prepare send/receive buffers */
6773   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
6774   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
6775   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
6776   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
6777   if (nis) {
6778     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
6779   }
6780 
6781   /* Get data from local matrices */
6782   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
6783     /* TODO: See below some guidelines on how to prepare the local buffers */
6784     /*
6785        send_buffer_vals should contain the raw values of the local matrix
6786        send_buffer_idxs should contain:
6787        - MatType_PRIVATE type
6788        - PetscInt        size_of_l2gmap
6789        - PetscInt        global_row_indices[size_of_l2gmap]
6790        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
6791     */
6792   else {
6793     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
6794     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
6795     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
6796     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
6797     send_buffer_idxs[1] = i;
6798     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6799     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
6800     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
6801     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
6802     for (i=0;i<n_sends;i++) {
6803       ilengths_vals[is_indices[i]] = len*len;
6804       ilengths_idxs[is_indices[i]] = len+2;
6805     }
6806   }
6807   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
6808   /* additional is (if any) */
6809   if (nis) {
6810     PetscMPIInt psum;
6811     PetscInt j;
6812     for (j=0,psum=0;j<nis;j++) {
6813       PetscInt plen;
6814       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6815       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
6816       psum += len+1; /* indices + lenght */
6817     }
6818     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
6819     for (j=0,psum=0;j<nis;j++) {
6820       PetscInt plen;
6821       const PetscInt *is_array_idxs;
6822       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
6823       send_buffer_idxs_is[psum] = plen;
6824       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6825       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
6826       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
6827       psum += plen+1; /* indices + lenght */
6828     }
6829     for (i=0;i<n_sends;i++) {
6830       ilengths_idxs_is[is_indices[i]] = psum;
6831     }
6832     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
6833   }
6834 
6835   buf_size_idxs = 0;
6836   buf_size_vals = 0;
6837   buf_size_idxs_is = 0;
6838   buf_size_vecs = 0;
6839   for (i=0;i<n_recvs;i++) {
6840     buf_size_idxs += (PetscInt)olengths_idxs[i];
6841     buf_size_vals += (PetscInt)olengths_vals[i];
6842     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
6843     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
6844   }
6845   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
6846   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
6847   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
6848   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
6849 
6850   /* get new tags for clean communications */
6851   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
6852   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
6853   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
6854   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
6855 
6856   /* allocate for requests */
6857   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
6858   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
6859   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
6860   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
6861   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
6862   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
6863   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
6864   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
6865 
6866   /* communications */
6867   ptr_idxs = recv_buffer_idxs;
6868   ptr_vals = recv_buffer_vals;
6869   ptr_idxs_is = recv_buffer_idxs_is;
6870   ptr_vecs = recv_buffer_vecs;
6871   for (i=0;i<n_recvs;i++) {
6872     source_dest = onodes[i];
6873     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
6874     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
6875     ptr_idxs += olengths_idxs[i];
6876     ptr_vals += olengths_vals[i];
6877     if (nis) {
6878       source_dest = onodes_is[i];
6879       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);
6880       ptr_idxs_is += olengths_idxs_is[i];
6881     }
6882     if (nvecs) {
6883       source_dest = onodes[i];
6884       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
6885       ptr_vecs += olengths_idxs[i]-2;
6886     }
6887   }
6888   for (i=0;i<n_sends;i++) {
6889     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
6890     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
6891     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
6892     if (nis) {
6893       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);
6894     }
6895     if (nvecs) {
6896       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
6897       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
6898     }
6899   }
6900   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
6901   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
6902 
6903   /* assemble new l2g map */
6904   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6905   ptr_idxs = recv_buffer_idxs;
6906   new_local_rows = 0;
6907   for (i=0;i<n_recvs;i++) {
6908     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6909     ptr_idxs += olengths_idxs[i];
6910   }
6911   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
6912   ptr_idxs = recv_buffer_idxs;
6913   new_local_rows = 0;
6914   for (i=0;i<n_recvs;i++) {
6915     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
6916     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
6917     ptr_idxs += olengths_idxs[i];
6918   }
6919   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
6920   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
6921   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
6922 
6923   /* infer new local matrix type from received local matrices type */
6924   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
6925   /* 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) */
6926   if (n_recvs) {
6927     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
6928     ptr_idxs = recv_buffer_idxs;
6929     for (i=0;i<n_recvs;i++) {
6930       if ((PetscInt)new_local_type_private != *ptr_idxs) {
6931         new_local_type_private = MATAIJ_PRIVATE;
6932         break;
6933       }
6934       ptr_idxs += olengths_idxs[i];
6935     }
6936     switch (new_local_type_private) {
6937       case MATDENSE_PRIVATE:
6938         if (n_recvs>1) { /* subassembling of dense matrices does not give a dense matrix! */
6939           new_local_type = MATSEQAIJ;
6940           bs = 1;
6941         } else { /* if I receive only 1 dense matrix */
6942           new_local_type = MATSEQDENSE;
6943           bs = 1;
6944         }
6945         break;
6946       case MATAIJ_PRIVATE:
6947         new_local_type = MATSEQAIJ;
6948         bs = 1;
6949         break;
6950       case MATBAIJ_PRIVATE:
6951         new_local_type = MATSEQBAIJ;
6952         break;
6953       case MATSBAIJ_PRIVATE:
6954         new_local_type = MATSEQSBAIJ;
6955         break;
6956       default:
6957         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,__FUNCT__);
6958         break;
6959     }
6960   } else { /* by default, new_local_type is seqdense */
6961     new_local_type = MATSEQDENSE;
6962     bs = 1;
6963   }
6964 
6965   /* create MATIS object if needed */
6966   if (!reuse) {
6967     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
6968     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
6969   } else {
6970     /* it also destroys the local matrices */
6971     if (*mat_n) {
6972       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
6973     } else { /* this is a fake object */
6974       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
6975     }
6976   }
6977   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
6978   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
6979 
6980   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
6981 
6982   /* Global to local map of received indices */
6983   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
6984   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
6985   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
6986 
6987   /* restore attributes -> type of incoming data and its size */
6988   buf_size_idxs = 0;
6989   for (i=0;i<n_recvs;i++) {
6990     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
6991     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
6992     buf_size_idxs += (PetscInt)olengths_idxs[i];
6993   }
6994   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
6995 
6996   /* set preallocation */
6997   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
6998   if (!newisdense) {
6999     PetscInt *new_local_nnz=0;
7000 
7001     ptr_idxs = recv_buffer_idxs_local;
7002     if (n_recvs) {
7003       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7004     }
7005     for (i=0;i<n_recvs;i++) {
7006       PetscInt j;
7007       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7008         for (j=0;j<*(ptr_idxs+1);j++) {
7009           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7010         }
7011       } else {
7012         /* TODO */
7013       }
7014       ptr_idxs += olengths_idxs[i];
7015     }
7016     if (new_local_nnz) {
7017       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7018       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7019       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7020       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7021       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7022       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7023     } else {
7024       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7025     }
7026     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7027   } else {
7028     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7029   }
7030 
7031   /* set values */
7032   ptr_vals = recv_buffer_vals;
7033   ptr_idxs = recv_buffer_idxs_local;
7034   for (i=0;i<n_recvs;i++) {
7035     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7036       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7037       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7038       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7039       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7040       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7041     } else {
7042       /* TODO */
7043     }
7044     ptr_idxs += olengths_idxs[i];
7045     ptr_vals += olengths_vals[i];
7046   }
7047   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7048   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7049   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7050   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7051   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7052 
7053 #if 0
7054   if (!restrict_comm) { /* check */
7055     Vec       lvec,rvec;
7056     PetscReal infty_error;
7057 
7058     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7059     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7060     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7061     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7062     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7063     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7064     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7065     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7066     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7067   }
7068 #endif
7069 
7070   /* assemble new additional is (if any) */
7071   if (nis) {
7072     PetscInt **temp_idxs,*count_is,j,psum;
7073 
7074     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7075     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7076     ptr_idxs = recv_buffer_idxs_is;
7077     psum = 0;
7078     for (i=0;i<n_recvs;i++) {
7079       for (j=0;j<nis;j++) {
7080         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7081         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7082         psum += plen;
7083         ptr_idxs += plen+1; /* shift pointer to received data */
7084       }
7085     }
7086     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7087     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7088     for (i=1;i<nis;i++) {
7089       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7090     }
7091     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7092     ptr_idxs = recv_buffer_idxs_is;
7093     for (i=0;i<n_recvs;i++) {
7094       for (j=0;j<nis;j++) {
7095         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7096         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7097         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7098         ptr_idxs += plen+1; /* shift pointer to received data */
7099       }
7100     }
7101     for (i=0;i<nis;i++) {
7102       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7103       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7104       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7105     }
7106     ierr = PetscFree(count_is);CHKERRQ(ierr);
7107     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7108     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7109   }
7110   /* free workspace */
7111   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7112   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7113   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7114   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7115   if (isdense) {
7116     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7117     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7118   } else {
7119     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7120   }
7121   if (nis) {
7122     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7123     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7124   }
7125 
7126   if (nvecs) {
7127     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7128     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7129     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7130     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7131     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7132     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7133     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7134     /* set values */
7135     ptr_vals = recv_buffer_vecs;
7136     ptr_idxs = recv_buffer_idxs_local;
7137     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7138     for (i=0;i<n_recvs;i++) {
7139       PetscInt j;
7140       for (j=0;j<*(ptr_idxs+1);j++) {
7141         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7142       }
7143       ptr_idxs += olengths_idxs[i];
7144       ptr_vals += olengths_idxs[i]-2;
7145     }
7146     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7147     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7148     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7149   }
7150 
7151   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7152   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7153   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7154   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7155   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7156   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7157   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7158   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7159   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7160   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7161   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7162   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7163   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7164   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7165   ierr = PetscFree(onodes);CHKERRQ(ierr);
7166   if (nis) {
7167     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7168     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7169     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7170   }
7171   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7172   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7173     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7174     for (i=0;i<nis;i++) {
7175       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7176     }
7177     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7178       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7179     }
7180     *mat_n = NULL;
7181   }
7182   PetscFunctionReturn(0);
7183 }
7184 
7185 /* temporary hack into ksp private data structure */
7186 #include <petsc/private/kspimpl.h>
7187 
7188 #undef __FUNCT__
7189 #define __FUNCT__ "PCBDDCSetUpCoarseSolver"
7190 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7191 {
7192   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7193   PC_IS                  *pcis = (PC_IS*)pc->data;
7194   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7195   Mat                    coarsedivudotp = NULL;
7196   Mat                    coarseG,t_coarse_mat_is;
7197   MatNullSpace           CoarseNullSpace = NULL;
7198   ISLocalToGlobalMapping coarse_islg;
7199   IS                     coarse_is,*isarray;
7200   PetscInt               i,im_active=-1,active_procs=-1;
7201   PetscInt               nis,nisdofs,nisneu,nisvert;
7202   PC                     pc_temp;
7203   PCType                 coarse_pc_type;
7204   KSPType                coarse_ksp_type;
7205   PetscBool              multilevel_requested,multilevel_allowed;
7206   PetscBool              isredundant,isbddc,isnn,coarse_reuse;
7207   PetscInt               ncoarse,nedcfield;
7208   PetscBool              compute_vecs = PETSC_FALSE;
7209   PetscScalar            *array;
7210   MatReuse               coarse_mat_reuse;
7211   PetscBool              restr, full_restr, have_void;
7212   PetscErrorCode         ierr;
7213 
7214   PetscFunctionBegin;
7215   /* Assign global numbering to coarse dofs */
7216   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 */
7217     PetscInt ocoarse_size;
7218     compute_vecs = PETSC_TRUE;
7219     ocoarse_size = pcbddc->coarse_size;
7220     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7221     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7222     /* see if we can avoid some work */
7223     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7224       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7225       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7226         PC        pc;
7227         PetscBool isbddc;
7228 
7229         /* temporary workaround since PCBDDC does not have a reset method so far */
7230         ierr = KSPGetPC(pcbddc->coarse_ksp,&pc);CHKERRQ(ierr);
7231         ierr = PetscObjectTypeCompare((PetscObject)pc,PCBDDC,&isbddc);CHKERRQ(ierr);
7232         if (isbddc) {
7233           ierr = KSPDestroy(&pcbddc->coarse_ksp);CHKERRQ(ierr);
7234         } else {
7235           ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7236         }
7237         coarse_reuse = PETSC_FALSE;
7238       } else { /* we can safely reuse already computed coarse matrix */
7239         coarse_reuse = PETSC_TRUE;
7240       }
7241     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7242       coarse_reuse = PETSC_FALSE;
7243     }
7244     /* reset any subassembling information */
7245     if (!coarse_reuse || pcbddc->recompute_topography) {
7246       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7247     }
7248   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7249     coarse_reuse = PETSC_TRUE;
7250   }
7251   /* assemble coarse matrix */
7252   if (coarse_reuse && pcbddc->coarse_ksp) {
7253     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7254     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7255     coarse_mat_reuse = MAT_REUSE_MATRIX;
7256   } else {
7257     coarse_mat = NULL;
7258     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7259   }
7260 
7261   /* creates temporary l2gmap and IS for coarse indexes */
7262   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7263   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7264 
7265   /* creates temporary MATIS object for coarse matrix */
7266   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7267   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7268   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7269   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7270   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);
7271   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7272   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7273   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7274   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7275 
7276   /* count "active" (i.e. with positive local size) and "void" processes */
7277   im_active = !!(pcis->n);
7278   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7279 
7280   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7281   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7282   /* full_restr : just use the receivers from the subassembling pattern */
7283   coarse_mat_is = NULL;
7284   multilevel_allowed = PETSC_FALSE;
7285   multilevel_requested = PETSC_FALSE;
7286   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7287   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7288   if (multilevel_requested) {
7289     ncoarse = active_procs/pcbddc->coarsening_ratio;
7290     restr = PETSC_FALSE;
7291     full_restr = PETSC_FALSE;
7292   } else {
7293     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7294     restr = PETSC_TRUE;
7295     full_restr = PETSC_TRUE;
7296   }
7297   if (!pcbddc->coarse_size) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7298   ncoarse = PetscMax(1,ncoarse);
7299   if (!pcbddc->coarse_subassembling) {
7300     if (pcbddc->coarsening_ratio > 1) {
7301       if (multilevel_requested) {
7302         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7303       } else {
7304         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7305       }
7306     } else {
7307       PetscMPIInt size,rank;
7308       ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7309       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7310       have_void = (active_procs == (PetscInt)size) ? PETSC_FALSE : PETSC_TRUE;
7311       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7312     }
7313   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7314     PetscInt    psum;
7315     PetscMPIInt size;
7316     if (pcbddc->coarse_ksp) psum = 1;
7317     else psum = 0;
7318     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7319     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&size);CHKERRQ(ierr);
7320     if (ncoarse < size) have_void = PETSC_TRUE;
7321   }
7322   /* determine if we can go multilevel */
7323   if (multilevel_requested) {
7324     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7325     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7326   }
7327   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7328 
7329   /* dump subassembling pattern */
7330   if (pcbddc->dbg_flag && multilevel_allowed) {
7331     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7332   }
7333 
7334   /* compute dofs splitting and neumann boundaries for coarse dofs */
7335   nedcfield = -1;
7336   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7337     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7338     const PetscInt         *idxs;
7339     ISLocalToGlobalMapping tmap;
7340 
7341     /* create map between primal indices (in local representative ordering) and local primal numbering */
7342     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7343     /* allocate space for temporary storage */
7344     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7345     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7346     /* allocate for IS array */
7347     nisdofs = pcbddc->n_ISForDofsLocal;
7348     if (pcbddc->nedclocal) {
7349       if (pcbddc->nedfield > -1) {
7350         nedcfield = pcbddc->nedfield;
7351       } else {
7352         nedcfield = 0;
7353         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7354         nisdofs = 1;
7355       }
7356     }
7357     nisneu = !!pcbddc->NeumannBoundariesLocal;
7358     nisvert = 0; /* nisvert is not used */
7359     nis = nisdofs + nisneu + nisvert;
7360     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7361     /* dofs splitting */
7362     for (i=0;i<nisdofs;i++) {
7363       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7364       if (nedcfield != i) {
7365         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7366         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7367         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7368         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7369       } else {
7370         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7371         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7372         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7373         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7374         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7375       }
7376       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7377       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7378       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7379     }
7380     /* neumann boundaries */
7381     if (pcbddc->NeumannBoundariesLocal) {
7382       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7383       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7384       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7385       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7386       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7387       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7388       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7389       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7390     }
7391     /* free memory */
7392     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7393     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7394     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7395   } else {
7396     nis = 0;
7397     nisdofs = 0;
7398     nisneu = 0;
7399     nisvert = 0;
7400     isarray = NULL;
7401   }
7402   /* destroy no longer needed map */
7403   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7404 
7405   /* subassemble */
7406   if (multilevel_allowed) {
7407     Vec       vp[1];
7408     PetscInt  nvecs = 0;
7409     PetscBool reuse,reuser;
7410 
7411     if (coarse_mat) reuse = PETSC_TRUE;
7412     else reuse = PETSC_FALSE;
7413     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7414     vp[0] = NULL;
7415     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
7416       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
7417       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
7418       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
7419       nvecs = 1;
7420 
7421       if (pcbddc->divudotp) {
7422         Mat      B,loc_divudotp;
7423         Vec      v,p;
7424         IS       dummy;
7425         PetscInt np;
7426 
7427         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
7428         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
7429         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
7430         ierr = MatGetSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
7431         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
7432         ierr = VecSet(p,1.);CHKERRQ(ierr);
7433         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
7434         ierr = VecDestroy(&p);CHKERRQ(ierr);
7435         ierr = MatDestroy(&B);CHKERRQ(ierr);
7436         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
7437         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
7438         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
7439         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
7440         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
7441         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
7442         ierr = VecDestroy(&v);CHKERRQ(ierr);
7443       }
7444     }
7445     if (reuser) {
7446       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7447     } else {
7448       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
7449     }
7450     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
7451       PetscScalar *arraym,*arrayv;
7452       PetscInt    nl;
7453       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
7454       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
7455       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7456       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
7457       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
7458       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
7459       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
7460       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
7461     } else {
7462       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
7463     }
7464   } else {
7465     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
7466   }
7467   if (coarse_mat_is || coarse_mat) {
7468     PetscMPIInt size;
7469     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
7470     if (!multilevel_allowed) {
7471       ierr = MatISGetMPIXAIJ(coarse_mat_is,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
7472     } else {
7473       Mat A;
7474 
7475       /* if this matrix is present, it means we are not reusing the coarse matrix */
7476       if (coarse_mat_is) {
7477         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
7478         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
7479         coarse_mat = coarse_mat_is;
7480       }
7481       /* be sure we don't have MatSeqDENSE as local mat */
7482       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
7483       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
7484     }
7485   }
7486   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
7487   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
7488 
7489   /* create local to global scatters for coarse problem */
7490   if (compute_vecs) {
7491     PetscInt lrows;
7492     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
7493     if (coarse_mat) {
7494       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
7495     } else {
7496       lrows = 0;
7497     }
7498     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
7499     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
7500     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
7501     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7502     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
7503   }
7504   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
7505 
7506   /* set defaults for coarse KSP and PC */
7507   if (multilevel_allowed) {
7508     coarse_ksp_type = KSPRICHARDSON;
7509     coarse_pc_type = PCBDDC;
7510   } else {
7511     coarse_ksp_type = KSPPREONLY;
7512     coarse_pc_type = PCREDUNDANT;
7513   }
7514 
7515   /* print some info if requested */
7516   if (pcbddc->dbg_flag) {
7517     if (!multilevel_allowed) {
7518       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7519       if (multilevel_requested) {
7520         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);
7521       } else if (pcbddc->max_levels) {
7522         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
7523       }
7524       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7525     }
7526   }
7527 
7528   /* communicate coarse discrete gradient */
7529   coarseG = NULL;
7530   if (pcbddc->nedcG && multilevel_allowed) {
7531     MPI_Comm ccomm;
7532     if (coarse_mat) {
7533       ccomm = PetscObjectComm((PetscObject)coarse_mat);
7534     } else {
7535       ccomm = MPI_COMM_NULL;
7536     }
7537     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
7538   }
7539 
7540   /* create the coarse KSP object only once with defaults */
7541   if (coarse_mat) {
7542     PetscViewer dbg_viewer = NULL;
7543     if (pcbddc->dbg_flag) {
7544       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
7545       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7546     }
7547     if (!pcbddc->coarse_ksp) {
7548       char prefix[256],str_level[16];
7549       size_t len;
7550 
7551       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
7552       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7553       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
7554       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
7555       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7556       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
7557       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
7558       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7559       /* TODO is this logic correct? should check for coarse_mat type */
7560       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7561       /* prefix */
7562       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
7563       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
7564       if (!pcbddc->current_level) {
7565         ierr = PetscStrcpy(prefix,((PetscObject)pc)->prefix);CHKERRQ(ierr);
7566         ierr = PetscStrcat(prefix,"pc_bddc_coarse_");CHKERRQ(ierr);
7567       } else {
7568         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
7569         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
7570         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
7571         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
7572         sprintf(str_level,"l%d_",(int)(pcbddc->current_level));
7573         ierr = PetscStrcat(prefix,str_level);CHKERRQ(ierr);
7574       }
7575       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
7576       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7577       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
7578       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
7579       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
7580       /* allow user customization */
7581       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
7582     }
7583     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
7584     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
7585     if (nisdofs) {
7586       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
7587       for (i=0;i<nisdofs;i++) {
7588         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7589       }
7590     }
7591     if (nisneu) {
7592       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
7593       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
7594     }
7595     if (nisvert) {
7596       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
7597       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
7598     }
7599     if (coarseG) {
7600       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
7601     }
7602 
7603     /* get some info after set from options */
7604     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
7605     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
7606     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
7607     if (isbddc && !multilevel_allowed) { /* multilevel can only be requested via pc_bddc_set_levels */
7608       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
7609       isbddc = PETSC_FALSE;
7610     }
7611     ierr = PCFactorSetReuseFill(pc_temp,PETSC_TRUE);CHKERRQ(ierr);
7612     if (isredundant) {
7613       KSP inner_ksp;
7614       PC  inner_pc;
7615       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
7616       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
7617       ierr = PCFactorSetReuseFill(inner_pc,PETSC_TRUE);CHKERRQ(ierr);
7618     }
7619 
7620     /* parameters which miss an API */
7621     if (isbddc) {
7622       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
7623       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
7624       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
7625       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
7626       if (pcbddc_coarse->benign_saddle_point) {
7627         Mat                    coarsedivudotp_is;
7628         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
7629         IS                     row,col;
7630         const PetscInt         *gidxs;
7631         PetscInt               n,st,M,N;
7632 
7633         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
7634         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
7635         st = st-n;
7636         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
7637         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
7638         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
7639         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7640         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
7641         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
7642         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
7643         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
7644         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
7645         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
7646         ierr = ISDestroy(&row);CHKERRQ(ierr);
7647         ierr = ISDestroy(&col);CHKERRQ(ierr);
7648         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
7649         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
7650         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
7651         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
7652         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
7653         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
7654         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
7655         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7656         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
7657         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
7658         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
7659         if (pcbddc->adaptive_threshold < 1.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
7660       }
7661     }
7662 
7663     /* propagate symmetry info of coarse matrix */
7664     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
7665     if (pc->pmat->symmetric_set) {
7666       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
7667     }
7668     if (pc->pmat->hermitian_set) {
7669       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
7670     }
7671     if (pc->pmat->spd_set) {
7672       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
7673     }
7674     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
7675       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
7676     }
7677     /* set operators */
7678     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7679     if (pcbddc->dbg_flag) {
7680       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
7681     }
7682   }
7683   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
7684   ierr = PetscFree(isarray);CHKERRQ(ierr);
7685 #if 0
7686   {
7687     PetscViewer viewer;
7688     char filename[256];
7689     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
7690     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
7691     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
7692     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
7693     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
7694     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
7695   }
7696 #endif
7697 
7698   if (pcbddc->coarse_ksp) {
7699     Vec crhs,csol;
7700 
7701     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
7702     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
7703     if (!csol) {
7704       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
7705     }
7706     if (!crhs) {
7707       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
7708     }
7709   }
7710   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
7711 
7712   /* compute null space for coarse solver if the benign trick has been requested */
7713   if (pcbddc->benign_null) {
7714 
7715     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
7716     for (i=0;i<pcbddc->benign_n;i++) {
7717       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
7718     }
7719     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
7720     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
7721     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7722     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7723     if (coarse_mat) {
7724       Vec         nullv;
7725       PetscScalar *array,*array2;
7726       PetscInt    nl;
7727 
7728       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
7729       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
7730       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7731       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
7732       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
7733       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
7734       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
7735       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
7736       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
7737       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
7738     }
7739   }
7740 
7741   if (pcbddc->coarse_ksp) {
7742     PetscBool ispreonly;
7743 
7744     if (CoarseNullSpace) {
7745       PetscBool isnull;
7746       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
7747       if (isnull) {
7748         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
7749       }
7750       /* TODO: add local nullspaces (if any) */
7751     }
7752     /* setup coarse ksp */
7753     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
7754     /* Check coarse problem if in debug mode or if solving with an iterative method */
7755     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
7756     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
7757       KSP       check_ksp;
7758       KSPType   check_ksp_type;
7759       PC        check_pc;
7760       Vec       check_vec,coarse_vec;
7761       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
7762       PetscInt  its;
7763       PetscBool compute_eigs;
7764       PetscReal *eigs_r,*eigs_c;
7765       PetscInt  neigs;
7766       const char *prefix;
7767 
7768       /* Create ksp object suitable for estimation of extreme eigenvalues */
7769       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
7770       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
7771       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
7772       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
7773       /* prevent from setup unneeded object */
7774       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
7775       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
7776       if (ispreonly) {
7777         check_ksp_type = KSPPREONLY;
7778         compute_eigs = PETSC_FALSE;
7779       } else {
7780         check_ksp_type = KSPGMRES;
7781         compute_eigs = PETSC_TRUE;
7782       }
7783       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
7784       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
7785       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
7786       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
7787       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
7788       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
7789       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
7790       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
7791       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
7792       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
7793       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
7794       /* create random vec */
7795       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
7796       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
7797       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7798       /* solve coarse problem */
7799       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
7800       /* set eigenvalue estimation if preonly has not been requested */
7801       if (compute_eigs) {
7802         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
7803         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
7804         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
7805         if (neigs) {
7806           lambda_max = eigs_r[neigs-1];
7807           lambda_min = eigs_r[0];
7808           if (pcbddc->use_coarse_estimates) {
7809             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
7810               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
7811               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
7812             }
7813           }
7814         }
7815       }
7816 
7817       /* check coarse problem residual error */
7818       if (pcbddc->dbg_flag) {
7819         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
7820         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7821         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
7822         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7823         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
7824         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
7825         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
7826         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
7827         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
7828         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
7829         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
7830         if (CoarseNullSpace) {
7831           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
7832         }
7833         if (compute_eigs) {
7834           PetscReal          lambda_max_s,lambda_min_s;
7835           KSPConvergedReason reason;
7836           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
7837           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
7838           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
7839           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
7840           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);
7841           for (i=0;i<neigs;i++) {
7842             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
7843           }
7844         }
7845         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
7846         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
7847       }
7848       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
7849       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
7850       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
7851       if (compute_eigs) {
7852         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
7853         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
7854       }
7855     }
7856   }
7857   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
7858   /* print additional info */
7859   if (pcbddc->dbg_flag) {
7860     /* waits until all processes reaches this point */
7861     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
7862     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
7863     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7864   }
7865 
7866   /* free memory */
7867   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
7868   PetscFunctionReturn(0);
7869 }
7870 
7871 #undef __FUNCT__
7872 #define __FUNCT__ "PCBDDCComputePrimalNumbering"
7873 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
7874 {
7875   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
7876   PC_IS*         pcis = (PC_IS*)pc->data;
7877   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
7878   IS             subset,subset_mult,subset_n;
7879   PetscInt       local_size,coarse_size=0;
7880   PetscInt       *local_primal_indices=NULL;
7881   const PetscInt *t_local_primal_indices;
7882   PetscErrorCode ierr;
7883 
7884   PetscFunctionBegin;
7885   /* Compute global number of coarse dofs */
7886   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
7887   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
7888   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
7889   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7890   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
7891   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
7892   ierr = ISDestroy(&subset);CHKERRQ(ierr);
7893   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
7894   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
7895   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);
7896   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
7897   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7898   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
7899   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
7900   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
7901 
7902   /* check numbering */
7903   if (pcbddc->dbg_flag) {
7904     PetscScalar coarsesum,*array,*array2;
7905     PetscInt    i;
7906     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
7907 
7908     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7909     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
7910     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
7911     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7912     /* counter */
7913     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7914     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
7915     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7916     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7917     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7918     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7919     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
7920     for (i=0;i<pcbddc->local_primal_size;i++) {
7921       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
7922     }
7923     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
7924     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
7925     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7926     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7927     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7928     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7929     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
7930     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
7931     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
7932     for (i=0;i<pcis->n;i++) {
7933       if (array[i] != 0.0 && array[i] != array2[i]) {
7934         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
7935         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
7936         set_error = PETSC_TRUE;
7937         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
7938         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);
7939       }
7940     }
7941     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
7942     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7943     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7944     for (i=0;i<pcis->n;i++) {
7945       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
7946     }
7947     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
7948     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
7949     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7950     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
7951     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
7952     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
7953     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
7954       PetscInt *gidxs;
7955 
7956       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
7957       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
7958       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
7959       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7960       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
7961       for (i=0;i<pcbddc->local_primal_size;i++) {
7962         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);
7963       }
7964       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7965       ierr = PetscFree(gidxs);CHKERRQ(ierr);
7966     }
7967     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
7968     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
7969     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
7970   }
7971   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
7972   /* get back data */
7973   *coarse_size_n = coarse_size;
7974   *local_primal_indices_n = local_primal_indices;
7975   PetscFunctionReturn(0);
7976 }
7977 
7978 #undef __FUNCT__
7979 #define __FUNCT__ "PCBDDCGlobalToLocal"
7980 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
7981 {
7982   IS             localis_t;
7983   PetscInt       i,lsize,*idxs,n;
7984   PetscScalar    *vals;
7985   PetscErrorCode ierr;
7986 
7987   PetscFunctionBegin;
7988   /* get indices in local ordering exploiting local to global map */
7989   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
7990   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
7991   for (i=0;i<lsize;i++) vals[i] = 1.0;
7992   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
7993   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
7994   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
7995   if (idxs) { /* multilevel guard */
7996     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
7997   }
7998   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
7999   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8000   ierr = PetscFree(vals);CHKERRQ(ierr);
8001   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8002   /* now compute set in local ordering */
8003   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8004   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8005   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8006   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8007   for (i=0,lsize=0;i<n;i++) {
8008     if (PetscRealPart(vals[i]) > 0.5) {
8009       lsize++;
8010     }
8011   }
8012   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8013   for (i=0,lsize=0;i<n;i++) {
8014     if (PetscRealPart(vals[i]) > 0.5) {
8015       idxs[lsize++] = i;
8016     }
8017   }
8018   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8019   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8020   *localis = localis_t;
8021   PetscFunctionReturn(0);
8022 }
8023 
8024 #undef __FUNCT__
8025 #define __FUNCT__ "PCBDDCSetUpSubSchurs"
8026 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8027 {
8028   PC_IS               *pcis=(PC_IS*)pc->data;
8029   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8030   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8031   Mat                 S_j;
8032   PetscInt            *used_xadj,*used_adjncy;
8033   PetscBool           free_used_adj;
8034   PetscErrorCode      ierr;
8035 
8036   PetscFunctionBegin;
8037   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8038   free_used_adj = PETSC_FALSE;
8039   if (pcbddc->sub_schurs_layers == -1) {
8040     used_xadj = NULL;
8041     used_adjncy = NULL;
8042   } else {
8043     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8044       used_xadj = pcbddc->mat_graph->xadj;
8045       used_adjncy = pcbddc->mat_graph->adjncy;
8046     } else if (pcbddc->computed_rowadj) {
8047       used_xadj = pcbddc->mat_graph->xadj;
8048       used_adjncy = pcbddc->mat_graph->adjncy;
8049     } else {
8050       PetscBool      flg_row=PETSC_FALSE;
8051       const PetscInt *xadj,*adjncy;
8052       PetscInt       nvtxs;
8053 
8054       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8055       if (flg_row) {
8056         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8057         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8058         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8059         free_used_adj = PETSC_TRUE;
8060       } else {
8061         pcbddc->sub_schurs_layers = -1;
8062         used_xadj = NULL;
8063         used_adjncy = NULL;
8064       }
8065       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8066     }
8067   }
8068 
8069   /* setup sub_schurs data */
8070   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8071   if (!sub_schurs->schur_explicit) {
8072     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8073     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8074     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);
8075   } else {
8076     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8077     PetscBool isseqaij,need_change = PETSC_FALSE;
8078     PetscInt  benign_n;
8079     Mat       change = NULL;
8080     Vec       scaling = NULL;
8081     IS        change_primal = NULL;
8082 
8083     if (!pcbddc->use_vertices && reuse_solvers) {
8084       PetscInt n_vertices;
8085 
8086       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8087       reuse_solvers = (PetscBool)!n_vertices;
8088     }
8089     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8090     if (!isseqaij) {
8091       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8092       if (matis->A == pcbddc->local_mat) {
8093         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8094         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8095       } else {
8096         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8097       }
8098     }
8099     if (!pcbddc->benign_change_explicit) {
8100       benign_n = pcbddc->benign_n;
8101     } else {
8102       benign_n = 0;
8103     }
8104     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8105        We need a global reduction to avoid possible deadlocks.
8106        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8107     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8108       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8109       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8110       need_change = (PetscBool)(!need_change);
8111     }
8112     /* If the user defines additional constraints, we import them here.
8113        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 */
8114     if (need_change) {
8115       PC_IS   *pcisf;
8116       PC_BDDC *pcbddcf;
8117       PC      pcf;
8118 
8119       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8120       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8121       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8122       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8123       /* hacks */
8124       pcisf = (PC_IS*)pcf->data;
8125       pcisf->is_B_local = pcis->is_B_local;
8126       pcisf->vec1_N = pcis->vec1_N;
8127       pcisf->BtoNmap = pcis->BtoNmap;
8128       pcisf->n = pcis->n;
8129       pcisf->n_B = pcis->n_B;
8130       pcbddcf = (PC_BDDC*)pcf->data;
8131       ierr = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8132       pcbddcf->mat_graph = pcbddc->mat_graph;
8133       pcbddcf->use_faces = PETSC_TRUE;
8134       pcbddcf->use_change_of_basis = PETSC_TRUE;
8135       pcbddcf->use_change_on_faces = PETSC_TRUE;
8136       pcbddcf->use_qr_single = PETSC_TRUE;
8137       pcbddcf->fake_change = PETSC_TRUE;
8138       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8139       /* store information on primal vertices and change of basis (in local numbering) */
8140       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8141       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8142       change = pcbddcf->ConstraintMatrix;
8143       pcbddcf->ConstraintMatrix = NULL;
8144       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8145       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8146       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8147       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8148       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8149       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8150       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8151       pcf->ops->destroy = NULL;
8152       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8153     }
8154     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8155     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);
8156     ierr = MatDestroy(&change);CHKERRQ(ierr);
8157     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8158   }
8159   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8160 
8161   /* free adjacency */
8162   if (free_used_adj) {
8163     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8164   }
8165   PetscFunctionReturn(0);
8166 }
8167 
8168 #undef __FUNCT__
8169 #define __FUNCT__ "PCBDDCInitSubSchurs"
8170 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8171 {
8172   PC_IS               *pcis=(PC_IS*)pc->data;
8173   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8174   PCBDDCGraph         graph;
8175   PetscErrorCode      ierr;
8176 
8177   PetscFunctionBegin;
8178   /* attach interface graph for determining subsets */
8179   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8180     IS       verticesIS,verticescomm;
8181     PetscInt vsize,*idxs;
8182 
8183     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8184     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8185     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8186     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8187     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8188     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8189     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8190     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8191     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8192     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8193     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8194   } else {
8195     graph = pcbddc->mat_graph;
8196   }
8197   /* print some info */
8198   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8199     IS       vertices;
8200     PetscInt nv,nedges,nfaces;
8201     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8202     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8203     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8204     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8205     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8206     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8207     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8208     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8209     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8210     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8211     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8212   }
8213 
8214   /* sub_schurs init */
8215   if (!pcbddc->sub_schurs) {
8216     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8217   }
8218   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8219 
8220   /* free graph struct */
8221   if (pcbddc->sub_schurs_rebuild) {
8222     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8223   }
8224   PetscFunctionReturn(0);
8225 }
8226 
8227 #undef __FUNCT__
8228 #define __FUNCT__ "PCBDDCCheckOperator"
8229 PetscErrorCode PCBDDCCheckOperator(PC pc)
8230 {
8231   PC_IS               *pcis=(PC_IS*)pc->data;
8232   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8233   PetscErrorCode      ierr;
8234 
8235   PetscFunctionBegin;
8236   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8237     IS             zerodiag = NULL;
8238     Mat            S_j,B0_B=NULL;
8239     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8240     PetscScalar    *p0_check,*array,*array2;
8241     PetscReal      norm;
8242     PetscInt       i;
8243 
8244     /* B0 and B0_B */
8245     if (zerodiag) {
8246       IS       dummy;
8247 
8248       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8249       ierr = MatGetSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8250       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8251       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8252     }
8253     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8254     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8255     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8256     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8257     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8258     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8259     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8260     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8261     /* S_j */
8262     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8263     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8264 
8265     /* mimic vector in \widetilde{W}_\Gamma */
8266     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8267     /* continuous in primal space */
8268     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8269     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8270     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8271     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8272     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8273     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8274     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8275     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8276     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8277     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8278     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8279     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8280     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8281     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8282 
8283     /* assemble rhs for coarse problem */
8284     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8285     /* local with Schur */
8286     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8287     if (zerodiag) {
8288       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8289       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8290       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8291       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8292     }
8293     /* sum on primal nodes the local contributions */
8294     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8295     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8296     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8297     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8298     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8299     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8300     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8301     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8302     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8303     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8304     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8305     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8306     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8307     /* scale primal nodes (BDDC sums contibutions) */
8308     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8309     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8310     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8311     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8312     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8313     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8314     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8315     /* global: \widetilde{B0}_B w_\Gamma */
8316     if (zerodiag) {
8317       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8318       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8319       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8320       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8321     }
8322     /* BDDC */
8323     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8324     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8325 
8326     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8327     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8328     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8329     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8330     for (i=0;i<pcbddc->benign_n;i++) {
8331       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8332     }
8333     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8334     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8335     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8336     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8337     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8338     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8339   }
8340   PetscFunctionReturn(0);
8341 }
8342 
8343 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8344 #undef __FUNCT__
8345 #define __FUNCT__ "MatMPIAIJRestrict"
8346 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8347 {
8348   Mat            At;
8349   IS             rows;
8350   PetscInt       rst,ren;
8351   PetscErrorCode ierr;
8352   PetscLayout    rmap;
8353 
8354   PetscFunctionBegin;
8355   rst = ren = 0;
8356   if (ccomm != MPI_COMM_NULL) {
8357     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8358     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8359     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8360     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8361     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8362   }
8363   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8364   ierr = MatGetSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8365   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8366 
8367   if (ccomm != MPI_COMM_NULL) {
8368     Mat_MPIAIJ *a,*b;
8369     IS         from,to;
8370     Vec        gvec;
8371     PetscInt   lsize;
8372 
8373     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8374     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8375     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8376     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8377     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8378     a    = (Mat_MPIAIJ*)At->data;
8379     b    = (Mat_MPIAIJ*)(*B)->data;
8380     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8381     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8382     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8383     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
8384     b->A = a->A;
8385     b->B = a->B;
8386 
8387     b->donotstash      = a->donotstash;
8388     b->roworiented     = a->roworiented;
8389     b->rowindices      = 0;
8390     b->rowvalues       = 0;
8391     b->getrowactive    = PETSC_FALSE;
8392 
8393     (*B)->rmap         = rmap;
8394     (*B)->factortype   = A->factortype;
8395     (*B)->assembled    = PETSC_TRUE;
8396     (*B)->insertmode   = NOT_SET_VALUES;
8397     (*B)->preallocated = PETSC_TRUE;
8398 
8399     if (a->colmap) {
8400 #if defined(PETSC_USE_CTABLE)
8401       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
8402 #else
8403       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
8404       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8405       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
8406 #endif
8407     } else b->colmap = 0;
8408     if (a->garray) {
8409       PetscInt len;
8410       len  = a->B->cmap->n;
8411       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
8412       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
8413       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
8414     } else b->garray = 0;
8415 
8416     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
8417     b->lvec = a->lvec;
8418     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
8419 
8420     /* cannot use VecScatterCopy */
8421     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
8422     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
8423     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
8424     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
8425     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
8426     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
8427     ierr = ISDestroy(&from);CHKERRQ(ierr);
8428     ierr = ISDestroy(&to);CHKERRQ(ierr);
8429     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
8430   }
8431   ierr = MatDestroy(&At);CHKERRQ(ierr);
8432   PetscFunctionReturn(0);
8433 }
8434