xref: /petsc/src/ksp/pc/impls/bddc/bddcprivate.c (revision 65f8aed5f7eaa1e2ef2ddeffe666264e0669c876)
1 #include <../src/mat/impls/aij/seq/aij.h>
2 #include <../src/ksp/pc/impls/bddc/bddc.h>
3 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
4 #include <../src/mat/impls/dense/seq/dense.h>
5 #include <petscdmplex.h>
6 #include <petscblaslapack.h>
7 #include <petsc/private/sfimpl.h>
8 #include <petsc/private/dmpleximpl.h>
9 #include <petscdmda.h>
10 
11 static PetscErrorCode MatMPIAIJRestrict(Mat,MPI_Comm,Mat*);
12 
13 /* if range is true,  it returns B s.t. span{B} = range(A)
14    if range is false, it returns B s.t. range(B) _|_ range(A) */
15 PetscErrorCode MatDenseOrthogonalRangeOrComplement(Mat A, PetscBool range, PetscInt lw, PetscScalar *work, PetscReal *rwork, Mat *B)
16 {
17 #if !defined(PETSC_USE_COMPLEX)
18   PetscScalar    *uwork,*data,*U, ds = 0.;
19   PetscReal      *sing;
20   PetscBLASInt   bM,bN,lwork,lierr,di = 1;
21   PetscInt       ulw,i,nr,nc,n;
22   PetscErrorCode ierr;
23 
24   PetscFunctionBegin;
25 #if defined(PETSC_MISSING_LAPACK_GESVD)
26   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"LAPACK _GESVD not available");
27 #else
28   ierr = MatGetSize(A,&nr,&nc);CHKERRQ(ierr);
29   if (!nr || !nc) PetscFunctionReturn(0);
30 
31   /* workspace */
32   if (!work) {
33     ulw  = PetscMax(PetscMax(1,5*PetscMin(nr,nc)),3*PetscMin(nr,nc)+PetscMax(nr,nc));
34     ierr = PetscMalloc1(ulw,&uwork);CHKERRQ(ierr);
35   } else {
36     ulw   = lw;
37     uwork = work;
38   }
39   n = PetscMin(nr,nc);
40   if (!rwork) {
41     ierr = PetscMalloc1(n,&sing);CHKERRQ(ierr);
42   } else {
43     sing = rwork;
44   }
45 
46   /* SVD */
47   ierr = PetscMalloc1(nr*nr,&U);CHKERRQ(ierr);
48   ierr = PetscBLASIntCast(nr,&bM);CHKERRQ(ierr);
49   ierr = PetscBLASIntCast(nc,&bN);CHKERRQ(ierr);
50   ierr = PetscBLASIntCast(ulw,&lwork);CHKERRQ(ierr);
51   ierr = MatDenseGetArray(A,&data);CHKERRQ(ierr);
52   ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
53   PetscStackCallBLAS("LAPACKgesvd",LAPACKgesvd_("A","N",&bM,&bN,data,&bM,sing,U,&bM,&ds,&di,uwork,&lwork,&lierr));
54   ierr = PetscFPTrapPop();CHKERRQ(ierr);
55   if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
56   ierr = MatDenseRestoreArray(A,&data);CHKERRQ(ierr);
57   for (i=0;i<n;i++) if (sing[i] < PETSC_SMALL) break;
58   if (!rwork) {
59     ierr = PetscFree(sing);CHKERRQ(ierr);
60   }
61   if (!work) {
62     ierr = PetscFree(uwork);CHKERRQ(ierr);
63   }
64   /* create B */
65   if (!range) {
66     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,nr-i,NULL,B);CHKERRQ(ierr);
67     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
68     ierr = PetscMemcpy(data,U+nr*i,(nr-i)*nr*sizeof(PetscScalar));CHKERRQ(ierr);
69   } else {
70     ierr = MatCreateSeqDense(PETSC_COMM_SELF,nr,i,NULL,B);CHKERRQ(ierr);
71     ierr = MatDenseGetArray(*B,&data);CHKERRQ(ierr);
72     ierr = PetscMemcpy(data,U,i*nr*sizeof(PetscScalar));CHKERRQ(ierr);
73   }
74   ierr = MatDenseRestoreArray(*B,&data);CHKERRQ(ierr);
75   ierr = PetscFree(U);CHKERRQ(ierr);
76 #endif
77 #else /* PETSC_USE_COMPLEX */
78   PetscFunctionBegin;
79   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented for complexes");
80 #endif
81   PetscFunctionReturn(0);
82 }
83 
84 /* TODO REMOVE */
85 #if defined(PRINT_GDET)
86 static int inc = 0;
87 static int lev = 0;
88 #endif
89 
90 PetscErrorCode PCBDDCComputeNedelecChangeEdge(Mat lG, IS edge, IS extrow, IS extcol, IS corners, Mat* Gins, Mat* GKins, PetscScalar cvals[2], PetscScalar *work, PetscReal *rwork)
91 {
92   PetscErrorCode ierr;
93   Mat            GE,GEd;
94   PetscInt       rsize,csize,esize;
95   PetscScalar    *ptr;
96 
97   PetscFunctionBegin;
98   ierr = ISGetSize(edge,&esize);CHKERRQ(ierr);
99   if (!esize) PetscFunctionReturn(0);
100   ierr = ISGetSize(extrow,&rsize);CHKERRQ(ierr);
101   ierr = ISGetSize(extcol,&csize);CHKERRQ(ierr);
102 
103   /* gradients */
104   ptr  = work + 5*esize;
105   ierr = MatCreateSubMatrix(lG,extrow,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
106   ierr = MatCreateSeqDense(PETSC_COMM_SELF,rsize,csize,ptr,Gins);CHKERRQ(ierr);
107   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,Gins);CHKERRQ(ierr);
108   ierr = MatDestroy(&GE);CHKERRQ(ierr);
109 
110   /* constants */
111   ptr += rsize*csize;
112   ierr = MatCreateSeqDense(PETSC_COMM_SELF,esize,csize,ptr,&GEd);CHKERRQ(ierr);
113   ierr = MatCreateSubMatrix(lG,edge,extcol,MAT_INITIAL_MATRIX,&GE);CHKERRQ(ierr);
114   ierr = MatConvert(GE,MATSEQDENSE,MAT_REUSE_MATRIX,&GEd);CHKERRQ(ierr);
115   ierr = MatDestroy(&GE);CHKERRQ(ierr);
116   ierr = MatDenseOrthogonalRangeOrComplement(GEd,PETSC_FALSE,5*esize,work,rwork,GKins);CHKERRQ(ierr);
117   ierr = MatDestroy(&GEd);CHKERRQ(ierr);
118 
119   if (corners) {
120     Mat            GEc;
121     PetscScalar    *vals,v;
122 
123     ierr = MatCreateSubMatrix(lG,edge,corners,MAT_INITIAL_MATRIX,&GEc);CHKERRQ(ierr);
124     ierr = MatTransposeMatMult(GEc,*GKins,MAT_INITIAL_MATRIX,1.0,&GEd);CHKERRQ(ierr);
125     ierr = MatDenseGetArray(GEd,&vals);CHKERRQ(ierr);
126     /* v    = PetscAbsScalar(vals[0]) */;
127     v    = 1.;
128     cvals[0] = vals[0]/v;
129     cvals[1] = vals[1]/v;
130     ierr = MatDenseRestoreArray(GEd,&vals);CHKERRQ(ierr);
131     ierr = MatScale(*GKins,1./v);CHKERRQ(ierr);
132 #if defined(PRINT_GDET)
133     {
134       PetscViewer viewer;
135       char filename[256];
136       sprintf(filename,"Gdet_l%d_r%d_cc%d.m",lev,PetscGlobalRank,inc++);
137       ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
138       ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
139       ierr = PetscObjectSetName((PetscObject)GEc,"GEc");CHKERRQ(ierr);
140       ierr = MatView(GEc,viewer);CHKERRQ(ierr);
141       ierr = PetscObjectSetName((PetscObject)(*GKins),"GK");CHKERRQ(ierr);
142       ierr = MatView(*GKins,viewer);CHKERRQ(ierr);
143       ierr = PetscObjectSetName((PetscObject)GEd,"Gproj");CHKERRQ(ierr);
144       ierr = MatView(GEd,viewer);CHKERRQ(ierr);
145       ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
146     }
147 #endif
148     ierr = MatDestroy(&GEd);CHKERRQ(ierr);
149     ierr = MatDestroy(&GEc);CHKERRQ(ierr);
150   }
151 
152   PetscFunctionReturn(0);
153 }
154 
155 PetscErrorCode PCBDDCNedelecSupport(PC pc)
156 {
157   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
158   Mat_IS                 *matis = (Mat_IS*)pc->pmat->data;
159   Mat                    G,T,conn,lG,lGt,lGis,lGall,lGe,lGinit;
160   Vec                    tvec;
161   PetscSF                sfv;
162   ISLocalToGlobalMapping el2g,vl2g,fl2g,al2g;
163   MPI_Comm               comm;
164   IS                     lned,primals,allprimals,nedfieldlocal;
165   IS                     *eedges,*extrows,*extcols,*alleedges;
166   PetscBT                btv,bte,btvc,btb,btbd,btvcand,btvi,btee,bter;
167   PetscScalar            *vals,*work;
168   PetscReal              *rwork;
169   const PetscInt         *idxs,*ii,*jj,*iit,*jjt;
170   PetscInt               ne,nv,Lv,order,n,field;
171   PetscInt               n_neigh,*neigh,*n_shared,**shared;
172   PetscInt               i,j,extmem,cum,maxsize,nee;
173   PetscInt               *extrow,*extrowcum,*marks,*vmarks,*gidxs;
174   PetscInt               *sfvleaves,*sfvroots;
175   PetscInt               *corners,*cedges;
176   PetscInt               *ecount,**eneighs,*vcount,**vneighs;
177 #if defined(PETSC_USE_DEBUG)
178   PetscInt               *emarks;
179 #endif
180   PetscBool              print,eerr,done,lrc[2],conforming,global,singular,setprimal;
181   PetscErrorCode         ierr;
182 
183   PetscFunctionBegin;
184   /* If the discrete gradient is defined for a subset of dofs and global is true,
185      it assumes G is given in global ordering for all the dofs.
186      Otherwise, the ordering is global for the Nedelec field */
187   order      = pcbddc->nedorder;
188   conforming = pcbddc->conforming;
189   field      = pcbddc->nedfield;
190   global     = pcbddc->nedglobal;
191   setprimal  = PETSC_FALSE;
192   print      = PETSC_FALSE;
193   singular   = PETSC_FALSE;
194 
195   /* Command line customization */
196   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC Nedelec options","PC");CHKERRQ(ierr);
197   ierr = PetscOptionsBool("-pc_bddc_nedelec_field_primal","All edge dofs set as primals: Toselli's algorithm C",NULL,setprimal,&setprimal,NULL);CHKERRQ(ierr);
198   ierr = PetscOptionsBool("-pc_bddc_nedelec_singular","Infer nullspace from discrete gradient",NULL,singular,&singular,NULL);CHKERRQ(ierr);
199   ierr = PetscOptionsInt("-pc_bddc_nedelec_order","Test variable order code (to be removed)",NULL,order,&order,NULL);CHKERRQ(ierr);
200   /* print debug info TODO: to be removed */
201   ierr = PetscOptionsBool("-pc_bddc_nedelec_print","Print debug info",NULL,print,&print,NULL);CHKERRQ(ierr);
202   ierr = PetscOptionsEnd();CHKERRQ(ierr);
203 
204   /* Return if there are no edges in the decomposition and the problem is not singular */
205   ierr = MatGetLocalToGlobalMapping(pc->pmat,&al2g,NULL);CHKERRQ(ierr);
206   ierr = ISLocalToGlobalMappingGetSize(al2g,&n);CHKERRQ(ierr);
207   ierr = PetscObjectGetComm((PetscObject)pc,&comm);CHKERRQ(ierr);
208   if (!singular) {
209     ierr   = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
210     lrc[0] = PETSC_FALSE;
211     for (i=0;i<n;i++) {
212       if (PetscRealPart(vals[i]) > 2.) {
213         lrc[0] = PETSC_TRUE;
214         break;
215       }
216     }
217     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
218     ierr = MPIU_Allreduce(&lrc[0],&lrc[1],1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
219     if (!lrc[1]) PetscFunctionReturn(0);
220   }
221 
222   /* Get Nedelec field */
223   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
224   if (pcbddc->n_ISForDofsLocal && field >= pcbddc->n_ISForDofsLocal) SETERRQ2(comm,PETSC_ERR_USER,"Invalid field for Nedelec %d: number of fields is %d",field,pcbddc->n_ISForDofsLocal);
225   if (pcbddc->n_ISForDofsLocal && field >= 0) {
226     ierr          = PetscObjectReference((PetscObject)pcbddc->ISForDofsLocal[field]);CHKERRQ(ierr);
227     nedfieldlocal = pcbddc->ISForDofsLocal[field];
228     ierr          = ISGetLocalSize(nedfieldlocal,&ne);CHKERRQ(ierr);
229   } else if (!pcbddc->n_ISForDofsLocal && field != PETSC_DECIDE) {
230     ne            = n;
231     nedfieldlocal = NULL;
232     global        = PETSC_TRUE;
233   } else if (field == PETSC_DECIDE) {
234     PetscInt rst,ren,*idx;
235 
236     ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
237     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
238     ierr = MatGetOwnershipRange(pcbddc->discretegradient,&rst,&ren);CHKERRQ(ierr);
239     for (i=rst;i<ren;i++) {
240       PetscInt nc;
241 
242       ierr = MatGetRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
243       if (nc > 1) matis->sf_rootdata[i-rst] = 1;
244       ierr = MatRestoreRow(pcbddc->discretegradient,i,&nc,NULL,NULL);CHKERRQ(ierr);
245     }
246     ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
247     ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
248     ierr = PetscMalloc1(n,&idx);CHKERRQ(ierr);
249     for (i=0,ne=0;i<n;i++) if (matis->sf_leafdata[i]) idx[ne++] = i;
250     ierr = ISCreateGeneral(comm,ne,idx,PETSC_OWN_POINTER,&nedfieldlocal);CHKERRQ(ierr);
251   } else {
252     SETERRQ(comm,PETSC_ERR_USER,"When multiple fields are present, the Nedelec field has to be specified");
253   }
254 
255   /* Sanity checks */
256   if (!order && !conforming) SETERRQ(comm,PETSC_ERR_SUP,"Variable order and non-conforming spaces are not supported at the same time");
257   if (pcbddc->user_ChangeOfBasisMatrix) SETERRQ(comm,PETSC_ERR_SUP,"Cannot generate Nedelec support with user defined change of basis");
258   if (order && ne%order) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"The number of local edge dofs %d it's not a multiple of the order %d",ne,order);
259 
260   /* Just set primal dofs and return */
261   if (setprimal) {
262     IS       enedfieldlocal;
263     PetscInt *eidxs;
264 
265     ierr = PetscMalloc1(ne,&eidxs);CHKERRQ(ierr);
266     ierr = VecGetArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
267     if (nedfieldlocal) {
268       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
269       for (i=0,cum=0;i<ne;i++) {
270         if (PetscRealPart(vals[idxs[i]]) > 2.) {
271           eidxs[cum++] = idxs[i];
272         }
273       }
274       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
275     } else {
276       for (i=0,cum=0;i<ne;i++) {
277         if (PetscRealPart(vals[i]) > 2.) {
278           eidxs[cum++] = i;
279         }
280       }
281     }
282     ierr = VecRestoreArrayRead(matis->counter,(const PetscScalar**)&vals);CHKERRQ(ierr);
283     ierr = ISCreateGeneral(comm,cum,eidxs,PETSC_COPY_VALUES,&enedfieldlocal);CHKERRQ(ierr);
284     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,enedfieldlocal);CHKERRQ(ierr);
285     ierr = PetscFree(eidxs);CHKERRQ(ierr);
286     ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
287     ierr = ISDestroy(&enedfieldlocal);CHKERRQ(ierr);
288     PetscFunctionReturn(0);
289   }
290 
291   /* Compute some l2g maps */
292   if (nedfieldlocal) {
293     IS is;
294 
295     /* need to map from the local Nedelec field to local numbering */
296     ierr = ISLocalToGlobalMappingCreateIS(nedfieldlocal,&fl2g);CHKERRQ(ierr);
297     /* need to map from the local Nedelec field to global numbering for the whole dofs*/
298     ierr = ISLocalToGlobalMappingApplyIS(al2g,nedfieldlocal,&is);CHKERRQ(ierr);
299     ierr = ISLocalToGlobalMappingCreateIS(is,&al2g);CHKERRQ(ierr);
300     /* need to map from the local Nedelec field to global numbering (for Nedelec only) */
301     if (global) {
302       ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
303       el2g = al2g;
304     } else {
305       IS gis;
306 
307       ierr = ISRenumber(is,NULL,NULL,&gis);CHKERRQ(ierr);
308       ierr = ISLocalToGlobalMappingCreateIS(gis,&el2g);CHKERRQ(ierr);
309       ierr = ISDestroy(&gis);CHKERRQ(ierr);
310     }
311     ierr = ISDestroy(&is);CHKERRQ(ierr);
312   } else {
313     /* restore default */
314     pcbddc->nedfield = -1;
315     /* one ref for the destruction of al2g, one for el2g */
316     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
317     ierr = PetscObjectReference((PetscObject)al2g);CHKERRQ(ierr);
318     el2g = al2g;
319     fl2g = NULL;
320   }
321 
322   /* Start communication to drop connections for interior edges (for cc analysis only) */
323   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscInt));CHKERRQ(ierr);
324   ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscInt));CHKERRQ(ierr);
325   if (nedfieldlocal) {
326     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
327     for (i=0;i<ne;i++) matis->sf_leafdata[idxs[i]] = 1;
328     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
329   } else {
330     for (i=0;i<ne;i++) matis->sf_leafdata[i] = 1;
331   }
332   ierr = PetscSFReduceBegin(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
333   ierr = PetscSFReduceEnd(matis->sf,MPIU_INT,matis->sf_leafdata,matis->sf_rootdata,MPI_SUM);CHKERRQ(ierr);
334 
335   if (!singular) { /* drop connections with interior edges to avoid unneeded communications and memory movements */
336     ierr = MatDuplicate(pcbddc->discretegradient,MAT_COPY_VALUES,&G);CHKERRQ(ierr);
337     ierr = MatSetOption(G,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
338     if (global) {
339       PetscInt rst;
340 
341       ierr = MatGetOwnershipRange(G,&rst,NULL);CHKERRQ(ierr);
342       for (i=0,cum=0;i<pc->pmat->rmap->n;i++) {
343         if (matis->sf_rootdata[i] < 2) {
344           matis->sf_rootdata[cum++] = i + rst;
345         }
346       }
347       ierr = MatSetOption(G,MAT_NO_OFF_PROC_ZERO_ROWS,PETSC_TRUE);CHKERRQ(ierr);
348       ierr = MatZeroRows(G,cum,matis->sf_rootdata,0.,NULL,NULL);CHKERRQ(ierr);
349     } else {
350       PetscInt *tbz;
351 
352       ierr = PetscMalloc1(ne,&tbz);CHKERRQ(ierr);
353       ierr = PetscSFBcastBegin(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
354       ierr = PetscSFBcastEnd(matis->sf,MPIU_INT,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
355       ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
356       for (i=0,cum=0;i<ne;i++)
357         if (matis->sf_leafdata[idxs[i]] == 1)
358           tbz[cum++] = i;
359       ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
360       ierr = ISLocalToGlobalMappingApply(el2g,cum,tbz,tbz);CHKERRQ(ierr);
361       ierr = MatZeroRows(G,cum,tbz,0.,NULL,NULL);CHKERRQ(ierr);
362       ierr = PetscFree(tbz);CHKERRQ(ierr);
363     }
364   } else { /* we need the entire G to infer the nullspace */
365     ierr = PetscObjectReference((PetscObject)pcbddc->discretegradient);CHKERRQ(ierr);
366     G    = pcbddc->discretegradient;
367   }
368 
369   /* Extract subdomain relevant rows of G */
370   ierr = ISLocalToGlobalMappingGetIndices(el2g,&idxs);CHKERRQ(ierr);
371   ierr = ISCreateGeneral(comm,ne,idxs,PETSC_USE_POINTER,&lned);CHKERRQ(ierr);
372   ierr = MatCreateSubMatrix(G,lned,NULL,MAT_INITIAL_MATRIX,&lGall);CHKERRQ(ierr);
373   ierr = ISLocalToGlobalMappingRestoreIndices(el2g,&idxs);CHKERRQ(ierr);
374   ierr = ISDestroy(&lned);CHKERRQ(ierr);
375   ierr = MatConvert(lGall,MATIS,MAT_INITIAL_MATRIX,&lGis);CHKERRQ(ierr);
376   ierr = MatDestroy(&lGall);CHKERRQ(ierr);
377   ierr = MatISGetLocalMat(lGis,&lG);CHKERRQ(ierr);
378 
379   /* SF for nodal dofs communications */
380   ierr = MatGetLocalSize(G,NULL,&Lv);CHKERRQ(ierr);
381   ierr = MatGetLocalToGlobalMapping(lGis,NULL,&vl2g);CHKERRQ(ierr);
382   ierr = PetscObjectReference((PetscObject)vl2g);CHKERRQ(ierr);
383   ierr = ISLocalToGlobalMappingGetSize(vl2g,&nv);CHKERRQ(ierr);
384   ierr = PetscSFCreate(comm,&sfv);CHKERRQ(ierr);
385   ierr = ISLocalToGlobalMappingGetIndices(vl2g,&idxs);CHKERRQ(ierr);
386   ierr = PetscSFSetGraphLayout(sfv,lGis->cmap,nv,NULL,PETSC_OWN_POINTER,idxs);CHKERRQ(ierr);
387   ierr = ISLocalToGlobalMappingRestoreIndices(vl2g,&idxs);CHKERRQ(ierr);
388   i    = singular ? 2 : 1;
389   ierr = PetscMalloc2(i*nv,&sfvleaves,i*Lv,&sfvroots);CHKERRQ(ierr);
390 
391   /* Destroy temporary G created in MATIS format and modified G */
392   ierr = PetscObjectReference((PetscObject)lG);CHKERRQ(ierr);
393   ierr = MatDestroy(&lGis);CHKERRQ(ierr);
394   ierr = MatDestroy(&G);CHKERRQ(ierr);
395 
396   if (print) {
397     ierr = PetscObjectSetName((PetscObject)lG,"initial_lG");CHKERRQ(ierr);
398     ierr = MatView(lG,NULL);CHKERRQ(ierr);
399   }
400 
401   /* Save lG for values insertion in change of basis */
402   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGinit);CHKERRQ(ierr);
403 
404   /* Analyze the edge-nodes connections (duplicate lG) */
405   ierr = MatDuplicate(lG,MAT_COPY_VALUES,&lGe);CHKERRQ(ierr);
406   ierr = MatSetOption(lGe,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
407   ierr = PetscBTCreate(nv,&btv);CHKERRQ(ierr);
408   ierr = PetscBTCreate(ne,&bte);CHKERRQ(ierr);
409   ierr = PetscBTCreate(ne,&btb);CHKERRQ(ierr);
410   ierr = PetscBTCreate(ne,&btbd);CHKERRQ(ierr);
411   ierr = PetscBTCreate(nv,&btvcand);CHKERRQ(ierr);
412   /* need to import the boundary specification to ensure the
413      proper detection of coarse edges' endpoints */
414   if (pcbddc->DirichletBoundariesLocal) {
415     IS is;
416 
417     if (fl2g) {
418       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->DirichletBoundariesLocal,&is);CHKERRQ(ierr);
419     } else {
420       is = pcbddc->DirichletBoundariesLocal;
421     }
422     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
423     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
424     for (i=0;i<cum;i++) {
425       if (idxs[i] >= 0) {
426         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
427         ierr = PetscBTSet(btbd,idxs[i]);CHKERRQ(ierr);
428       }
429     }
430     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
431     if (fl2g) {
432       ierr = ISDestroy(&is);CHKERRQ(ierr);
433     }
434   }
435   if (pcbddc->NeumannBoundariesLocal) {
436     IS is;
437 
438     if (fl2g) {
439       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_MASK,pcbddc->NeumannBoundariesLocal,&is);CHKERRQ(ierr);
440     } else {
441       is = pcbddc->NeumannBoundariesLocal;
442     }
443     ierr = ISGetLocalSize(is,&cum);CHKERRQ(ierr);
444     ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
445     for (i=0;i<cum;i++) {
446       if (idxs[i] >= 0) {
447         ierr = PetscBTSet(btb,idxs[i]);CHKERRQ(ierr);
448       }
449     }
450     ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
451     if (fl2g) {
452       ierr = ISDestroy(&is);CHKERRQ(ierr);
453     }
454   }
455 
456   /* Count neighs per dof */
457   ierr = ISLocalToGlobalMappingGetNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
458   ierr = ISLocalToGlobalMappingGetNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
459 
460   /* need to remove coarse faces' dofs and coarse edges' dirichlet dofs
461      for proper detection of coarse edges' endpoints */
462   ierr = PetscBTCreate(ne,&btee);CHKERRQ(ierr);
463   for (i=0;i<ne;i++) {
464     if ((ecount[i] > 2 && !PetscBTLookup(btbd,i)) || (ecount[i] == 2 && PetscBTLookup(btb,i))) {
465       ierr = PetscBTSet(btee,i);CHKERRQ(ierr);
466     }
467   }
468   ierr = PetscMalloc1(ne,&marks);CHKERRQ(ierr);
469   if (!conforming) {
470     ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
471     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
472   }
473   ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
474   ierr = MatSeqAIJGetArray(lGe,&vals);CHKERRQ(ierr);
475   cum  = 0;
476   for (i=0;i<ne;i++) {
477     /* eliminate rows corresponding to edge dofs belonging to coarse faces */
478     if (!PetscBTLookup(btee,i)) {
479       marks[cum++] = i;
480       continue;
481     }
482     /* set badly connected edge dofs as primal */
483     if (!conforming) {
484       if (ii[i+1]-ii[i] != order + 1) { /* every row of G on the coarse edge should list order+1 nodal dofs */
485         marks[cum++] = i;
486         ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
487         for (j=ii[i];j<ii[i+1];j++) {
488           ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
489         }
490       } else {
491         /* every edge dofs should be connected trough a certain number of nodal dofs
492            to other edge dofs belonging to coarse edges
493            - at most 2 endpoints
494            - order-1 interior nodal dofs
495            - no undefined nodal dofs (nconn < order)
496         */
497         PetscInt ends = 0,ints = 0, undef = 0;
498         for (j=ii[i];j<ii[i+1];j++) {
499           PetscInt v = jj[j],k;
500           PetscInt nconn = iit[v+1]-iit[v];
501           for (k=iit[v];k<iit[v+1];k++) if (!PetscBTLookup(btee,jjt[k])) nconn--;
502           if (nconn > order) ends++;
503           else if (nconn == order) ints++;
504           else undef++;
505         }
506         if (undef || ends > 2 || ints != order -1) {
507           marks[cum++] = i;
508           ierr = PetscBTSet(bte,i);CHKERRQ(ierr);
509           for (j=ii[i];j<ii[i+1];j++) {
510             ierr = PetscBTSet(btv,jj[j]);CHKERRQ(ierr);
511           }
512         }
513       }
514     }
515     /* We assume the order on the element edge is ii[i+1]-ii[i]-1 */
516     if (!order && ii[i+1] != ii[i]) {
517       PetscScalar val = 1./(ii[i+1]-ii[i]-1);
518       for (j=ii[i];j<ii[i+1];j++) vals[j] = val;
519     }
520   }
521   ierr = PetscBTDestroy(&btee);CHKERRQ(ierr);
522   ierr = MatSeqAIJRestoreArray(lGe,&vals);CHKERRQ(ierr);
523   ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
524   if (!conforming) {
525     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
526     ierr = MatDestroy(&lGt);CHKERRQ(ierr);
527   }
528   ierr = MatZeroRows(lGe,cum,marks,0.,NULL,NULL);CHKERRQ(ierr);
529 
530   /* identify splitpoints and corner candidates */
531   ierr = MatTranspose(lGe,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
532   if (print) {
533     ierr = PetscObjectSetName((PetscObject)lGe,"edgerestr_lG");CHKERRQ(ierr);
534     ierr = MatView(lGe,NULL);CHKERRQ(ierr);
535     ierr = PetscObjectSetName((PetscObject)lGt,"edgerestr_lGt");CHKERRQ(ierr);
536     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
537   }
538   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
539   ierr = MatSeqAIJGetArray(lGt,&vals);CHKERRQ(ierr);
540   for (i=0;i<nv;i++) {
541     PetscInt  ord = order, test = ii[i+1]-ii[i], vc = vcount[i];
542     PetscBool sneighs = PETSC_TRUE, bdir = PETSC_FALSE;
543     if (!order) { /* variable order */
544       PetscReal vorder = 0.;
545 
546       for (j=ii[i];j<ii[i+1];j++) vorder += PetscRealPart(vals[j]);
547       test = PetscFloorReal(vorder+10.*PETSC_SQRT_MACHINE_EPSILON);
548       if (vorder-test > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected value for vorder: %g (%d)",vorder,test);
549       ord  = 1;
550     }
551 #if defined(PETSC_USE_DEBUG)
552     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);
553 #endif
554     for (j=ii[i];j<ii[i+1] && sneighs;j++) {
555       if (PetscBTLookup(btbd,jj[j])) {
556         bdir = PETSC_TRUE;
557         break;
558       }
559       if (vc != ecount[jj[j]]) {
560         sneighs = PETSC_FALSE;
561       } else {
562         PetscInt k,*vn = vneighs[i], *en = eneighs[jj[j]];
563         for (k=0;k<vc;k++) {
564           if (vn[k] != en[k]) {
565             sneighs = PETSC_FALSE;
566             break;
567           }
568         }
569       }
570     }
571     if (!sneighs || test >= 3*ord || bdir) { /* splitpoints */
572       if (print) PetscPrintf(PETSC_COMM_SELF,"SPLITPOINT %d (%d %d %d)\n",i,!sneighs,test >= 3*ord,bdir);
573       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
574     } else if (test == ord) {
575       if (order == 1 || (!order && ii[i+1]-ii[i] == 1)) {
576         if (print) PetscPrintf(PETSC_COMM_SELF,"ENDPOINT %d\n",i);
577         ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
578       } else {
579         if (print) PetscPrintf(PETSC_COMM_SELF,"CORNER CANDIDATE %d\n",i);
580         ierr = PetscBTSet(btvcand,i);CHKERRQ(ierr);
581       }
582     }
583   }
584   ierr = ISLocalToGlobalMappingRestoreNodeInfo(el2g,NULL,&ecount,&eneighs);CHKERRQ(ierr);
585   ierr = ISLocalToGlobalMappingRestoreNodeInfo(vl2g,NULL,&vcount,&vneighs);CHKERRQ(ierr);
586   ierr = PetscBTDestroy(&btbd);CHKERRQ(ierr);
587 
588   /* a candidate is valid if it is connected to another candidate via a non-primal edge dof */
589   if (order != 1) {
590     if (print) PetscPrintf(PETSC_COMM_SELF,"INSPECTING CANDIDATES\n");
591     ierr = MatGetRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
592     for (i=0;i<nv;i++) {
593       if (PetscBTLookup(btvcand,i)) {
594         PetscBool found = PETSC_FALSE;
595         for (j=ii[i];j<ii[i+1] && !found;j++) {
596           PetscInt k,e = jj[j];
597           if (PetscBTLookup(bte,e)) continue;
598           for (k=iit[e];k<iit[e+1];k++) {
599             PetscInt v = jjt[k];
600             if (v != i && PetscBTLookup(btvcand,v)) {
601               found = PETSC_TRUE;
602               break;
603             }
604           }
605         }
606         if (!found) {
607           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d CLEARED\n",i);
608           ierr = PetscBTClear(btvcand,i);CHKERRQ(ierr);
609         } else {
610           if (print) PetscPrintf(PETSC_COMM_SELF,"  CANDIDATE %d ACCEPTED\n",i);
611         }
612       }
613     }
614     ierr = MatRestoreRowIJ(lGe,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
615   }
616   ierr = MatSeqAIJRestoreArray(lGt,&vals);CHKERRQ(ierr);
617   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
618   ierr = MatDestroy(&lGe);CHKERRQ(ierr);
619 
620   /* Get the local G^T explicitly */
621   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
622   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
623   ierr = MatSetOption(lGt,MAT_KEEP_NONZERO_PATTERN,PETSC_FALSE);CHKERRQ(ierr);
624 
625   /* Mark interior nodal dofs */
626   ierr = ISLocalToGlobalMappingGetInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
627   ierr = PetscBTCreate(nv,&btvi);CHKERRQ(ierr);
628   for (i=1;i<n_neigh;i++) {
629     for (j=0;j<n_shared[i];j++) {
630       ierr = PetscBTSet(btvi,shared[i][j]);CHKERRQ(ierr);
631     }
632   }
633   ierr = ISLocalToGlobalMappingRestoreInfo(vl2g,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
634 
635   /* communicate corners and splitpoints */
636   ierr = PetscMalloc1(nv,&vmarks);CHKERRQ(ierr);
637   ierr = PetscMemzero(sfvleaves,nv*sizeof(PetscInt));CHKERRQ(ierr);
638   ierr = PetscMemzero(sfvroots,Lv*sizeof(PetscInt));CHKERRQ(ierr);
639   for (i=0;i<nv;i++) if (PetscUnlikely(PetscBTLookup(btv,i))) sfvleaves[i] = 1;
640 
641   if (print) {
642     IS tbz;
643 
644     cum = 0;
645     for (i=0;i<nv;i++)
646       if (sfvleaves[i])
647         vmarks[cum++] = i;
648 
649     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
650     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_local");CHKERRQ(ierr);
651     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
652     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
653   }
654 
655   ierr = PetscSFReduceBegin(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
656   ierr = PetscSFReduceEnd(sfv,MPIU_INT,sfvleaves,sfvroots,MPI_SUM);CHKERRQ(ierr);
657   ierr = PetscSFBcastBegin(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
658   ierr = PetscSFBcastEnd(sfv,MPIU_INT,sfvroots,sfvleaves);CHKERRQ(ierr);
659 
660   /* Zero rows of lGt corresponding to identified corners
661      and interior nodal dofs */
662   cum = 0;
663   for (i=0;i<nv;i++) {
664     if (sfvleaves[i]) {
665       vmarks[cum++] = i;
666       ierr = PetscBTSet(btv,i);CHKERRQ(ierr);
667     }
668     if (!PetscBTLookup(btvi,i)) vmarks[cum++] = i;
669   }
670   ierr = PetscBTDestroy(&btvi);CHKERRQ(ierr);
671   if (print) {
672     IS tbz;
673 
674     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,vmarks,PETSC_COPY_VALUES,&tbz);CHKERRQ(ierr);
675     ierr = PetscObjectSetName((PetscObject)tbz,"corners_to_be_zeroed_with_interior");CHKERRQ(ierr);
676     ierr = ISView(tbz,NULL);CHKERRQ(ierr);
677     ierr = ISDestroy(&tbz);CHKERRQ(ierr);
678   }
679   ierr = MatZeroRows(lGt,cum,vmarks,0.,NULL,NULL);CHKERRQ(ierr);
680   ierr = PetscFree(vmarks);CHKERRQ(ierr);
681   ierr = PetscSFDestroy(&sfv);CHKERRQ(ierr);
682   ierr = PetscFree2(sfvleaves,sfvroots);CHKERRQ(ierr);
683 
684   /* Recompute G */
685   ierr = MatDestroy(&lG);CHKERRQ(ierr);
686   ierr = MatTranspose(lGt,MAT_INITIAL_MATRIX,&lG);CHKERRQ(ierr);
687   if (print) {
688     ierr = PetscObjectSetName((PetscObject)lG,"used_lG");CHKERRQ(ierr);
689     ierr = MatView(lG,NULL);CHKERRQ(ierr);
690     ierr = PetscObjectSetName((PetscObject)lGt,"used_lGt");CHKERRQ(ierr);
691     ierr = MatView(lGt,NULL);CHKERRQ(ierr);
692   }
693 
694   /* Get primal dofs (if any) */
695   cum = 0;
696   for (i=0;i<ne;i++) {
697     if (PetscUnlikely(PetscBTLookup(bte,i))) marks[cum++] = i;
698   }
699   if (fl2g) {
700     ierr = ISLocalToGlobalMappingApply(fl2g,cum,marks,marks);CHKERRQ(ierr);
701   }
702   ierr = ISCreateGeneral(comm,cum,marks,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
703   if (print) {
704     ierr = PetscObjectSetName((PetscObject)primals,"prescribed_primal_dofs");CHKERRQ(ierr);
705     ierr = ISView(primals,NULL);CHKERRQ(ierr);
706   }
707   ierr = PetscBTDestroy(&bte);CHKERRQ(ierr);
708   /* TODO: what if the user passed in some of them ?  */
709   ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
710   ierr = ISDestroy(&primals);CHKERRQ(ierr);
711 
712   /* Compute edge connectivity */
713   ierr = PetscObjectSetOptionsPrefix((PetscObject)lG,"econn_");CHKERRQ(ierr);
714   ierr = MatMatMultSymbolic(lG,lGt,PETSC_DEFAULT,&conn);CHKERRQ(ierr);
715   ierr = MatGetRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
716   if (fl2g) {
717     PetscBT   btf;
718     PetscInt  *iia,*jja,*iiu,*jju;
719     PetscBool rest = PETSC_FALSE,free = PETSC_FALSE;
720 
721     /* create CSR for all local dofs */
722     ierr = PetscMalloc1(n+1,&iia);CHKERRQ(ierr);
723     if (pcbddc->mat_graph->nvtxs_csr) { /* the user has passed in a CSR graph */
724       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);
725       iiu = pcbddc->mat_graph->xadj;
726       jju = pcbddc->mat_graph->adjncy;
727     } else if (pcbddc->use_local_adj) {
728       rest = PETSC_TRUE;
729       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
730     } else {
731       free   = PETSC_TRUE;
732       ierr   = PetscMalloc2(n+1,&iiu,n,&jju);CHKERRQ(ierr);
733       iiu[0] = 0;
734       for (i=0;i<n;i++) {
735         iiu[i+1] = i+1;
736         jju[i]   = -1;
737       }
738     }
739 
740     /* import sizes of CSR */
741     iia[0] = 0;
742     for (i=0;i<n;i++) iia[i+1] = iiu[i+1]-iiu[i];
743 
744     /* overwrite entries corresponding to the Nedelec field */
745     ierr = PetscBTCreate(n,&btf);CHKERRQ(ierr);
746     ierr = ISGetIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
747     for (i=0;i<ne;i++) {
748       ierr = PetscBTSet(btf,idxs[i]);CHKERRQ(ierr);
749       iia[idxs[i]+1] = ii[i+1]-ii[i];
750     }
751 
752     /* iia in CSR */
753     for (i=0;i<n;i++) iia[i+1] += iia[i];
754 
755     /* jja in CSR */
756     ierr = PetscMalloc1(iia[n],&jja);CHKERRQ(ierr);
757     for (i=0;i<n;i++)
758       if (!PetscBTLookup(btf,i))
759         for (j=0;j<iiu[i+1]-iiu[i];j++)
760           jja[iia[i]+j] = jju[iiu[i]+j];
761 
762     /* map edge dofs connectivity */
763     if (jj) {
764       ierr = ISLocalToGlobalMappingApply(fl2g,ii[ne],jj,(PetscInt *)jj);CHKERRQ(ierr);
765       for (i=0;i<ne;i++) {
766         PetscInt e = idxs[i];
767         for (j=0;j<ii[i+1]-ii[i];j++) jja[iia[e]+j] = jj[ii[i]+j];
768       }
769     }
770     ierr = ISRestoreIndices(nedfieldlocal,&idxs);CHKERRQ(ierr);
771     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,iia,jja,PETSC_OWN_POINTER);CHKERRQ(ierr);
772     if (rest) {
773       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&i,(const PetscInt**)&iiu,(const PetscInt**)&jju,&done);CHKERRQ(ierr);
774     }
775     if (free) {
776       ierr = PetscFree2(iiu,jju);CHKERRQ(ierr);
777     }
778     ierr = PetscBTDestroy(&btf);CHKERRQ(ierr);
779   } else {
780     ierr = PCBDDCSetLocalAdjacencyGraph(pc,n,ii,jj,PETSC_USE_POINTER);CHKERRQ(ierr);
781   }
782 
783   /* Analyze interface for edge dofs */
784   ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
785   pcbddc->mat_graph->twodim = PETSC_FALSE;
786 
787   /* Get coarse edges in the edge space */
788   ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
789   ierr = MatRestoreRowIJ(conn,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
790 
791   if (fl2g) {
792     ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
793     ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
794     for (i=0;i<nee;i++) {
795       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
796     }
797   } else {
798     eedges  = alleedges;
799     primals = allprimals;
800   }
801 
802   /* Mark fine edge dofs with their coarse edge id */
803   ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
804   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
805   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
806   for (i=0;i<cum;i++) marks[idxs[i]] = nee+1;
807   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
808   if (print) {
809     ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs");CHKERRQ(ierr);
810     ierr = ISView(primals,NULL);CHKERRQ(ierr);
811   }
812 
813   maxsize = 0;
814   for (i=0;i<nee;i++) {
815     PetscInt size,mark = i+1;
816 
817     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
818     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
819     for (j=0;j<size;j++) marks[idxs[j]] = mark;
820     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
821     maxsize = PetscMax(maxsize,size);
822   }
823 
824   /* Find coarse edge endpoints */
825   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
826   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
827   for (i=0;i<nee;i++) {
828     PetscInt mark = i+1,size;
829 
830     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
831     if (!size && nedfieldlocal) continue;
832     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
833     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
834     if (print) {
835       PetscPrintf(PETSC_COMM_SELF,"ENDPOINTS ANALYSIS EDGE %d\n",i);
836       ISView(eedges[i],NULL);
837     }
838     for (j=0;j<size;j++) {
839       PetscInt k, ee = idxs[j];
840       if (print) PetscPrintf(PETSC_COMM_SELF,"  idx %d\n",ee);
841       for (k=ii[ee];k<ii[ee+1];k++) {
842         if (print) PetscPrintf(PETSC_COMM_SELF,"    inspect %d\n",jj[k]);
843         if (PetscBTLookup(btv,jj[k])) {
844           if (print) PetscPrintf(PETSC_COMM_SELF,"      corner found (already set) %d\n",jj[k]);
845         } else if (PetscBTLookup(btvcand,jj[k])) { /* is it ok? */
846           PetscInt  k2;
847           PetscBool corner = PETSC_FALSE;
848           for (k2 = iit[jj[k]];k2 < iit[jj[k]+1];k2++) {
849             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]));
850             /* it's a corner if either is connected with an edge dof belonging to a different cc or
851                if the edge dof lie on the natural part of the boundary */
852             if ((marks[jjt[k2]] && marks[jjt[k2]] != mark) || (!marks[jjt[k2]] && PetscBTLookup(btb,jjt[k2]))) {
853               corner = PETSC_TRUE;
854               break;
855             }
856           }
857           if (corner) { /* found the nodal dof corresponding to the endpoint of the edge */
858             if (print) PetscPrintf(PETSC_COMM_SELF,"        corner found %d\n",jj[k]);
859             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
860           } else {
861             if (print) PetscPrintf(PETSC_COMM_SELF,"        no corners found\n");
862           }
863         }
864       }
865     }
866     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
867   }
868   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
869   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
870   ierr = PetscBTDestroy(&btb);CHKERRQ(ierr);
871 
872   /* Reset marked primal dofs */
873   ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
874   ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
875   for (i=0;i<cum;i++) marks[idxs[i]] = 0;
876   ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
877 
878   /* Now use the initial lG */
879   ierr = MatDestroy(&lG);CHKERRQ(ierr);
880   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
881   lG   = lGinit;
882   ierr = MatTranspose(lG,MAT_INITIAL_MATRIX,&lGt);CHKERRQ(ierr);
883 
884   /* Compute extended cols indices */
885   ierr = PetscBTCreate(nv,&btvc);CHKERRQ(ierr);
886   ierr = PetscBTCreate(nee,&bter);CHKERRQ(ierr);
887   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
888   ierr = MatSeqAIJGetMaxRowNonzeros(lG,&i);CHKERRQ(ierr);
889   i   *= maxsize;
890   ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
891   ierr = PetscMalloc2(i,&extrow,i,&gidxs);CHKERRQ(ierr);
892   eerr = PETSC_FALSE;
893   for (i=0;i<nee;i++) {
894     PetscInt size,found = 0;
895 
896     cum  = 0;
897     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
898     if (!size && nedfieldlocal) continue;
899     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
900     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
901     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
902     for (j=0;j<size;j++) {
903       PetscInt k,ee = idxs[j];
904       for (k=ii[ee];k<ii[ee+1];k++) {
905         PetscInt vv = jj[k];
906         if (!PetscBTLookup(btv,vv)) extrow[cum++] = vv;
907         else if (!PetscBTLookupSet(btvc,vv)) found++;
908       }
909     }
910     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
911     ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
912     ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
913     ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
914     ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
915     /* it may happen that endpoints are not defined at this point
916        if it is the case, mark this edge for a second pass */
917     if (cum != size -1 || found != 2) {
918       ierr = PetscBTSet(bter,i);CHKERRQ(ierr);
919       if (print) {
920         ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge");CHKERRQ(ierr);
921         ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
922         ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol");CHKERRQ(ierr);
923         ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
924       }
925       eerr = PETSC_TRUE;
926     }
927   }
928   /* if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL FIRST PASS"); */
929   ierr = MPIU_Allreduce(&eerr,&done,1,MPIU_BOOL,MPI_LOR,comm);CHKERRQ(ierr);
930   if (done) {
931     PetscInt *newprimals;
932 
933     ierr = PetscMalloc1(ne,&newprimals);CHKERRQ(ierr);
934     ierr = ISGetLocalSize(primals,&cum);CHKERRQ(ierr);
935     ierr = ISGetIndices(primals,&idxs);CHKERRQ(ierr);
936     ierr = PetscMemcpy(newprimals,idxs,cum*sizeof(PetscInt));CHKERRQ(ierr);
937     ierr = ISRestoreIndices(primals,&idxs);CHKERRQ(ierr);
938     ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
939     if (print) PetscPrintf(PETSC_COMM_SELF,"DOING SECOND PASS (eerr %d)\n",eerr);
940     for (i=0;i<nee;i++) {
941       PetscBool has_candidates = PETSC_FALSE;
942       if (PetscBTLookup(bter,i)) {
943         PetscInt size,mark = i+1;
944 
945         ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
946         ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
947         /* for (j=0;j<size;j++) newprimals[cum++] = idxs[j]; */
948         for (j=0;j<size;j++) {
949           PetscInt k,ee = idxs[j];
950           if (print) PetscPrintf(PETSC_COMM_SELF,"Inspecting edge dof %d [%d %d)\n",ee,ii[ee],ii[ee+1]);
951           for (k=ii[ee];k<ii[ee+1];k++) {
952             /* set all candidates located on the edge as corners */
953             if (PetscBTLookup(btvcand,jj[k])) {
954               PetscInt k2,vv = jj[k];
955               has_candidates = PETSC_TRUE;
956               if (print) PetscPrintf(PETSC_COMM_SELF,"  Candidate set to vertex %d\n",vv);
957               ierr = PetscBTSet(btv,vv);CHKERRQ(ierr);
958               /* set all edge dofs connected to candidate as primals */
959               for (k2=iit[vv];k2<iit[vv+1];k2++) {
960                 if (marks[jjt[k2]] == mark) {
961                   PetscInt k3,ee2 = jjt[k2];
962                   if (print) PetscPrintf(PETSC_COMM_SELF,"    Connected edge dof set to primal %d\n",ee2);
963                   newprimals[cum++] = ee2;
964                   /* finally set the new corners */
965                   for (k3=ii[ee2];k3<ii[ee2+1];k3++) {
966                     if (print) PetscPrintf(PETSC_COMM_SELF,"      Connected nodal dof set to vertex %d\n",jj[k3]);
967                     ierr = PetscBTSet(btv,jj[k3]);CHKERRQ(ierr);
968                   }
969                 }
970               }
971             } else {
972               if (print) PetscPrintf(PETSC_COMM_SELF,"  Not a candidate vertex %d\n",jj[k]);
973             }
974           }
975         }
976         if (!has_candidates) { /* circular edge */
977           PetscInt k, ee = idxs[0],*tmarks;
978 
979           ierr = PetscCalloc1(ne,&tmarks);CHKERRQ(ierr);
980           if (print) PetscPrintf(PETSC_COMM_SELF,"  Circular edge %d\n",i);
981           for (k=ii[ee];k<ii[ee+1];k++) {
982             PetscInt k2;
983             if (print) PetscPrintf(PETSC_COMM_SELF,"    Set to corner %d\n",jj[k]);
984             ierr = PetscBTSet(btv,jj[k]);CHKERRQ(ierr);
985             for (k2=iit[jj[k]];k2<iit[jj[k]+1];k2++) tmarks[jjt[k2]]++;
986           }
987           for (j=0;j<size;j++) {
988             if (tmarks[idxs[j]] > 1) {
989               if (print) PetscPrintf(PETSC_COMM_SELF,"  Edge dof set to primal %d\n",idxs[j]);
990               newprimals[cum++] = idxs[j];
991             }
992           }
993           ierr = PetscFree(tmarks);CHKERRQ(ierr);
994         }
995         ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
996       }
997       ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
998     }
999     ierr = PetscFree(extcols);CHKERRQ(ierr);
1000     ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&iit,&jjt,&done);CHKERRQ(ierr);
1001     ierr = PetscSortRemoveDupsInt(&cum,newprimals);CHKERRQ(ierr);
1002     if (fl2g) {
1003       ierr = ISLocalToGlobalMappingApply(fl2g,cum,newprimals,newprimals);CHKERRQ(ierr);
1004       ierr = ISDestroy(&primals);CHKERRQ(ierr);
1005       for (i=0;i<nee;i++) {
1006         ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1007       }
1008       ierr = PetscFree(eedges);CHKERRQ(ierr);
1009     }
1010     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1011     ierr = ISCreateGeneral(comm,cum,newprimals,PETSC_COPY_VALUES,&primals);CHKERRQ(ierr);
1012     ierr = PetscFree(newprimals);CHKERRQ(ierr);
1013     ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primals);CHKERRQ(ierr);
1014     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1015     ierr = PCBDDCAnalyzeInterface(pc);CHKERRQ(ierr);
1016     pcbddc->mat_graph->twodim = PETSC_FALSE;
1017     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1018     if (fl2g) {
1019       ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,allprimals,&primals);CHKERRQ(ierr);
1020       ierr = PetscMalloc1(nee,&eedges);CHKERRQ(ierr);
1021       for (i=0;i<nee;i++) {
1022         ierr = ISGlobalToLocalMappingApplyIS(fl2g,IS_GTOLM_DROP,alleedges[i],&eedges[i]);CHKERRQ(ierr);
1023       }
1024     } else {
1025       eedges  = alleedges;
1026       primals = allprimals;
1027     }
1028     ierr = PetscCalloc1(nee,&extcols);CHKERRQ(ierr);
1029 
1030     /* Mark again */
1031     ierr = PetscMemzero(marks,ne*sizeof(PetscInt));CHKERRQ(ierr);
1032     for (i=0;i<nee;i++) {
1033       PetscInt size,mark = i+1;
1034 
1035       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1036       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1037       for (j=0;j<size;j++) marks[idxs[j]] = mark;
1038       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1039     }
1040     if (print) {
1041       ierr = PetscObjectSetName((PetscObject)primals,"obtained_primal_dofs_secondpass");CHKERRQ(ierr);
1042       ierr = ISView(primals,NULL);CHKERRQ(ierr);
1043     }
1044 
1045     /* Recompute extended cols */
1046     eerr = PETSC_FALSE;
1047     for (i=0;i<nee;i++) {
1048       PetscInt size;
1049 
1050       cum  = 0;
1051       ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1052       if (!size && nedfieldlocal) continue;
1053       if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1054       ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1055       for (j=0;j<size;j++) {
1056         PetscInt k,ee = idxs[j];
1057         for (k=ii[ee];k<ii[ee+1];k++) if (!PetscBTLookup(btv,jj[k])) extrow[cum++] = jj[k];
1058       }
1059       ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1060       ierr = PetscSortRemoveDupsInt(&cum,extrow);CHKERRQ(ierr);
1061       ierr = ISLocalToGlobalMappingApply(vl2g,cum,extrow,gidxs);CHKERRQ(ierr);
1062       ierr = PetscSortIntWithArray(cum,gidxs,extrow);CHKERRQ(ierr);
1063       ierr = ISCreateGeneral(PETSC_COMM_SELF,cum,extrow,PETSC_COPY_VALUES,&extcols[i]);CHKERRQ(ierr);
1064       if (cum != size -1) {
1065         if (print) {
1066           ierr = PetscObjectSetName((PetscObject)eedges[i],"error_edge_secondpass");CHKERRQ(ierr);
1067           ierr = ISView(eedges[i],NULL);CHKERRQ(ierr);
1068           ierr = PetscObjectSetName((PetscObject)extcols[i],"error_extcol_secondpass");CHKERRQ(ierr);
1069           ierr = ISView(extcols[i],NULL);CHKERRQ(ierr);
1070         }
1071         eerr = PETSC_TRUE;
1072       }
1073     }
1074   }
1075   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1076   ierr = PetscFree2(extrow,gidxs);CHKERRQ(ierr);
1077   ierr = PetscBTDestroy(&bter);CHKERRQ(ierr);
1078   if (print) { ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,5,PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr); }
1079   /* an error should not occur at this point */
1080   if (eerr) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected SIZE OF EDGE > EXTCOL SECOND PASS");
1081 
1082   /* Check the number of endpoints */
1083   ierr = MatGetRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1084   ierr = PetscMalloc1(2*nee,&corners);CHKERRQ(ierr);
1085   ierr = PetscMalloc1(nee,&cedges);CHKERRQ(ierr);
1086   for (i=0;i<nee;i++) {
1087     PetscInt size, found = 0, gc[2];
1088 
1089     /* init with defaults */
1090     cedges[i] = corners[i*2] = corners[i*2+1] = -1;
1091     ierr = ISGetLocalSize(eedges[i],&size);CHKERRQ(ierr);
1092     if (!size && nedfieldlocal) continue;
1093     if (!size) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Unexpected zero sized edge %d",i);
1094     ierr = ISGetIndices(eedges[i],&idxs);CHKERRQ(ierr);
1095     ierr = PetscBTMemzero(nv,btvc);CHKERRQ(ierr);
1096     for (j=0;j<size;j++) {
1097       PetscInt k,ee = idxs[j];
1098       for (k=ii[ee];k<ii[ee+1];k++) {
1099         PetscInt vv = jj[k];
1100         if (PetscBTLookup(btv,vv) && !PetscBTLookupSet(btvc,vv)) {
1101           if (found == 2) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found more then two corners for edge %d\n",i);
1102           corners[i*2+found++] = vv;
1103         }
1104       }
1105     }
1106     if (found != 2) {
1107       PetscInt e;
1108       if (fl2g) {
1109         ierr = ISLocalToGlobalMappingApply(fl2g,1,idxs,&e);CHKERRQ(ierr);
1110       } else {
1111         e = idxs[0];
1112       }
1113       SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Found %d corners for edge %d (astart %d, estart %d)\n",found,i,e,idxs[0]);
1114     }
1115 
1116     /* get primal dof index on this coarse edge */
1117     ierr = ISLocalToGlobalMappingApply(vl2g,2,corners+2*i,gc);CHKERRQ(ierr);
1118     if (gc[0] > gc[1]) {
1119       PetscInt swap  = corners[2*i];
1120       corners[2*i]   = corners[2*i+1];
1121       corners[2*i+1] = swap;
1122     }
1123     cedges[i] = idxs[size-1];
1124     ierr = ISRestoreIndices(eedges[i],&idxs);CHKERRQ(ierr);
1125     if (print) PetscPrintf(PETSC_COMM_SELF,"EDGE %d: ce %d, corners (%d,%d)\n",i,cedges[i],corners[2*i],corners[2*i+1]);
1126   }
1127   ierr = MatRestoreRowIJ(lG,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1128   ierr = PetscBTDestroy(&btvc);CHKERRQ(ierr);
1129 
1130 #if defined(PETSC_USE_DEBUG)
1131   /* Inspects columns of lG (rows of lGt) and make sure the change of basis will
1132      not interfere with neighbouring coarse edges */
1133   ierr = PetscMalloc1(nee+1,&emarks);CHKERRQ(ierr);
1134   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1135   for (i=0;i<nv;i++) {
1136     PetscInt emax = 0,eemax = 0;
1137 
1138     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1139     ierr = PetscMemzero(emarks,(nee+1)*sizeof(PetscInt));CHKERRQ(ierr);
1140     for (j=ii[i];j<ii[i+1];j++) emarks[marks[jj[j]]]++;
1141     for (j=1;j<nee+1;j++) {
1142       if (emax < emarks[j]) {
1143         emax = emarks[j];
1144         eemax = j;
1145       }
1146     }
1147     /* not relevant for edges */
1148     if (!eemax) continue;
1149 
1150     for (j=ii[i];j<ii[i+1];j++) {
1151       if (marks[jj[j]] && marks[jj[j]] != eemax) {
1152         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]);
1153       }
1154     }
1155   }
1156   ierr = PetscFree(emarks);CHKERRQ(ierr);
1157   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1158 #endif
1159 
1160   /* Compute extended rows indices for edge blocks of the change of basis */
1161   ierr = MatGetRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1162   ierr = MatSeqAIJGetMaxRowNonzeros(lGt,&extmem);CHKERRQ(ierr);
1163   extmem *= maxsize;
1164   ierr = PetscMalloc1(extmem*nee,&extrow);CHKERRQ(ierr);
1165   ierr = PetscMalloc1(nee,&extrows);CHKERRQ(ierr);
1166   ierr = PetscCalloc1(nee,&extrowcum);CHKERRQ(ierr);
1167   for (i=0;i<nv;i++) {
1168     PetscInt mark = 0,size,start;
1169 
1170     if (ii[i+1]==ii[i] || PetscBTLookup(btv,i)) continue;
1171     for (j=ii[i];j<ii[i+1];j++)
1172       if (marks[jj[j]] && !mark)
1173         mark = marks[jj[j]];
1174 
1175     /* not relevant */
1176     if (!mark) continue;
1177 
1178     /* import extended row */
1179     mark--;
1180     start = mark*extmem+extrowcum[mark];
1181     size = ii[i+1]-ii[i];
1182     if (extrowcum[mark] + size > extmem) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Not enough memory allocated %d > %d",extrowcum[mark] + size,extmem);
1183     ierr = PetscMemcpy(extrow+start,jj+ii[i],size*sizeof(PetscInt));CHKERRQ(ierr);
1184     extrowcum[mark] += size;
1185   }
1186   ierr = MatRestoreRowIJ(lGt,0,PETSC_FALSE,PETSC_FALSE,&i,&ii,&jj,&done);CHKERRQ(ierr);
1187   ierr = MatDestroy(&lGt);CHKERRQ(ierr);
1188   ierr = PetscFree(marks);CHKERRQ(ierr);
1189 
1190   /* Compress extrows */
1191   cum  = 0;
1192   for (i=0;i<nee;i++) {
1193     PetscInt size = extrowcum[i],*start = extrow + i*extmem;
1194     ierr = PetscSortRemoveDupsInt(&size,start);CHKERRQ(ierr);
1195     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,start,PETSC_USE_POINTER,&extrows[i]);CHKERRQ(ierr);
1196     cum  = PetscMax(cum,size);
1197   }
1198   ierr = PetscFree(extrowcum);CHKERRQ(ierr);
1199   ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
1200   ierr = PetscBTDestroy(&btvcand);CHKERRQ(ierr);
1201 
1202   /* Workspace for lapack inner calls and VecSetValues */
1203   ierr = PetscMalloc2((5+cum+maxsize)*maxsize,&work,maxsize,&rwork);CHKERRQ(ierr);
1204 
1205   /* Create change of basis matrix (preallocation can be improved) */
1206   ierr = MatCreate(comm,&T);CHKERRQ(ierr);
1207   ierr = MatSetSizes(T,pc->pmat->rmap->n,pc->pmat->rmap->n,
1208                        pc->pmat->rmap->N,pc->pmat->rmap->N);CHKERRQ(ierr);
1209   ierr = MatSetType(T,MATAIJ);CHKERRQ(ierr);
1210   ierr = MatSeqAIJSetPreallocation(T,10,NULL);CHKERRQ(ierr);
1211   ierr = MatMPIAIJSetPreallocation(T,10,NULL,10,NULL);CHKERRQ(ierr);
1212   ierr = MatSetLocalToGlobalMapping(T,al2g,al2g);CHKERRQ(ierr);
1213   ierr = MatSetOption(T,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
1214   ierr = MatSetOption(T,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
1215   ierr = ISLocalToGlobalMappingDestroy(&al2g);CHKERRQ(ierr);
1216 
1217   /* Defaults to identity */
1218   ierr = MatCreateVecs(pc->pmat,&tvec,NULL);CHKERRQ(ierr);
1219   ierr = VecSet(tvec,1.0);CHKERRQ(ierr);
1220   ierr = MatDiagonalSet(T,tvec,INSERT_VALUES);CHKERRQ(ierr);
1221   ierr = VecDestroy(&tvec);CHKERRQ(ierr);
1222 
1223   /* Create discrete gradient for the coarser level if needed */
1224   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
1225   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
1226   if (pcbddc->current_level < pcbddc->max_levels) {
1227     ISLocalToGlobalMapping cel2g,cvl2g;
1228     IS                     wis,gwis;
1229     PetscInt               cnv,cne;
1230 
1231     ierr = ISCreateGeneral(comm,nee,cedges,PETSC_COPY_VALUES,&wis);CHKERRQ(ierr);
1232     if (fl2g) {
1233       ierr = ISLocalToGlobalMappingApplyIS(fl2g,wis,&pcbddc->nedclocal);CHKERRQ(ierr);
1234     } else {
1235       ierr = PetscObjectReference((PetscObject)wis);CHKERRQ(ierr);
1236       pcbddc->nedclocal = wis;
1237     }
1238     ierr = ISLocalToGlobalMappingApplyIS(el2g,wis,&gwis);CHKERRQ(ierr);
1239     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1240     ierr = ISRenumber(gwis,NULL,&cne,&wis);CHKERRQ(ierr);
1241     ierr = ISLocalToGlobalMappingCreateIS(wis,&cel2g);CHKERRQ(ierr);
1242     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1243     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1244 
1245     ierr = ISCreateGeneral(comm,2*nee,corners,PETSC_USE_POINTER,&wis);CHKERRQ(ierr);
1246     ierr = ISLocalToGlobalMappingApplyIS(vl2g,wis,&gwis);CHKERRQ(ierr);
1247     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1248     ierr = ISRenumber(gwis,NULL,&cnv,&wis);CHKERRQ(ierr);
1249     ierr = ISLocalToGlobalMappingCreateIS(wis,&cvl2g);CHKERRQ(ierr);
1250     ierr = ISDestroy(&wis);CHKERRQ(ierr);
1251     ierr = ISDestroy(&gwis);CHKERRQ(ierr);
1252 
1253     ierr = MatCreate(comm,&pcbddc->nedcG);CHKERRQ(ierr);
1254     ierr = MatSetSizes(pcbddc->nedcG,PETSC_DECIDE,PETSC_DECIDE,cne,cnv);CHKERRQ(ierr);
1255     ierr = MatSetType(pcbddc->nedcG,MATAIJ);CHKERRQ(ierr);
1256     ierr = MatSeqAIJSetPreallocation(pcbddc->nedcG,2,NULL);CHKERRQ(ierr);
1257     ierr = MatMPIAIJSetPreallocation(pcbddc->nedcG,2,NULL,2,NULL);CHKERRQ(ierr);
1258     ierr = MatSetLocalToGlobalMapping(pcbddc->nedcG,cel2g,cvl2g);CHKERRQ(ierr);
1259     ierr = ISLocalToGlobalMappingDestroy(&cel2g);CHKERRQ(ierr);
1260     ierr = ISLocalToGlobalMappingDestroy(&cvl2g);CHKERRQ(ierr);
1261   }
1262   ierr = ISLocalToGlobalMappingDestroy(&vl2g);CHKERRQ(ierr);
1263 
1264 #if defined(PRINT_GDET)
1265   inc = 0;
1266   lev = pcbddc->current_level;
1267 #endif
1268 
1269   /* Insert values in the change of basis matrix */
1270   for (i=0;i<nee;i++) {
1271     Mat         Gins = NULL, GKins = NULL;
1272     IS          cornersis = NULL;
1273     PetscScalar cvals[2];
1274 
1275     if (pcbddc->nedcG) {
1276       ierr = ISCreateGeneral(PETSC_COMM_SELF,2,corners+2*i,PETSC_USE_POINTER,&cornersis);CHKERRQ(ierr);
1277     }
1278     ierr = PCBDDCComputeNedelecChangeEdge(lG,eedges[i],extrows[i],extcols[i],cornersis,&Gins,&GKins,cvals,work,rwork);CHKERRQ(ierr);
1279     if (Gins && GKins) {
1280       PetscScalar    *data;
1281       const PetscInt *rows,*cols;
1282       PetscInt       nrh,nch,nrc,ncc;
1283 
1284       ierr = ISGetIndices(eedges[i],&cols);CHKERRQ(ierr);
1285       /* H1 */
1286       ierr = ISGetIndices(extrows[i],&rows);CHKERRQ(ierr);
1287       ierr = MatGetSize(Gins,&nrh,&nch);CHKERRQ(ierr);
1288       ierr = MatDenseGetArray(Gins,&data);CHKERRQ(ierr);
1289       ierr = MatSetValuesLocal(T,nrh,rows,nch,cols,data,INSERT_VALUES);CHKERRQ(ierr);
1290       ierr = MatDenseRestoreArray(Gins,&data);CHKERRQ(ierr);
1291       ierr = ISRestoreIndices(extrows[i],&rows);CHKERRQ(ierr);
1292       /* complement */
1293       ierr = MatGetSize(GKins,&nrc,&ncc);CHKERRQ(ierr);
1294       if (!ncc) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Constant function has not been generated for coarse edge %d",i);
1295       if (ncc + nch != nrc) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_PLIB,"The sum of the number of columns of GKins %d and Gins %d does not match %d for coarse edge %d",ncc,nch,nrc,i);
1296       if (ncc != 1 && pcbddc->nedcG) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot generate the coarse discrete gradient for coarse edge %d with ncc %d",i,ncc);
1297       ierr = MatDenseGetArray(GKins,&data);CHKERRQ(ierr);
1298       ierr = MatSetValuesLocal(T,nrc,cols,ncc,cols+nch,data,INSERT_VALUES);CHKERRQ(ierr);
1299       ierr = MatDenseRestoreArray(GKins,&data);CHKERRQ(ierr);
1300 
1301       /* coarse discrete gradient */
1302       if (pcbddc->nedcG) {
1303         PetscInt cols[2];
1304 
1305         cols[0] = 2*i;
1306         cols[1] = 2*i+1;
1307         ierr = MatSetValuesLocal(pcbddc->nedcG,1,&i,2,cols,cvals,INSERT_VALUES);CHKERRQ(ierr);
1308       }
1309       ierr = ISRestoreIndices(eedges[i],&cols);CHKERRQ(ierr);
1310     }
1311     ierr = ISDestroy(&extrows[i]);CHKERRQ(ierr);
1312     ierr = ISDestroy(&extcols[i]);CHKERRQ(ierr);
1313     ierr = ISDestroy(&cornersis);CHKERRQ(ierr);
1314     ierr = MatDestroy(&Gins);CHKERRQ(ierr);
1315     ierr = MatDestroy(&GKins);CHKERRQ(ierr);
1316   }
1317   ierr = ISLocalToGlobalMappingDestroy(&el2g);CHKERRQ(ierr);
1318 
1319   /* Start assembling */
1320   ierr = MatAssemblyBegin(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1321   if (pcbddc->nedcG) {
1322     ierr = MatAssemblyBegin(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1323   }
1324 
1325   /* Free */
1326   if (fl2g) {
1327     ierr = ISDestroy(&primals);CHKERRQ(ierr);
1328     for (i=0;i<nee;i++) {
1329       ierr = ISDestroy(&eedges[i]);CHKERRQ(ierr);
1330     }
1331     ierr = PetscFree(eedges);CHKERRQ(ierr);
1332   }
1333 
1334   /* hack mat_graph with primal dofs on the coarse edges */
1335   {
1336     PCBDDCGraph graph   = pcbddc->mat_graph;
1337     PetscInt    *oqueue = graph->queue;
1338     PetscInt    *ocptr  = graph->cptr;
1339     PetscInt    ncc,*idxs;
1340 
1341     /* find first primal edge */
1342     if (pcbddc->nedclocal) {
1343       ierr = ISGetIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1344     } else {
1345       if (fl2g) {
1346         ierr = ISLocalToGlobalMappingApply(fl2g,nee,cedges,cedges);CHKERRQ(ierr);
1347       }
1348       idxs = cedges;
1349     }
1350     cum = 0;
1351     while (cum < nee && cedges[cum] < 0) cum++;
1352 
1353     /* adapt connected components */
1354     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,ocptr[graph->ncc],&graph->queue);CHKERRQ(ierr);
1355     graph->cptr[0] = 0;
1356     for (i=0,ncc=0;i<graph->ncc;i++) {
1357       PetscInt lc = ocptr[i+1]-ocptr[i];
1358       if (cum != nee && oqueue[ocptr[i+1]-1] == cedges[cum]) { /* this cc has a primal dof */
1359         graph->cptr[ncc+1] = graph->cptr[ncc]+1;
1360         graph->queue[graph->cptr[ncc]] = cedges[cum];
1361         ncc++;
1362         lc--;
1363         cum++;
1364         while (cum < nee && cedges[cum] < 0) cum++;
1365       }
1366       graph->cptr[ncc+1] = graph->cptr[ncc] + lc;
1367       for (j=0;j<lc;j++) graph->queue[graph->cptr[ncc]+j] = oqueue[ocptr[i]+j];
1368       ncc++;
1369     }
1370     graph->ncc = ncc;
1371     if (pcbddc->nedclocal) {
1372       ierr = ISRestoreIndices(pcbddc->nedclocal,(const PetscInt**)&idxs);CHKERRQ(ierr);
1373     }
1374     ierr = PetscFree2(ocptr,oqueue);CHKERRQ(ierr);
1375   }
1376   ierr = ISLocalToGlobalMappingDestroy(&fl2g);CHKERRQ(ierr);
1377   ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,&nee,&alleedges,&allprimals);CHKERRQ(ierr);
1378   ierr = PCBDDCGraphResetCSR(pcbddc->mat_graph);CHKERRQ(ierr);
1379   ierr = MatDestroy(&conn);CHKERRQ(ierr);
1380 
1381   ierr = ISDestroy(&nedfieldlocal);CHKERRQ(ierr);
1382   ierr = PetscFree(extrow);CHKERRQ(ierr);
1383   ierr = PetscFree2(work,rwork);CHKERRQ(ierr);
1384   ierr = PetscFree(corners);CHKERRQ(ierr);
1385   ierr = PetscFree(cedges);CHKERRQ(ierr);
1386   ierr = PetscFree(extrows);CHKERRQ(ierr);
1387   ierr = PetscFree(extcols);CHKERRQ(ierr);
1388   ierr = MatDestroy(&lG);CHKERRQ(ierr);
1389 
1390   /* Complete assembling */
1391   ierr = MatAssemblyEnd(T,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1392   if (pcbddc->nedcG) {
1393     ierr = MatAssemblyEnd(pcbddc->nedcG,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
1394 #if 0
1395     ierr = PetscObjectSetName((PetscObject)pcbddc->nedcG,"coarse_G");CHKERRQ(ierr);
1396     ierr = MatView(pcbddc->nedcG,NULL);CHKERRQ(ierr);
1397 #endif
1398   }
1399 
1400   /* set change of basis */
1401   ierr = PCBDDCSetChangeOfBasisMat(pc,T,singular);CHKERRQ(ierr);
1402   ierr = MatDestroy(&T);CHKERRQ(ierr);
1403 
1404   PetscFunctionReturn(0);
1405 }
1406 
1407 /* the near-null space of BDDC carries information on quadrature weights,
1408    and these can be collinear -> so cheat with MatNullSpaceCreate
1409    and create a suitable set of basis vectors first */
1410 PetscErrorCode PCBDDCNullSpaceCreate(MPI_Comm comm, PetscBool has_const, PetscInt nvecs, Vec quad_vecs[], MatNullSpace *nnsp)
1411 {
1412   PetscErrorCode ierr;
1413   PetscInt       i;
1414 
1415   PetscFunctionBegin;
1416   for (i=0;i<nvecs;i++) {
1417     PetscInt first,last;
1418 
1419     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1420     if (last-first < 2*nvecs && has_const) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not implemented");
1421     if (i>=first && i < last) {
1422       PetscScalar *data;
1423       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1424       if (!has_const) {
1425         data[i-first] = 1.;
1426       } else {
1427         data[2*i-first] = 1./PetscSqrtReal(2.);
1428         data[2*i-first+1] = -1./PetscSqrtReal(2.);
1429       }
1430       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1431     }
1432     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1433   }
1434   ierr = MatNullSpaceCreate(comm,has_const,nvecs,quad_vecs,nnsp);CHKERRQ(ierr);
1435   for (i=0;i<nvecs;i++) { /* reset vectors */
1436     PetscInt first,last;
1437     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1438     ierr = VecGetOwnershipRange(quad_vecs[i],&first,&last);CHKERRQ(ierr);
1439     if (i>=first && i < last) {
1440       PetscScalar *data;
1441       ierr = VecGetArray(quad_vecs[i],&data);CHKERRQ(ierr);
1442       if (!has_const) {
1443         data[i-first] = 0.;
1444       } else {
1445         data[2*i-first] = 0.;
1446         data[2*i-first+1] = 0.;
1447       }
1448       ierr = VecRestoreArray(quad_vecs[i],&data);CHKERRQ(ierr);
1449     }
1450     ierr = PetscObjectStateIncrease((PetscObject)quad_vecs[i]);CHKERRQ(ierr);
1451     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1452   }
1453   PetscFunctionReturn(0);
1454 }
1455 
1456 PetscErrorCode PCBDDCComputeNoNetFlux(Mat A, Mat divudotp, PetscBool transpose, IS vl2l, PCBDDCGraph graph, MatNullSpace *nnsp)
1457 {
1458   Mat                    loc_divudotp;
1459   Vec                    p,v,vins,quad_vec,*quad_vecs;
1460   ISLocalToGlobalMapping map;
1461   PetscScalar            *vals;
1462   const PetscScalar      *array;
1463   PetscInt               i,maxneighs,maxsize;
1464   PetscInt               n_neigh,*neigh,*n_shared,**shared;
1465   PetscMPIInt            rank;
1466   PetscErrorCode         ierr;
1467 
1468   PetscFunctionBegin;
1469   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1470   ierr = MPIU_Allreduce(&n_neigh,&maxneighs,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)A));CHKERRQ(ierr);
1471   if (!maxneighs) {
1472     ierr  = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1473     *nnsp = NULL;
1474     PetscFunctionReturn(0);
1475   }
1476   maxsize = 0;
1477   for (i=0;i<n_neigh;i++) maxsize = PetscMax(n_shared[i],maxsize);
1478   ierr = PetscMalloc1(maxsize,&vals);CHKERRQ(ierr);
1479   /* create vectors to hold quadrature weights */
1480   ierr = MatCreateVecs(A,&quad_vec,NULL);CHKERRQ(ierr);
1481   if (!transpose) {
1482     ierr = MatGetLocalToGlobalMapping(A,&map,NULL);CHKERRQ(ierr);
1483   } else {
1484     ierr = MatGetLocalToGlobalMapping(A,NULL,&map);CHKERRQ(ierr);
1485   }
1486   ierr = VecDuplicateVecs(quad_vec,maxneighs,&quad_vecs);CHKERRQ(ierr);
1487   ierr = VecDestroy(&quad_vec);CHKERRQ(ierr);
1488   ierr = PCBDDCNullSpaceCreate(PetscObjectComm((PetscObject)A),PETSC_FALSE,maxneighs,quad_vecs,nnsp);CHKERRQ(ierr);
1489   for (i=0;i<maxneighs;i++) {
1490     ierr = VecLockPop(quad_vecs[i]);CHKERRQ(ierr);
1491     ierr = VecSetLocalToGlobalMapping(quad_vecs[i],map);CHKERRQ(ierr);
1492   }
1493 
1494   /* compute local quad vec */
1495   ierr = MatISGetLocalMat(divudotp,&loc_divudotp);CHKERRQ(ierr);
1496   if (!transpose) {
1497     ierr = MatCreateVecs(loc_divudotp,&v,&p);CHKERRQ(ierr);
1498   } else {
1499     ierr = MatCreateVecs(loc_divudotp,&p,&v);CHKERRQ(ierr);
1500   }
1501   ierr = VecSet(p,1.);CHKERRQ(ierr);
1502   if (!transpose) {
1503     ierr = MatMultTranspose(loc_divudotp,p,v);CHKERRQ(ierr);
1504   } else {
1505     ierr = MatMult(loc_divudotp,p,v);CHKERRQ(ierr);
1506   }
1507   if (vl2l) {
1508     Mat        lA;
1509     VecScatter sc;
1510 
1511     ierr = MatISGetLocalMat(A,&lA);CHKERRQ(ierr);
1512     ierr = MatCreateVecs(lA,&vins,NULL);CHKERRQ(ierr);
1513     ierr = VecScatterCreate(v,vl2l,vins,NULL,&sc);CHKERRQ(ierr);
1514     ierr = VecScatterBegin(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1515     ierr = VecScatterEnd(sc,v,vins,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1516     ierr = VecScatterDestroy(&sc);CHKERRQ(ierr);
1517   } else {
1518     vins = v;
1519   }
1520   ierr = VecGetArrayRead(vins,&array);CHKERRQ(ierr);
1521   ierr = VecDestroy(&p);CHKERRQ(ierr);
1522 
1523   /* insert in global quadrature vecs */
1524   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)A),&rank);CHKERRQ(ierr);
1525   for (i=0;i<n_neigh;i++) {
1526     const PetscInt    *idxs;
1527     PetscInt          idx,nn,j;
1528 
1529     idxs = shared[i];
1530     nn   = n_shared[i];
1531     for (j=0;j<nn;j++) vals[j] = array[idxs[j]];
1532     ierr = PetscFindInt(rank,graph->count[idxs[0]],graph->neighbours_set[idxs[0]],&idx);CHKERRQ(ierr);
1533     idx  = -(idx+1);
1534     ierr = VecSetValuesLocal(quad_vecs[idx],nn,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
1535   }
1536   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
1537   ierr = VecRestoreArrayRead(vins,&array);CHKERRQ(ierr);
1538   if (vl2l) {
1539     ierr = VecDestroy(&vins);CHKERRQ(ierr);
1540   }
1541   ierr = VecDestroy(&v);CHKERRQ(ierr);
1542   ierr = PetscFree(vals);CHKERRQ(ierr);
1543 
1544   /* assemble near null space */
1545   for (i=0;i<maxneighs;i++) {
1546     ierr = VecAssemblyBegin(quad_vecs[i]);CHKERRQ(ierr);
1547   }
1548   for (i=0;i<maxneighs;i++) {
1549     ierr = VecAssemblyEnd(quad_vecs[i]);CHKERRQ(ierr);
1550     ierr = VecViewFromOptions(quad_vecs[i],NULL,"-pc_bddc_quad_vecs_view");CHKERRQ(ierr);
1551     ierr = VecLockPush(quad_vecs[i]);CHKERRQ(ierr);
1552   }
1553   ierr = VecDestroyVecs(maxneighs,&quad_vecs);CHKERRQ(ierr);
1554   PetscFunctionReturn(0);
1555 }
1556 
1557 PetscErrorCode PCBDDCAddPrimalVerticesLocalIS(PC pc, IS primalv)
1558 {
1559   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1560   PetscErrorCode ierr;
1561 
1562   PetscFunctionBegin;
1563   if (primalv) {
1564     if (pcbddc->user_primal_vertices_local) {
1565       IS list[2], newp;
1566 
1567       list[0] = primalv;
1568       list[1] = pcbddc->user_primal_vertices_local;
1569       ierr = ISConcatenate(PetscObjectComm((PetscObject)pc),2,list,&newp);CHKERRQ(ierr);
1570       ierr = ISSortRemoveDups(newp);CHKERRQ(ierr);
1571       ierr = ISDestroy(&list[1]);CHKERRQ(ierr);
1572       pcbddc->user_primal_vertices_local = newp;
1573     } else {
1574       ierr = PCBDDCSetPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1575     }
1576   }
1577   PetscFunctionReturn(0);
1578 }
1579 
1580 static PetscErrorCode func_coords_private(PetscInt dim, PetscReal t, const PetscReal X[], PetscInt Nf, PetscScalar *out, void *ctx)
1581 {
1582   PetscInt f, *comp  = (PetscInt *)ctx;
1583 
1584   PetscFunctionBegin;
1585   for (f=0;f<Nf;f++) out[f] = X[*comp];
1586   PetscFunctionReturn(0);
1587 }
1588 
1589 PetscErrorCode PCBDDCComputeLocalTopologyInfo(PC pc)
1590 {
1591   PetscErrorCode ierr;
1592   Vec            local,global;
1593   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
1594   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
1595   PetscBool      monolithic = PETSC_FALSE;
1596 
1597   PetscFunctionBegin;
1598   ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC topology options","PC");CHKERRQ(ierr);
1599   ierr = PetscOptionsBool("-pc_bddc_monolithic","Discard any information on dofs splitting",NULL,monolithic,&monolithic,NULL);CHKERRQ(ierr);
1600   ierr = PetscOptionsEnd();CHKERRQ(ierr);
1601   /* need to convert from global to local topology information and remove references to information in global ordering */
1602   ierr = MatCreateVecs(pc->pmat,&global,NULL);CHKERRQ(ierr);
1603   ierr = MatCreateVecs(matis->A,&local,NULL);CHKERRQ(ierr);
1604   if (monolithic) { /* just get block size to properly compute vertices */
1605     if (pcbddc->vertex_size == 1) {
1606       ierr = MatGetBlockSize(pc->pmat,&pcbddc->vertex_size);CHKERRQ(ierr);
1607     }
1608     goto boundary;
1609   }
1610 
1611   if (pcbddc->user_provided_isfordofs) {
1612     if (pcbddc->n_ISForDofs) {
1613       PetscInt i;
1614       ierr = PetscMalloc1(pcbddc->n_ISForDofs,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1615       for (i=0;i<pcbddc->n_ISForDofs;i++) {
1616         ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->ISForDofs[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1617         ierr = ISDestroy(&pcbddc->ISForDofs[i]);CHKERRQ(ierr);
1618       }
1619       pcbddc->n_ISForDofsLocal = pcbddc->n_ISForDofs;
1620       pcbddc->n_ISForDofs = 0;
1621       ierr = PetscFree(pcbddc->ISForDofs);CHKERRQ(ierr);
1622     }
1623   } else {
1624     if (!pcbddc->n_ISForDofsLocal) { /* field split not present */
1625       DM dm;
1626 
1627       ierr = PCGetDM(pc, &dm);CHKERRQ(ierr);
1628       if (!dm) {
1629         ierr = MatGetDM(pc->pmat, &dm);CHKERRQ(ierr);
1630       }
1631       if (dm) {
1632         IS      *fields;
1633         PetscInt nf,i;
1634         ierr = DMCreateFieldDecomposition(dm,&nf,NULL,&fields,NULL);CHKERRQ(ierr);
1635         ierr = PetscMalloc1(nf,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1636         for (i=0;i<nf;i++) {
1637           ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,fields[i],&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1638           ierr = ISDestroy(&fields[i]);CHKERRQ(ierr);
1639         }
1640         ierr = PetscFree(fields);CHKERRQ(ierr);
1641         pcbddc->n_ISForDofsLocal = nf;
1642       } else { /* See if MATIS has fields attached by the conversion from MatNest */
1643         PetscContainer   c;
1644 
1645         ierr = PetscObjectQuery((PetscObject)pc->pmat,"_convert_nest_lfields",(PetscObject*)&c);CHKERRQ(ierr);
1646         if (c) {
1647           MatISLocalFields lf;
1648           ierr = PetscContainerGetPointer(c,(void**)&lf);CHKERRQ(ierr);
1649           ierr = PCBDDCSetDofsSplittingLocal(pc,lf->nr,lf->rf);CHKERRQ(ierr);
1650         } else { /* fallback, create the default fields if bs > 1 */
1651           PetscInt i, n = matis->A->rmap->n;
1652           ierr = MatGetBlockSize(pc->pmat,&i);CHKERRQ(ierr);
1653           if (i > 1) {
1654             pcbddc->n_ISForDofsLocal = i;
1655             ierr = PetscMalloc1(pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal);CHKERRQ(ierr);
1656             for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1657               ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n/pcbddc->n_ISForDofsLocal,i,pcbddc->n_ISForDofsLocal,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1658             }
1659           }
1660         }
1661       }
1662     } else {
1663       PetscInt i;
1664       for (i=0;i<pcbddc->n_ISForDofsLocal;i++) {
1665         ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->ISForDofsLocal[i]);CHKERRQ(ierr);
1666       }
1667     }
1668   }
1669 
1670 boundary:
1671   if (!pcbddc->DirichletBoundariesLocal && pcbddc->DirichletBoundaries) {
1672     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->DirichletBoundaries,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1673   } else if (pcbddc->DirichletBoundariesLocal) {
1674     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LAND,&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
1675   }
1676   if (!pcbddc->NeumannBoundariesLocal && pcbddc->NeumannBoundaries) {
1677     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->NeumannBoundaries,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1678   } else if (pcbddc->NeumannBoundariesLocal) {
1679     ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
1680   }
1681   if (!pcbddc->user_primal_vertices_local && pcbddc->user_primal_vertices) {
1682     ierr = PCBDDCGlobalToLocal(matis->rctx,global,local,pcbddc->user_primal_vertices,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
1683   }
1684   ierr = VecDestroy(&global);CHKERRQ(ierr);
1685   ierr = VecDestroy(&local);CHKERRQ(ierr);
1686   /* detect local disconnected subdomains if requested (use matis->A) */
1687   if (pcbddc->detect_disconnected) {
1688     IS        primalv = NULL;
1689     PetscInt  i;
1690     PetscBool filter = pcbddc->detect_disconnected_filter;
1691 
1692     for (i=0;i<pcbddc->n_local_subs;i++) {
1693       ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
1694     }
1695     ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
1696     ierr = PCBDDCDetectDisconnectedComponents(pc,filter,&pcbddc->n_local_subs,&pcbddc->local_subs,&primalv);CHKERRQ(ierr);
1697     ierr = PCBDDCAddPrimalVerticesLocalIS(pc,primalv);CHKERRQ(ierr);
1698     ierr = ISDestroy(&primalv);CHKERRQ(ierr);
1699   }
1700   /* early stage corner detection */
1701   {
1702     DM dm;
1703 
1704     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1705     if (dm) {
1706       PetscBool isda;
1707 
1708       ierr = PetscObjectTypeCompare((PetscObject)dm,DMDA,&isda);CHKERRQ(ierr);
1709       if (isda) {
1710         ISLocalToGlobalMapping l2l;
1711         IS                     corners;
1712         Mat                    lA;
1713 
1714         ierr = DMDAGetSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1715         ierr = MatISGetLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1716         ierr = MatGetLocalToGlobalMapping(lA,&l2l,NULL);CHKERRQ(ierr);
1717         ierr = MatISRestoreLocalMat(pc->pmat,&lA);CHKERRQ(ierr);
1718         if (l2l && corners) {
1719           const PetscInt *idx;
1720           PetscInt       dof,bs,*idxout,n;
1721 
1722           ierr = DMDAGetInfo(dm,NULL,NULL,NULL,NULL,NULL,NULL,NULL,&dof,NULL,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
1723           ierr = ISLocalToGlobalMappingGetBlockSize(l2l,&bs);CHKERRQ(ierr);
1724           ierr = ISGetLocalSize(corners,&n);CHKERRQ(ierr);
1725           ierr = ISGetIndices(corners,&idx);CHKERRQ(ierr);
1726           if (bs == dof) {
1727             ierr = PetscMalloc1(n,&idxout);CHKERRQ(ierr);
1728             ierr = ISLocalToGlobalMappingApplyBlock(l2l,n,idx,idxout);CHKERRQ(ierr);
1729           } else { /* the original DMDA local-to-local map have been modified */
1730             PetscInt i,d;
1731 
1732             ierr = PetscMalloc1(dof*n,&idxout);CHKERRQ(ierr);
1733             for (i=0;i<n;i++) for (d=0;d<dof;d++) idxout[dof*i+d] = dof*idx[i]+d;
1734             ierr = ISLocalToGlobalMappingApply(l2l,dof*n,idxout,idxout);CHKERRQ(ierr);
1735 
1736             bs = 1;
1737             n *= dof;
1738           }
1739           ierr = ISRestoreIndices(corners,&idx);CHKERRQ(ierr);
1740           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1741           ierr = ISCreateBlock(PetscObjectComm((PetscObject)pc),bs,n,idxout,PETSC_OWN_POINTER,&corners);CHKERRQ(ierr);
1742           ierr = PCBDDCAddPrimalVerticesLocalIS(pc,corners);CHKERRQ(ierr);
1743           ierr = ISDestroy(&corners);CHKERRQ(ierr);
1744           pcbddc->corner_selected = PETSC_TRUE;
1745         } else if (corners) { /* not from DMDA */
1746           ierr = DMDARestoreSubdomainCornersIS(dm,&corners);CHKERRQ(ierr);
1747         }
1748       }
1749     }
1750   }
1751   if (pcbddc->corner_selection && !pcbddc->mat_graph->cdim) {
1752     DM dm;
1753 
1754     ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
1755     if (!dm) {
1756       ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
1757     }
1758     if (dm) {
1759       Vec            vcoords;
1760       PetscSection   section;
1761       PetscReal      *coords;
1762       PetscInt       d,cdim,nl,nf,**ctxs;
1763       PetscErrorCode (**funcs)(PetscInt, PetscReal, const PetscReal *, PetscInt, PetscScalar *, void *);
1764 
1765       ierr = DMGetCoordinateDim(dm,&cdim);CHKERRQ(ierr);
1766       ierr = DMGetSection(dm,&section);CHKERRQ(ierr);
1767       ierr = PetscSectionGetNumFields(section,&nf);CHKERRQ(ierr);
1768       ierr = DMCreateGlobalVector(dm,&vcoords);CHKERRQ(ierr);
1769       ierr = VecGetLocalSize(vcoords,&nl);CHKERRQ(ierr);
1770       ierr = PetscMalloc1(nl*cdim,&coords);CHKERRQ(ierr);
1771       ierr = PetscMalloc2(nf,&funcs,nf,&ctxs);CHKERRQ(ierr);
1772       ierr = PetscMalloc1(nf,&ctxs[0]);CHKERRQ(ierr);
1773       for (d=0;d<nf;d++) funcs[d] = func_coords_private;
1774       for (d=1;d<nf;d++) ctxs[d] = ctxs[d-1] + 1;
1775       for (d=0;d<cdim;d++) {
1776         PetscInt          i;
1777         const PetscScalar *v;
1778 
1779         for (i=0;i<nf;i++) ctxs[i][0] = d;
1780         ierr = DMProjectFunction(dm,0.0,funcs,(void**)ctxs,INSERT_VALUES,vcoords);CHKERRQ(ierr);
1781         ierr = VecGetArrayRead(vcoords,&v);CHKERRQ(ierr);
1782         for (i=0;i<nl;i++) coords[i*cdim+d] = PetscRealPart(v[i]);
1783         ierr = VecRestoreArrayRead(vcoords,&v);CHKERRQ(ierr);
1784       }
1785       ierr = VecDestroy(&vcoords);CHKERRQ(ierr);
1786       ierr = PCSetCoordinates(pc,cdim,nl,coords);CHKERRQ(ierr);
1787       ierr = PetscFree(coords);CHKERRQ(ierr);
1788       ierr = PetscFree(ctxs[0]);CHKERRQ(ierr);
1789       ierr = PetscFree2(funcs,ctxs);CHKERRQ(ierr);
1790     }
1791   }
1792   PetscFunctionReturn(0);
1793 }
1794 
1795 PetscErrorCode PCBDDCConsistencyCheckIS(PC pc, MPI_Op mop, IS *is)
1796 {
1797   Mat_IS          *matis = (Mat_IS*)(pc->pmat->data);
1798   PetscErrorCode  ierr;
1799   IS              nis;
1800   const PetscInt  *idxs;
1801   PetscInt        i,nd,n = matis->A->rmap->n,*nidxs,nnd;
1802   PetscBool       *ld;
1803 
1804   PetscFunctionBegin;
1805   if (mop != MPI_LAND && mop != MPI_LOR) SETERRQ(PetscObjectComm((PetscObject)(pc)),PETSC_ERR_SUP,"Supported are MPI_LAND and MPI_LOR");
1806   ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
1807   if (mop == MPI_LAND) {
1808     /* init rootdata with true */
1809     ld   = (PetscBool*) matis->sf_rootdata;
1810     for (i=0;i<pc->pmat->rmap->n;i++) ld[i] = PETSC_TRUE;
1811   } else {
1812     ierr = PetscMemzero(matis->sf_rootdata,pc->pmat->rmap->n*sizeof(PetscBool));CHKERRQ(ierr);
1813   }
1814   ierr = PetscMemzero(matis->sf_leafdata,n*sizeof(PetscBool));CHKERRQ(ierr);
1815   ierr = ISGetLocalSize(*is,&nd);CHKERRQ(ierr);
1816   ierr = ISGetIndices(*is,&idxs);CHKERRQ(ierr);
1817   ld   = (PetscBool*) matis->sf_leafdata;
1818   for (i=0;i<nd;i++)
1819     if (-1 < idxs[i] && idxs[i] < n)
1820       ld[idxs[i]] = PETSC_TRUE;
1821   ierr = ISRestoreIndices(*is,&idxs);CHKERRQ(ierr);
1822   ierr = PetscSFReduceBegin(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1823   ierr = PetscSFReduceEnd(matis->sf,MPIU_BOOL,matis->sf_leafdata,matis->sf_rootdata,mop);CHKERRQ(ierr);
1824   ierr = PetscSFBcastBegin(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1825   ierr = PetscSFBcastEnd(matis->sf,MPIU_BOOL,matis->sf_rootdata,matis->sf_leafdata);CHKERRQ(ierr);
1826   if (mop == MPI_LAND) {
1827     ierr = PetscMalloc1(nd,&nidxs);CHKERRQ(ierr);
1828   } else {
1829     ierr = PetscMalloc1(n,&nidxs);CHKERRQ(ierr);
1830   }
1831   for (i=0,nnd=0;i<n;i++)
1832     if (ld[i])
1833       nidxs[nnd++] = i;
1834   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(*is)),nnd,nidxs,PETSC_OWN_POINTER,&nis);CHKERRQ(ierr);
1835   ierr = ISDestroy(is);CHKERRQ(ierr);
1836   *is  = nis;
1837   PetscFunctionReturn(0);
1838 }
1839 
1840 PetscErrorCode PCBDDCBenignRemoveInterior(PC pc,Vec r,Vec z)
1841 {
1842   PC_IS             *pcis = (PC_IS*)(pc->data);
1843   PC_BDDC           *pcbddc = (PC_BDDC*)(pc->data);
1844   PetscErrorCode    ierr;
1845 
1846   PetscFunctionBegin;
1847   if (!pcbddc->benign_have_null) {
1848     PetscFunctionReturn(0);
1849   }
1850   if (pcbddc->ChangeOfBasisMatrix) {
1851     Vec swap;
1852 
1853     ierr = MatMultTranspose(pcbddc->ChangeOfBasisMatrix,r,pcbddc->work_change);CHKERRQ(ierr);
1854     swap = pcbddc->work_change;
1855     pcbddc->work_change = r;
1856     r = swap;
1857   }
1858   ierr = VecScatterBegin(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1859   ierr = VecScatterEnd(pcis->global_to_D,r,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1860   ierr = KSPSolve(pcbddc->ksp_D,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
1861   ierr = VecSet(z,0.);CHKERRQ(ierr);
1862   ierr = VecScatterBegin(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1863   ierr = VecScatterEnd(pcis->global_to_D,pcis->vec2_D,z,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1864   if (pcbddc->ChangeOfBasisMatrix) {
1865     pcbddc->work_change = r;
1866     ierr = VecCopy(z,pcbddc->work_change);CHKERRQ(ierr);
1867     ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcbddc->work_change,z);CHKERRQ(ierr);
1868   }
1869   PetscFunctionReturn(0);
1870 }
1871 
1872 PetscErrorCode PCBDDCBenignMatMult_Private_Private(Mat A, Vec x, Vec y, PetscBool transpose)
1873 {
1874   PCBDDCBenignMatMult_ctx ctx;
1875   PetscErrorCode          ierr;
1876   PetscBool               apply_right,apply_left,reset_x;
1877 
1878   PetscFunctionBegin;
1879   ierr = MatShellGetContext(A,&ctx);CHKERRQ(ierr);
1880   if (transpose) {
1881     apply_right = ctx->apply_left;
1882     apply_left = ctx->apply_right;
1883   } else {
1884     apply_right = ctx->apply_right;
1885     apply_left = ctx->apply_left;
1886   }
1887   reset_x = PETSC_FALSE;
1888   if (apply_right) {
1889     const PetscScalar *ax;
1890     PetscInt          nl,i;
1891 
1892     ierr = VecGetLocalSize(x,&nl);CHKERRQ(ierr);
1893     ierr = VecGetArrayRead(x,&ax);CHKERRQ(ierr);
1894     ierr = PetscMemcpy(ctx->work,ax,nl*sizeof(PetscScalar));CHKERRQ(ierr);
1895     ierr = VecRestoreArrayRead(x,&ax);CHKERRQ(ierr);
1896     for (i=0;i<ctx->benign_n;i++) {
1897       PetscScalar    sum,val;
1898       const PetscInt *idxs;
1899       PetscInt       nz,j;
1900       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1901       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1902       sum = 0.;
1903       if (ctx->apply_p0) {
1904         val = ctx->work[idxs[nz-1]];
1905         for (j=0;j<nz-1;j++) {
1906           sum += ctx->work[idxs[j]];
1907           ctx->work[idxs[j]] += val;
1908         }
1909       } else {
1910         for (j=0;j<nz-1;j++) {
1911           sum += ctx->work[idxs[j]];
1912         }
1913       }
1914       ctx->work[idxs[nz-1]] -= sum;
1915       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1916     }
1917     ierr = VecPlaceArray(x,ctx->work);CHKERRQ(ierr);
1918     reset_x = PETSC_TRUE;
1919   }
1920   if (transpose) {
1921     ierr = MatMultTranspose(ctx->A,x,y);CHKERRQ(ierr);
1922   } else {
1923     ierr = MatMult(ctx->A,x,y);CHKERRQ(ierr);
1924   }
1925   if (reset_x) {
1926     ierr = VecResetArray(x);CHKERRQ(ierr);
1927   }
1928   if (apply_left) {
1929     PetscScalar *ay;
1930     PetscInt    i;
1931 
1932     ierr = VecGetArray(y,&ay);CHKERRQ(ierr);
1933     for (i=0;i<ctx->benign_n;i++) {
1934       PetscScalar    sum,val;
1935       const PetscInt *idxs;
1936       PetscInt       nz,j;
1937       ierr = ISGetLocalSize(ctx->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
1938       ierr = ISGetIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1939       val = -ay[idxs[nz-1]];
1940       if (ctx->apply_p0) {
1941         sum = 0.;
1942         for (j=0;j<nz-1;j++) {
1943           sum += ay[idxs[j]];
1944           ay[idxs[j]] += val;
1945         }
1946         ay[idxs[nz-1]] += sum;
1947       } else {
1948         for (j=0;j<nz-1;j++) {
1949           ay[idxs[j]] += val;
1950         }
1951         ay[idxs[nz-1]] = 0.;
1952       }
1953       ierr = ISRestoreIndices(ctx->benign_zerodiag_subs[i],&idxs);CHKERRQ(ierr);
1954     }
1955     ierr = VecRestoreArray(y,&ay);CHKERRQ(ierr);
1956   }
1957   PetscFunctionReturn(0);
1958 }
1959 
1960 PetscErrorCode PCBDDCBenignMatMultTranspose_Private(Mat A, Vec x, Vec y)
1961 {
1962   PetscErrorCode ierr;
1963 
1964   PetscFunctionBegin;
1965   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_TRUE);CHKERRQ(ierr);
1966   PetscFunctionReturn(0);
1967 }
1968 
1969 PetscErrorCode PCBDDCBenignMatMult_Private(Mat A, Vec x, Vec y)
1970 {
1971   PetscErrorCode ierr;
1972 
1973   PetscFunctionBegin;
1974   ierr = PCBDDCBenignMatMult_Private_Private(A,x,y,PETSC_FALSE);CHKERRQ(ierr);
1975   PetscFunctionReturn(0);
1976 }
1977 
1978 PetscErrorCode PCBDDCBenignShellMat(PC pc, PetscBool restore)
1979 {
1980   PC_IS                   *pcis = (PC_IS*)pc->data;
1981   PC_BDDC                 *pcbddc = (PC_BDDC*)pc->data;
1982   PCBDDCBenignMatMult_ctx ctx;
1983   PetscErrorCode          ierr;
1984 
1985   PetscFunctionBegin;
1986   if (!restore) {
1987     Mat                A_IB,A_BI;
1988     PetscScalar        *work;
1989     PCBDDCReuseSolvers reuse = pcbddc->sub_schurs ? pcbddc->sub_schurs->reuse_solver : NULL;
1990 
1991     if (pcbddc->benign_original_mat) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Benign original mat has not been restored");
1992     if (!pcbddc->benign_change || !pcbddc->benign_n || pcbddc->benign_change_explicit) PetscFunctionReturn(0);
1993     ierr = PetscMalloc1(pcis->n,&work);CHKERRQ(ierr);
1994     ierr = MatCreate(PETSC_COMM_SELF,&A_IB);CHKERRQ(ierr);
1995     ierr = MatSetSizes(A_IB,pcis->n-pcis->n_B,pcis->n_B,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
1996     ierr = MatSetType(A_IB,MATSHELL);CHKERRQ(ierr);
1997     ierr = MatShellSetOperation(A_IB,MATOP_MULT,(void (*)(void))PCBDDCBenignMatMult_Private);CHKERRQ(ierr);
1998     ierr = MatShellSetOperation(A_IB,MATOP_MULT_TRANSPOSE,(void (*)(void))PCBDDCBenignMatMultTranspose_Private);CHKERRQ(ierr);
1999     ierr = PetscNew(&ctx);CHKERRQ(ierr);
2000     ierr = MatShellSetContext(A_IB,ctx);CHKERRQ(ierr);
2001     ctx->apply_left = PETSC_TRUE;
2002     ctx->apply_right = PETSC_FALSE;
2003     ctx->apply_p0 = PETSC_FALSE;
2004     ctx->benign_n = pcbddc->benign_n;
2005     if (reuse) {
2006       ctx->benign_zerodiag_subs = reuse->benign_zerodiag_subs;
2007       ctx->free = PETSC_FALSE;
2008     } else { /* TODO: could be optimized for successive solves */
2009       ISLocalToGlobalMapping N_to_D;
2010       PetscInt               i;
2011 
2012       ierr = ISLocalToGlobalMappingCreateIS(pcis->is_I_local,&N_to_D);CHKERRQ(ierr);
2013       ierr = PetscMalloc1(pcbddc->benign_n,&ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2014       for (i=0;i<pcbddc->benign_n;i++) {
2015         ierr = ISGlobalToLocalMappingApplyIS(N_to_D,IS_GTOLM_DROP,pcbddc->benign_zerodiag_subs[i],&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2016       }
2017       ierr = ISLocalToGlobalMappingDestroy(&N_to_D);CHKERRQ(ierr);
2018       ctx->free = PETSC_TRUE;
2019     }
2020     ctx->A = pcis->A_IB;
2021     ctx->work = work;
2022     ierr = MatSetUp(A_IB);CHKERRQ(ierr);
2023     ierr = MatAssemblyBegin(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2024     ierr = MatAssemblyEnd(A_IB,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2025     pcis->A_IB = A_IB;
2026 
2027     /* A_BI as A_IB^T */
2028     ierr = MatCreateTranspose(A_IB,&A_BI);CHKERRQ(ierr);
2029     pcbddc->benign_original_mat = pcis->A_BI;
2030     pcis->A_BI = A_BI;
2031   } else {
2032     if (!pcbddc->benign_original_mat) {
2033       PetscFunctionReturn(0);
2034     }
2035     ierr = MatShellGetContext(pcis->A_IB,&ctx);CHKERRQ(ierr);
2036     ierr = MatDestroy(&pcis->A_IB);CHKERRQ(ierr);
2037     pcis->A_IB = ctx->A;
2038     ctx->A = NULL;
2039     ierr = MatDestroy(&pcis->A_BI);CHKERRQ(ierr);
2040     pcis->A_BI = pcbddc->benign_original_mat;
2041     pcbddc->benign_original_mat = NULL;
2042     if (ctx->free) {
2043       PetscInt i;
2044       for (i=0;i<ctx->benign_n;i++) {
2045         ierr = ISDestroy(&ctx->benign_zerodiag_subs[i]);CHKERRQ(ierr);
2046       }
2047       ierr = PetscFree(ctx->benign_zerodiag_subs);CHKERRQ(ierr);
2048     }
2049     ierr = PetscFree(ctx->work);CHKERRQ(ierr);
2050     ierr = PetscFree(ctx);CHKERRQ(ierr);
2051   }
2052   PetscFunctionReturn(0);
2053 }
2054 
2055 /* used just in bddc debug mode */
2056 PetscErrorCode PCBDDCBenignProject(PC pc, IS is1, IS is2, Mat *B)
2057 {
2058   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
2059   Mat_IS         *matis = (Mat_IS*)pc->pmat->data;
2060   Mat            An;
2061   PetscErrorCode ierr;
2062 
2063   PetscFunctionBegin;
2064   ierr = MatPtAP(matis->A,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&An);CHKERRQ(ierr);
2065   ierr = MatZeroRowsColumns(An,pcbddc->benign_n,pcbddc->benign_p0_lidx,1.0,NULL,NULL);CHKERRQ(ierr);
2066   if (is1) {
2067     ierr = MatCreateSubMatrix(An,is1,is2,MAT_INITIAL_MATRIX,B);CHKERRQ(ierr);
2068     ierr = MatDestroy(&An);CHKERRQ(ierr);
2069   } else {
2070     *B = An;
2071   }
2072   PetscFunctionReturn(0);
2073 }
2074 
2075 /* TODO: add reuse flag */
2076 PetscErrorCode MatSeqAIJCompress(Mat A, Mat *B)
2077 {
2078   Mat            Bt;
2079   PetscScalar    *a,*bdata;
2080   const PetscInt *ii,*ij;
2081   PetscInt       m,n,i,nnz,*bii,*bij;
2082   PetscBool      flg_row;
2083   PetscErrorCode ierr;
2084 
2085   PetscFunctionBegin;
2086   ierr = MatGetSize(A,&n,&m);CHKERRQ(ierr);
2087   ierr = MatGetRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2088   ierr = MatSeqAIJGetArray(A,&a);CHKERRQ(ierr);
2089   nnz = n;
2090   for (i=0;i<ii[n];i++) {
2091     if (PetscLikely(PetscAbsScalar(a[i]) > PETSC_SMALL)) nnz++;
2092   }
2093   ierr = PetscMalloc1(n+1,&bii);CHKERRQ(ierr);
2094   ierr = PetscMalloc1(nnz,&bij);CHKERRQ(ierr);
2095   ierr = PetscMalloc1(nnz,&bdata);CHKERRQ(ierr);
2096   nnz = 0;
2097   bii[0] = 0;
2098   for (i=0;i<n;i++) {
2099     PetscInt j;
2100     for (j=ii[i];j<ii[i+1];j++) {
2101       PetscScalar entry = a[j];
2102       if (PetscLikely(PetscAbsScalar(entry) > PETSC_SMALL) || (n == m && ij[j] == i)) {
2103         bij[nnz] = ij[j];
2104         bdata[nnz] = entry;
2105         nnz++;
2106       }
2107     }
2108     bii[i+1] = nnz;
2109   }
2110   ierr = MatSeqAIJRestoreArray(A,&a);CHKERRQ(ierr);
2111   ierr = MatCreateSeqAIJWithArrays(PetscObjectComm((PetscObject)A),n,m,bii,bij,bdata,&Bt);CHKERRQ(ierr);
2112   ierr = MatRestoreRowIJ(A,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&ij,&flg_row);CHKERRQ(ierr);
2113   {
2114     Mat_SeqAIJ *b = (Mat_SeqAIJ*)(Bt->data);
2115     b->free_a = PETSC_TRUE;
2116     b->free_ij = PETSC_TRUE;
2117   }
2118   if (*B == A) {
2119     ierr = MatDestroy(&A);CHKERRQ(ierr);
2120   }
2121   *B = Bt;
2122   PetscFunctionReturn(0);
2123 }
2124 
2125 PetscErrorCode PCBDDCDetectDisconnectedComponents(PC pc, PetscBool filter, PetscInt *ncc, IS* cc[], IS* primalv)
2126 {
2127   Mat                    B = NULL;
2128   DM                     dm;
2129   IS                     is_dummy,*cc_n;
2130   ISLocalToGlobalMapping l2gmap_dummy;
2131   PCBDDCGraph            graph;
2132   PetscInt               *xadj_filtered = NULL,*adjncy_filtered = NULL;
2133   PetscInt               i,n;
2134   PetscInt               *xadj,*adjncy;
2135   PetscBool              isplex = PETSC_FALSE;
2136   PetscErrorCode         ierr;
2137 
2138   PetscFunctionBegin;
2139   if (ncc) *ncc = 0;
2140   if (cc) *cc = NULL;
2141   if (primalv) *primalv = NULL;
2142   ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
2143   ierr = PCGetDM(pc,&dm);CHKERRQ(ierr);
2144   if (!dm) {
2145     ierr = MatGetDM(pc->pmat,&dm);CHKERRQ(ierr);
2146   }
2147   if (dm) {
2148     ierr = PetscObjectTypeCompare((PetscObject)dm,DMPLEX,&isplex);CHKERRQ(ierr);
2149   }
2150   if (filter) isplex = PETSC_FALSE;
2151 
2152   if (isplex) { /* this code has been modified from plexpartition.c */
2153     PetscInt       p, pStart, pEnd, a, adjSize, idx, size, nroots;
2154     PetscInt      *adj = NULL;
2155     IS             cellNumbering;
2156     const PetscInt *cellNum;
2157     PetscBool      useCone, useClosure;
2158     PetscSection   section;
2159     PetscSegBuffer adjBuffer;
2160     PetscSF        sfPoint;
2161     PetscErrorCode ierr;
2162 
2163     PetscFunctionBegin;
2164     ierr = DMPlexGetHeightStratum(dm, 0, &pStart, &pEnd);CHKERRQ(ierr);
2165     ierr = DMGetPointSF(dm, &sfPoint);CHKERRQ(ierr);
2166     ierr = PetscSFGetGraph(sfPoint, &nroots, NULL, NULL, NULL);CHKERRQ(ierr);
2167     /* Build adjacency graph via a section/segbuffer */
2168     ierr = PetscSectionCreate(PetscObjectComm((PetscObject) dm), &section);CHKERRQ(ierr);
2169     ierr = PetscSectionSetChart(section, pStart, pEnd);CHKERRQ(ierr);
2170     ierr = PetscSegBufferCreate(sizeof(PetscInt),1000,&adjBuffer);CHKERRQ(ierr);
2171     /* Always use FVM adjacency to create partitioner graph */
2172     ierr = DMPlexGetAdjacencyUseCone(dm, &useCone);CHKERRQ(ierr);
2173     ierr = DMPlexGetAdjacencyUseClosure(dm, &useClosure);CHKERRQ(ierr);
2174     ierr = DMPlexSetAdjacencyUseCone(dm, PETSC_TRUE);CHKERRQ(ierr);
2175     ierr = DMPlexSetAdjacencyUseClosure(dm, PETSC_FALSE);CHKERRQ(ierr);
2176     ierr = DMPlexGetCellNumbering(dm, &cellNumbering);CHKERRQ(ierr);
2177     ierr = ISGetIndices(cellNumbering, &cellNum);CHKERRQ(ierr);
2178     for (n = 0, p = pStart; p < pEnd; p++) {
2179       /* Skip non-owned cells in parallel (ParMetis expects no overlap) */
2180       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2181       adjSize = PETSC_DETERMINE;
2182       ierr = DMPlexGetAdjacency(dm, p, &adjSize, &adj);CHKERRQ(ierr);
2183       for (a = 0; a < adjSize; ++a) {
2184         const PetscInt point = adj[a];
2185         if (pStart <= point && point < pEnd) {
2186           PetscInt *PETSC_RESTRICT pBuf;
2187           ierr = PetscSectionAddDof(section, p, 1);CHKERRQ(ierr);
2188           ierr = PetscSegBufferGetInts(adjBuffer, 1, &pBuf);CHKERRQ(ierr);
2189           *pBuf = point;
2190         }
2191       }
2192       n++;
2193     }
2194     ierr = DMPlexSetAdjacencyUseCone(dm, useCone);CHKERRQ(ierr);
2195     ierr = DMPlexSetAdjacencyUseClosure(dm, useClosure);CHKERRQ(ierr);
2196     /* Derive CSR graph from section/segbuffer */
2197     ierr = PetscSectionSetUp(section);CHKERRQ(ierr);
2198     ierr = PetscSectionGetStorageSize(section, &size);CHKERRQ(ierr);
2199     ierr = PetscMalloc1(n+1, &xadj);CHKERRQ(ierr);
2200     for (idx = 0, p = pStart; p < pEnd; p++) {
2201       if (nroots > 0) {if (cellNum[p] < 0) continue;}
2202       ierr = PetscSectionGetOffset(section, p, &(xadj[idx++]));CHKERRQ(ierr);
2203     }
2204     xadj[n] = size;
2205     ierr = PetscSegBufferExtractAlloc(adjBuffer, &adjncy);CHKERRQ(ierr);
2206     /* Clean up */
2207     ierr = PetscSegBufferDestroy(&adjBuffer);CHKERRQ(ierr);
2208     ierr = PetscSectionDestroy(&section);CHKERRQ(ierr);
2209     ierr = PetscFree(adj);CHKERRQ(ierr);
2210     graph->xadj = xadj;
2211     graph->adjncy = adjncy;
2212   } else {
2213     Mat       A;
2214     PetscBool isseqaij, flg_row;
2215 
2216     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2217     if (!A->rmap->N || !A->cmap->N) {
2218       ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2219       PetscFunctionReturn(0);
2220     }
2221     ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
2222     if (!isseqaij && filter) {
2223       PetscBool isseqdense;
2224 
2225       ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQDENSE,&isseqdense);CHKERRQ(ierr);
2226       if (!isseqdense) {
2227         ierr = MatConvert(A,MATSEQAIJ,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
2228       } else { /* TODO: rectangular case and LDA */
2229         PetscScalar *array;
2230         PetscReal   chop=1.e-6;
2231 
2232         ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
2233         ierr = MatDenseGetArray(B,&array);CHKERRQ(ierr);
2234         ierr = MatGetSize(B,&n,NULL);CHKERRQ(ierr);
2235         for (i=0;i<n;i++) {
2236           PetscInt j;
2237           for (j=i+1;j<n;j++) {
2238             PetscReal thresh = chop*(PetscAbsScalar(array[i*(n+1)])+PetscAbsScalar(array[j*(n+1)]));
2239             if (PetscAbsScalar(array[i*n+j]) < thresh) array[i*n+j] = 0.;
2240             if (PetscAbsScalar(array[j*n+i]) < thresh) array[j*n+i] = 0.;
2241           }
2242         }
2243         ierr = MatDenseRestoreArray(B,&array);CHKERRQ(ierr);
2244         ierr = MatConvert(B,MATSEQAIJ,MAT_INPLACE_MATRIX,&B);CHKERRQ(ierr);
2245       }
2246     } else {
2247       ierr = PetscObjectReference((PetscObject)A);CHKERRQ(ierr);
2248       B = A;
2249     }
2250     ierr = MatGetRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2251 
2252     /* if filter is true, then removes entries lower than PETSC_SMALL in magnitude */
2253     if (filter) {
2254       PetscScalar *data;
2255       PetscInt    j,cum;
2256 
2257       ierr = PetscCalloc2(n+1,&xadj_filtered,xadj[n],&adjncy_filtered);CHKERRQ(ierr);
2258       ierr = MatSeqAIJGetArray(B,&data);CHKERRQ(ierr);
2259       cum = 0;
2260       for (i=0;i<n;i++) {
2261         PetscInt t;
2262 
2263         for (j=xadj[i];j<xadj[i+1];j++) {
2264           if (PetscUnlikely(PetscAbsScalar(data[j]) < PETSC_SMALL)) {
2265             continue;
2266           }
2267           adjncy_filtered[cum+xadj_filtered[i]++] = adjncy[j];
2268         }
2269         t = xadj_filtered[i];
2270         xadj_filtered[i] = cum;
2271         cum += t;
2272       }
2273       ierr = MatSeqAIJRestoreArray(B,&data);CHKERRQ(ierr);
2274       graph->xadj = xadj_filtered;
2275       graph->adjncy = adjncy_filtered;
2276     } else {
2277       graph->xadj = xadj;
2278       graph->adjncy = adjncy;
2279     }
2280   }
2281   /* compute local connected components using PCBDDCGraph */
2282   ierr = ISCreateStride(PETSC_COMM_SELF,n,0,1,&is_dummy);CHKERRQ(ierr);
2283   ierr = ISLocalToGlobalMappingCreateIS(is_dummy,&l2gmap_dummy);CHKERRQ(ierr);
2284   ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
2285   ierr = PCBDDCGraphInit(graph,l2gmap_dummy,n,PETSC_MAX_INT);CHKERRQ(ierr);
2286   ierr = ISLocalToGlobalMappingDestroy(&l2gmap_dummy);CHKERRQ(ierr);
2287   ierr = PCBDDCGraphSetUp(graph,1,NULL,NULL,0,NULL,NULL);CHKERRQ(ierr);
2288   ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
2289 
2290   /* partial clean up */
2291   ierr = PetscFree2(xadj_filtered,adjncy_filtered);CHKERRQ(ierr);
2292   if (B) {
2293     PetscBool flg_row;
2294     ierr = MatRestoreRowIJ(B,0,PETSC_TRUE,PETSC_FALSE,&n,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
2295     ierr = MatDestroy(&B);CHKERRQ(ierr);
2296   }
2297   if (isplex) {
2298     ierr = PetscFree(xadj);CHKERRQ(ierr);
2299     ierr = PetscFree(adjncy);CHKERRQ(ierr);
2300   }
2301 
2302   /* get back data */
2303   if (isplex) {
2304     if (ncc) *ncc = graph->ncc;
2305     if (cc || primalv) {
2306       Mat          A;
2307       PetscBT      btv,btvt;
2308       PetscSection subSection;
2309       PetscInt     *ids,cum,cump,*cids,*pids;
2310 
2311       ierr = DMPlexGetSubdomainSection(dm,&subSection);CHKERRQ(ierr);
2312       ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2313       ierr = PetscMalloc3(A->rmap->n,&ids,graph->ncc+1,&cids,A->rmap->n,&pids);CHKERRQ(ierr);
2314       ierr = PetscBTCreate(A->rmap->n,&btv);CHKERRQ(ierr);
2315       ierr = PetscBTCreate(A->rmap->n,&btvt);CHKERRQ(ierr);
2316 
2317       cids[0] = 0;
2318       for (i = 0, cump = 0, cum = 0; i < graph->ncc; i++) {
2319         PetscInt j;
2320 
2321         ierr = PetscBTMemzero(A->rmap->n,btvt);CHKERRQ(ierr);
2322         for (j = graph->cptr[i]; j < graph->cptr[i+1]; j++) {
2323           PetscInt k, size, *closure = NULL, cell = graph->queue[j];
2324 
2325           ierr = DMPlexGetTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2326           for (k = 0; k < 2*size; k += 2) {
2327             PetscInt s, p = closure[k], off, dof, cdof;
2328 
2329             ierr = PetscSectionGetConstraintDof(subSection, p, &cdof);CHKERRQ(ierr);
2330             ierr = PetscSectionGetOffset(subSection,p,&off);CHKERRQ(ierr);
2331             ierr = PetscSectionGetDof(subSection,p,&dof);CHKERRQ(ierr);
2332             for (s = 0; s < dof-cdof; s++) {
2333               if (PetscBTLookupSet(btvt,off+s)) continue;
2334               if (!PetscBTLookup(btv,off+s)) {
2335                 ids[cum++] = off+s;
2336               } else { /* cross-vertex */
2337                 pids[cump++] = off+s;
2338               }
2339             }
2340           }
2341           ierr = DMPlexRestoreTransitiveClosure(dm,cell,PETSC_TRUE,&size,&closure);CHKERRQ(ierr);
2342         }
2343         cids[i+1] = cum;
2344         /* mark dofs as already assigned */
2345         for (j = cids[i]; j < cids[i+1]; j++) {
2346           ierr = PetscBTSet(btv,ids[j]);CHKERRQ(ierr);
2347         }
2348       }
2349       if (cc) {
2350         ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2351         for (i = 0; i < graph->ncc; i++) {
2352           ierr = ISCreateGeneral(PETSC_COMM_SELF,cids[i+1]-cids[i],ids+cids[i],PETSC_COPY_VALUES,&cc_n[i]);CHKERRQ(ierr);
2353         }
2354         *cc = cc_n;
2355       }
2356       if (primalv) {
2357         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),cump,pids,PETSC_COPY_VALUES,primalv);CHKERRQ(ierr);
2358       }
2359       ierr = PetscFree3(ids,cids,pids);CHKERRQ(ierr);
2360       ierr = PetscBTDestroy(&btv);CHKERRQ(ierr);
2361       ierr = PetscBTDestroy(&btvt);CHKERRQ(ierr);
2362     }
2363   } else {
2364     if (ncc) *ncc = graph->ncc;
2365     if (cc) {
2366       ierr = PetscMalloc1(graph->ncc,&cc_n);CHKERRQ(ierr);
2367       for (i=0;i<graph->ncc;i++) {
2368         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);
2369       }
2370       *cc = cc_n;
2371     }
2372   }
2373   /* clean up graph */
2374   graph->xadj = 0;
2375   graph->adjncy = 0;
2376   ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
2377   PetscFunctionReturn(0);
2378 }
2379 
2380 PetscErrorCode PCBDDCBenignCheck(PC pc, IS zerodiag)
2381 {
2382   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2383   PC_IS*         pcis = (PC_IS*)(pc->data);
2384   IS             dirIS = NULL;
2385   PetscInt       i;
2386   PetscErrorCode ierr;
2387 
2388   PetscFunctionBegin;
2389   ierr = PCBDDCGraphGetDirichletDofs(pcbddc->mat_graph,&dirIS);CHKERRQ(ierr);
2390   if (zerodiag) {
2391     Mat            A;
2392     Vec            vec3_N;
2393     PetscScalar    *vals;
2394     const PetscInt *idxs;
2395     PetscInt       nz,*count;
2396 
2397     /* p0 */
2398     ierr = VecSet(pcis->vec1_N,0.);CHKERRQ(ierr);
2399     ierr = PetscMalloc1(pcis->n,&vals);CHKERRQ(ierr);
2400     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2401     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2402     for (i=0;i<nz;i++) vals[i] = 1.;
2403     ierr = VecSetValues(pcis->vec1_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2404     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
2405     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
2406     /* v_I */
2407     ierr = VecSetRandom(pcis->vec2_N,NULL);CHKERRQ(ierr);
2408     for (i=0;i<nz;i++) vals[i] = 0.;
2409     ierr = VecSetValues(pcis->vec2_N,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2410     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2411     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2412     for (i=0;i<pcis->n_B;i++) vals[i] = 0.;
2413     ierr = VecSetValues(pcis->vec2_N,pcis->n_B,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2414     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2415     if (dirIS) {
2416       PetscInt n;
2417 
2418       ierr = ISGetLocalSize(dirIS,&n);CHKERRQ(ierr);
2419       ierr = ISGetIndices(dirIS,&idxs);CHKERRQ(ierr);
2420       for (i=0;i<n;i++) vals[i] = 0.;
2421       ierr = VecSetValues(pcis->vec2_N,n,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2422       ierr = ISRestoreIndices(dirIS,&idxs);CHKERRQ(ierr);
2423     }
2424     ierr = VecAssemblyBegin(pcis->vec2_N);CHKERRQ(ierr);
2425     ierr = VecAssemblyEnd(pcis->vec2_N);CHKERRQ(ierr);
2426     ierr = VecDuplicate(pcis->vec1_N,&vec3_N);CHKERRQ(ierr);
2427     ierr = VecSet(vec3_N,0.);CHKERRQ(ierr);
2428     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2429     ierr = MatMult(A,pcis->vec1_N,vec3_N);CHKERRQ(ierr);
2430     ierr = VecDot(vec3_N,pcis->vec2_N,&vals[0]);CHKERRQ(ierr);
2431     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]));
2432     ierr = PetscFree(vals);CHKERRQ(ierr);
2433     ierr = VecDestroy(&vec3_N);CHKERRQ(ierr);
2434 
2435     /* there should not be any pressure dofs lying on the interface */
2436     ierr = PetscCalloc1(pcis->n,&count);CHKERRQ(ierr);
2437     ierr = ISGetIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2438     for (i=0;i<pcis->n_B;i++) count[idxs[i]]++;
2439     ierr = ISRestoreIndices(pcis->is_B_local,&idxs);CHKERRQ(ierr);
2440     ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2441     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]);
2442     ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2443     ierr = PetscFree(count);CHKERRQ(ierr);
2444   }
2445   ierr = ISDestroy(&dirIS);CHKERRQ(ierr);
2446 
2447   /* check PCBDDCBenignGetOrSetP0 */
2448   ierr = VecSetRandom(pcis->vec1_global,NULL);CHKERRQ(ierr);
2449   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = -PetscGlobalRank-i;
2450   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_FALSE);CHKERRQ(ierr);
2451   for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = 1;
2452   ierr = PCBDDCBenignGetOrSetP0(pc,pcis->vec1_global,PETSC_TRUE);CHKERRQ(ierr);
2453   for (i=0;i<pcbddc->benign_n;i++) {
2454     PetscInt val = PetscRealPart(pcbddc->benign_p0[i]);
2455     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);
2456   }
2457   PetscFunctionReturn(0);
2458 }
2459 
2460 PetscErrorCode PCBDDCBenignDetectSaddlePoint(PC pc, IS *zerodiaglocal)
2461 {
2462   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2463   IS             pressures,zerodiag,zerodiag_save,*zerodiag_subs;
2464   PetscInt       nz,n;
2465   PetscInt       *interior_dofs,n_interior_dofs,nneu;
2466   PetscBool      sorted,have_null,has_null_pressures,recompute_zerodiag,checkb;
2467   PetscErrorCode ierr;
2468 
2469   PetscFunctionBegin;
2470   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
2471   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
2472   for (n=0;n<pcbddc->benign_n;n++) {
2473     ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[n]);CHKERRQ(ierr);
2474   }
2475   ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
2476   pcbddc->benign_n = 0;
2477 
2478   /* if a local info on dofs is present, uses the last field for "pressures" (or fid by command line)
2479      otherwise, it uses only zerodiagonal dofs (ok if the pressure block is all zero; it could fail if it is not)
2480      Checks if all the pressure dofs in each subdomain have a zero diagonal
2481      If not, a change of basis on pressures is not needed
2482      since the local Schur complements are already SPD
2483   */
2484   has_null_pressures = PETSC_TRUE;
2485   have_null = PETSC_TRUE;
2486   if (pcbddc->n_ISForDofsLocal) {
2487     IS       iP = NULL;
2488     PetscInt npl,*idxs,p = pcbddc->n_ISForDofsLocal-1;
2489 
2490     ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)pc),((PetscObject)pc)->prefix,"BDDC benign options","PC");CHKERRQ(ierr);
2491     ierr = PetscOptionsInt("-pc_bddc_pressure_field","Field id for pressures",NULL,p,&p,NULL);CHKERRQ(ierr);
2492     ierr = PetscOptionsEnd();CHKERRQ(ierr);
2493     if (p < 0 || p > pcbddc->n_ISForDofsLocal-1) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Invalid field id for pressures %D",p);
2494     /* Dofs splitting for BDDC cannot have PETSC_COMM_SELF, so create a sequential IS */
2495     ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[p],&npl);CHKERRQ(ierr);
2496     ierr = ISGetIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2497     ierr = ISCreateGeneral(PETSC_COMM_SELF,npl,idxs,PETSC_COPY_VALUES,&pressures);CHKERRQ(ierr);
2498     ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[p],(const PetscInt**)&idxs);CHKERRQ(ierr);
2499     /* remove zeroed out pressures if we are setting up a BDDC solver for a saddle-point FETI-DP */
2500     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lP",(PetscObject*)&iP);CHKERRQ(ierr);
2501     if (iP) {
2502       IS newpressures;
2503 
2504       ierr = ISDifference(pressures,iP,&newpressures);CHKERRQ(ierr);
2505       ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2506       pressures = newpressures;
2507     }
2508     ierr = ISSorted(pressures,&sorted);CHKERRQ(ierr);
2509     if (!sorted) {
2510       ierr = ISSort(pressures);CHKERRQ(ierr);
2511     }
2512   } else {
2513     pressures = NULL;
2514   }
2515   /* pcis has not been setup yet, so get the local size from the subdomain matrix */
2516   ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2517   if (!n) pcbddc->benign_change_explicit = PETSC_TRUE;
2518   ierr = MatFindZeroDiagonals(pcbddc->local_mat,&zerodiag);CHKERRQ(ierr);
2519   ierr = ISSorted(zerodiag,&sorted);CHKERRQ(ierr);
2520   if (!sorted) {
2521     ierr = ISSort(zerodiag);CHKERRQ(ierr);
2522   }
2523   ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2524   zerodiag_save = zerodiag;
2525   ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2526   if (!nz) {
2527     if (n) have_null = PETSC_FALSE;
2528     has_null_pressures = PETSC_FALSE;
2529     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2530   }
2531   recompute_zerodiag = PETSC_FALSE;
2532   /* in case disconnected subdomains info is present, split the pressures accordingly (otherwise the benign trick could fail) */
2533   zerodiag_subs    = NULL;
2534   pcbddc->benign_n = 0;
2535   n_interior_dofs  = 0;
2536   interior_dofs    = NULL;
2537   nneu             = 0;
2538   if (pcbddc->NeumannBoundariesLocal) {
2539     ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&nneu);CHKERRQ(ierr);
2540   }
2541   checkb = (PetscBool)(!pcbddc->NeumannBoundariesLocal || pcbddc->current_level);
2542   if (checkb) { /* need to compute interior nodes */
2543     PetscInt n,i,j;
2544     PetscInt n_neigh,*neigh,*n_shared,**shared;
2545     PetscInt *iwork;
2546 
2547     ierr = ISLocalToGlobalMappingGetSize(pc->pmat->rmap->mapping,&n);CHKERRQ(ierr);
2548     ierr = ISLocalToGlobalMappingGetInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2549     ierr = PetscCalloc1(n,&iwork);CHKERRQ(ierr);
2550     ierr = PetscMalloc1(n,&interior_dofs);CHKERRQ(ierr);
2551     for (i=1;i<n_neigh;i++)
2552       for (j=0;j<n_shared[i];j++)
2553           iwork[shared[i][j]] += 1;
2554     for (i=0;i<n;i++)
2555       if (!iwork[i])
2556         interior_dofs[n_interior_dofs++] = i;
2557     ierr = PetscFree(iwork);CHKERRQ(ierr);
2558     ierr = ISLocalToGlobalMappingRestoreInfo(pc->pmat->rmap->mapping,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
2559   }
2560   if (has_null_pressures) {
2561     IS             *subs;
2562     PetscInt       nsubs,i,j,nl;
2563     const PetscInt *idxs;
2564     PetscScalar    *array;
2565     Vec            *work;
2566     Mat_IS*        matis = (Mat_IS*)(pc->pmat->data);
2567 
2568     subs  = pcbddc->local_subs;
2569     nsubs = pcbddc->n_local_subs;
2570     /* 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) */
2571     if (checkb) {
2572       ierr = VecDuplicateVecs(matis->y,2,&work);CHKERRQ(ierr);
2573       ierr = ISGetLocalSize(zerodiag,&nl);CHKERRQ(ierr);
2574       ierr = ISGetIndices(zerodiag,&idxs);CHKERRQ(ierr);
2575       /* work[0] = 1_p */
2576       ierr = VecSet(work[0],0.);CHKERRQ(ierr);
2577       ierr = VecGetArray(work[0],&array);CHKERRQ(ierr);
2578       for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2579       ierr = VecRestoreArray(work[0],&array);CHKERRQ(ierr);
2580       /* work[0] = 1_v */
2581       ierr = VecSet(work[1],1.);CHKERRQ(ierr);
2582       ierr = VecGetArray(work[1],&array);CHKERRQ(ierr);
2583       for (j=0;j<nl;j++) array[idxs[j]] = 0.;
2584       ierr = VecRestoreArray(work[1],&array);CHKERRQ(ierr);
2585       ierr = ISRestoreIndices(zerodiag,&idxs);CHKERRQ(ierr);
2586     }
2587     if (nsubs > 1) {
2588       ierr = PetscCalloc1(nsubs,&zerodiag_subs);CHKERRQ(ierr);
2589       for (i=0;i<nsubs;i++) {
2590         ISLocalToGlobalMapping l2g;
2591         IS                     t_zerodiag_subs;
2592         PetscInt               nl;
2593 
2594         ierr = ISLocalToGlobalMappingCreateIS(subs[i],&l2g);CHKERRQ(ierr);
2595         ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,zerodiag,&t_zerodiag_subs);CHKERRQ(ierr);
2596         ierr = ISGetLocalSize(t_zerodiag_subs,&nl);CHKERRQ(ierr);
2597         if (nl) {
2598           PetscBool valid = PETSC_TRUE;
2599 
2600           if (checkb) {
2601             ierr = VecSet(matis->x,0);CHKERRQ(ierr);
2602             ierr = ISGetLocalSize(subs[i],&nl);CHKERRQ(ierr);
2603             ierr = ISGetIndices(subs[i],&idxs);CHKERRQ(ierr);
2604             ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2605             for (j=0;j<nl;j++) array[idxs[j]] = 1.;
2606             ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2607             ierr = ISRestoreIndices(subs[i],&idxs);CHKERRQ(ierr);
2608             ierr = VecPointwiseMult(matis->x,work[0],matis->x);CHKERRQ(ierr);
2609             ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2610             ierr = VecPointwiseMult(matis->y,work[1],matis->y);CHKERRQ(ierr);
2611             ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2612             for (j=0;j<n_interior_dofs;j++) {
2613               if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2614                 valid = PETSC_FALSE;
2615                 break;
2616               }
2617             }
2618             ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2619           }
2620           if (valid && nneu) {
2621             const PetscInt *idxs;
2622             PetscInt       nzb;
2623 
2624             ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2625             ierr = ISGlobalToLocalMappingApply(l2g,IS_GTOLM_DROP,nneu,idxs,&nzb,NULL);CHKERRQ(ierr);
2626             ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
2627             if (nzb) valid = PETSC_FALSE;
2628           }
2629           if (valid && pressures) {
2630             IS t_pressure_subs;
2631             ierr = ISGlobalToLocalMappingApplyIS(l2g,IS_GTOLM_DROP,pressures,&t_pressure_subs);CHKERRQ(ierr);
2632             ierr = ISEqual(t_pressure_subs,t_zerodiag_subs,&valid);CHKERRQ(ierr);
2633             ierr = ISDestroy(&t_pressure_subs);CHKERRQ(ierr);
2634           }
2635           if (valid) {
2636             ierr = ISLocalToGlobalMappingApplyIS(l2g,t_zerodiag_subs,&zerodiag_subs[pcbddc->benign_n]);CHKERRQ(ierr);
2637             pcbddc->benign_n++;
2638           } else {
2639             recompute_zerodiag = PETSC_TRUE;
2640           }
2641         }
2642         ierr = ISDestroy(&t_zerodiag_subs);CHKERRQ(ierr);
2643         ierr = ISLocalToGlobalMappingDestroy(&l2g);CHKERRQ(ierr);
2644       }
2645     } else { /* there's just one subdomain (or zero if they have not been detected */
2646       PetscBool valid = PETSC_TRUE;
2647 
2648       if (nneu) valid = PETSC_FALSE;
2649       if (valid && pressures) {
2650         ierr = ISEqual(pressures,zerodiag,&valid);CHKERRQ(ierr);
2651       }
2652       if (valid && checkb) {
2653         ierr = MatMult(matis->A,work[0],matis->x);CHKERRQ(ierr);
2654         ierr = VecPointwiseMult(matis->x,work[1],matis->x);CHKERRQ(ierr);
2655         ierr = VecGetArray(matis->x,&array);CHKERRQ(ierr);
2656         for (j=0;j<n_interior_dofs;j++) {
2657           if (PetscAbsScalar(array[interior_dofs[j]]) > PETSC_SMALL) {
2658             valid = PETSC_FALSE;
2659             break;
2660           }
2661         }
2662         ierr = VecRestoreArray(matis->x,&array);CHKERRQ(ierr);
2663       }
2664       if (valid) {
2665         pcbddc->benign_n = 1;
2666         ierr = PetscMalloc1(pcbddc->benign_n,&zerodiag_subs);CHKERRQ(ierr);
2667         ierr = PetscObjectReference((PetscObject)zerodiag);CHKERRQ(ierr);
2668         zerodiag_subs[0] = zerodiag;
2669       }
2670     }
2671     if (checkb) {
2672       ierr = VecDestroyVecs(2,&work);CHKERRQ(ierr);
2673     }
2674   }
2675   ierr = PetscFree(interior_dofs);CHKERRQ(ierr);
2676 
2677   if (!pcbddc->benign_n) {
2678     PetscInt n;
2679 
2680     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2681     recompute_zerodiag = PETSC_FALSE;
2682     ierr = MatGetLocalSize(pcbddc->local_mat,&n,NULL);CHKERRQ(ierr);
2683     if (n) {
2684       has_null_pressures = PETSC_FALSE;
2685       have_null = PETSC_FALSE;
2686     }
2687   }
2688 
2689   /* final check for null pressures */
2690   if (zerodiag && pressures) {
2691     PetscInt nz,np;
2692     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2693     ierr = ISGetLocalSize(pressures,&np);CHKERRQ(ierr);
2694     if (nz != np) have_null = PETSC_FALSE;
2695   }
2696 
2697   if (recompute_zerodiag) {
2698     ierr = ISDestroy(&zerodiag);CHKERRQ(ierr);
2699     if (pcbddc->benign_n == 1) {
2700       ierr = PetscObjectReference((PetscObject)zerodiag_subs[0]);CHKERRQ(ierr);
2701       zerodiag = zerodiag_subs[0];
2702     } else {
2703       PetscInt i,nzn,*new_idxs;
2704 
2705       nzn = 0;
2706       for (i=0;i<pcbddc->benign_n;i++) {
2707         PetscInt ns;
2708         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2709         nzn += ns;
2710       }
2711       ierr = PetscMalloc1(nzn,&new_idxs);CHKERRQ(ierr);
2712       nzn = 0;
2713       for (i=0;i<pcbddc->benign_n;i++) {
2714         PetscInt ns,*idxs;
2715         ierr = ISGetLocalSize(zerodiag_subs[i],&ns);CHKERRQ(ierr);
2716         ierr = ISGetIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2717         ierr = PetscMemcpy(new_idxs+nzn,idxs,ns*sizeof(PetscInt));CHKERRQ(ierr);
2718         ierr = ISRestoreIndices(zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2719         nzn += ns;
2720       }
2721       ierr = PetscSortInt(nzn,new_idxs);CHKERRQ(ierr);
2722       ierr = ISCreateGeneral(PETSC_COMM_SELF,nzn,new_idxs,PETSC_OWN_POINTER,&zerodiag);CHKERRQ(ierr);
2723     }
2724     have_null = PETSC_FALSE;
2725   }
2726 
2727   /* Prepare matrix to compute no-net-flux */
2728   if (pcbddc->compute_nonetflux && !pcbddc->divudotp) {
2729     Mat                    A,loc_divudotp;
2730     ISLocalToGlobalMapping rl2g,cl2g,l2gmap;
2731     IS                     row,col,isused = NULL;
2732     PetscInt               M,N,n,st,n_isused;
2733 
2734     if (pressures) {
2735       isused = pressures;
2736     } else {
2737       isused = zerodiag_save;
2738     }
2739     ierr = MatGetLocalToGlobalMapping(pc->pmat,&l2gmap,NULL);CHKERRQ(ierr);
2740     ierr = MatISGetLocalMat(pc->pmat,&A);CHKERRQ(ierr);
2741     ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
2742     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");
2743     n_isused = 0;
2744     if (isused) {
2745       ierr = ISGetLocalSize(isused,&n_isused);CHKERRQ(ierr);
2746     }
2747     ierr = MPI_Scan(&n_isused,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2748     st = st-n_isused;
2749     if (n) {
2750       const PetscInt *gidxs;
2751 
2752       ierr = MatCreateSubMatrix(A,isused,NULL,MAT_INITIAL_MATRIX,&loc_divudotp);CHKERRQ(ierr);
2753       ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2754       /* TODO: extend ISCreateStride with st = PETSC_DECIDE */
2755       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2756       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2757       ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
2758     } else {
2759       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&loc_divudotp);CHKERRQ(ierr);
2760       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),n_isused,st,1,&row);CHKERRQ(ierr);
2761       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),0,NULL,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
2762     }
2763     ierr = MatGetSize(pc->pmat,NULL,&N);CHKERRQ(ierr);
2764     ierr = ISGetSize(row,&M);CHKERRQ(ierr);
2765     ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
2766     ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
2767     ierr = ISDestroy(&row);CHKERRQ(ierr);
2768     ierr = ISDestroy(&col);CHKERRQ(ierr);
2769     ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->divudotp);CHKERRQ(ierr);
2770     ierr = MatSetType(pcbddc->divudotp,MATIS);CHKERRQ(ierr);
2771     ierr = MatSetSizes(pcbddc->divudotp,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
2772     ierr = MatSetLocalToGlobalMapping(pcbddc->divudotp,rl2g,cl2g);CHKERRQ(ierr);
2773     ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
2774     ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
2775     ierr = MatISSetLocalMat(pcbddc->divudotp,loc_divudotp);CHKERRQ(ierr);
2776     ierr = MatDestroy(&loc_divudotp);CHKERRQ(ierr);
2777     ierr = MatAssemblyBegin(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2778     ierr = MatAssemblyEnd(pcbddc->divudotp,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2779   }
2780   ierr = ISDestroy(&zerodiag_save);CHKERRQ(ierr);
2781 
2782   /* change of basis and p0 dofs */
2783   if (has_null_pressures) {
2784     IS             zerodiagc;
2785     const PetscInt *idxs,*idxsc;
2786     PetscInt       i,s,*nnz;
2787 
2788     ierr = ISGetLocalSize(zerodiag,&nz);CHKERRQ(ierr);
2789     ierr = ISComplement(zerodiag,0,n,&zerodiagc);CHKERRQ(ierr);
2790     ierr = ISGetIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2791     /* local change of basis for pressures */
2792     ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
2793     ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_change);CHKERRQ(ierr);
2794     ierr = MatSetType(pcbddc->benign_change,MATAIJ);CHKERRQ(ierr);
2795     ierr = MatSetSizes(pcbddc->benign_change,n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2796     ierr = PetscMalloc1(n,&nnz);CHKERRQ(ierr);
2797     for (i=0;i<n-nz;i++) nnz[idxsc[i]] = 1; /* identity on velocities plus pressure dofs for non-singular subdomains */
2798     for (i=0;i<pcbddc->benign_n;i++) {
2799       PetscInt nzs,j;
2800 
2801       ierr = ISGetLocalSize(zerodiag_subs[i],&nzs);CHKERRQ(ierr);
2802       ierr = ISGetIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2803       for (j=0;j<nzs-1;j++) nnz[idxs[j]] = 2; /* change on pressures */
2804       nnz[idxs[nzs-1]] = nzs; /* last local pressure dof in subdomain */
2805       ierr = ISRestoreIndices(zerodiag_subs[i],&idxs);CHKERRQ(ierr);
2806     }
2807     ierr = MatSeqAIJSetPreallocation(pcbddc->benign_change,0,nnz);CHKERRQ(ierr);
2808     ierr = PetscFree(nnz);CHKERRQ(ierr);
2809     /* set identity on velocities */
2810     for (i=0;i<n-nz;i++) {
2811       ierr = MatSetValue(pcbddc->benign_change,idxsc[i],idxsc[i],1.,INSERT_VALUES);CHKERRQ(ierr);
2812     }
2813     ierr = ISRestoreIndices(zerodiagc,&idxsc);CHKERRQ(ierr);
2814     ierr = ISDestroy(&zerodiagc);CHKERRQ(ierr);
2815     ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
2816     ierr = PetscMalloc3(pcbddc->benign_n,&pcbddc->benign_p0_lidx,pcbddc->benign_n,&pcbddc->benign_p0_gidx,pcbddc->benign_n,&pcbddc->benign_p0);CHKERRQ(ierr);
2817     /* set change on pressures */
2818     for (s=0;s<pcbddc->benign_n;s++) {
2819       PetscScalar *array;
2820       PetscInt    nzs;
2821 
2822       ierr = ISGetLocalSize(zerodiag_subs[s],&nzs);CHKERRQ(ierr);
2823       ierr = ISGetIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2824       for (i=0;i<nzs-1;i++) {
2825         PetscScalar vals[2];
2826         PetscInt    cols[2];
2827 
2828         cols[0] = idxs[i];
2829         cols[1] = idxs[nzs-1];
2830         vals[0] = 1.;
2831         vals[1] = 1.;
2832         ierr = MatSetValues(pcbddc->benign_change,1,cols,2,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
2833       }
2834       ierr = PetscMalloc1(nzs,&array);CHKERRQ(ierr);
2835       for (i=0;i<nzs-1;i++) array[i] = -1.;
2836       array[nzs-1] = 1.;
2837       ierr = MatSetValues(pcbddc->benign_change,1,idxs+nzs-1,nzs,idxs,array,INSERT_VALUES);CHKERRQ(ierr);
2838       /* store local idxs for p0 */
2839       pcbddc->benign_p0_lidx[s] = idxs[nzs-1];
2840       ierr = ISRestoreIndices(zerodiag_subs[s],&idxs);CHKERRQ(ierr);
2841       ierr = PetscFree(array);CHKERRQ(ierr);
2842     }
2843     ierr = MatAssemblyBegin(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2844     ierr = MatAssemblyEnd(pcbddc->benign_change,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2845     /* project if needed */
2846     if (pcbddc->benign_change_explicit) {
2847       Mat M;
2848 
2849       ierr = MatPtAP(pcbddc->local_mat,pcbddc->benign_change,MAT_INITIAL_MATRIX,2.0,&M);CHKERRQ(ierr);
2850       ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
2851       ierr = MatSeqAIJCompress(M,&pcbddc->local_mat);CHKERRQ(ierr);
2852       ierr = MatDestroy(&M);CHKERRQ(ierr);
2853     }
2854     /* store global idxs for p0 */
2855     ierr = ISLocalToGlobalMappingApply(pc->pmat->rmap->mapping,pcbddc->benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2856   }
2857   pcbddc->benign_zerodiag_subs = zerodiag_subs;
2858   ierr = ISDestroy(&pressures);CHKERRQ(ierr);
2859 
2860   /* determines if the coarse solver will be singular or not */
2861   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_null,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2862   /* determines if the problem has subdomains with 0 pressure block */
2863   have_null = (PetscBool)(!!pcbddc->benign_n);
2864   ierr = MPI_Allreduce(&have_null,&pcbddc->benign_have_null,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
2865   *zerodiaglocal = zerodiag;
2866   PetscFunctionReturn(0);
2867 }
2868 
2869 PetscErrorCode PCBDDCBenignGetOrSetP0(PC pc, Vec v, PetscBool get)
2870 {
2871   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2872   PetscScalar    *array;
2873   PetscErrorCode ierr;
2874 
2875   PetscFunctionBegin;
2876   if (!pcbddc->benign_sf) {
2877     ierr = PetscSFCreate(PetscObjectComm((PetscObject)pc),&pcbddc->benign_sf);CHKERRQ(ierr);
2878     ierr = PetscSFSetGraphLayout(pcbddc->benign_sf,pc->pmat->rmap,pcbddc->benign_n,NULL,PETSC_OWN_POINTER,pcbddc->benign_p0_gidx);CHKERRQ(ierr);
2879   }
2880   if (get) {
2881     ierr = VecGetArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2882     ierr = PetscSFBcastBegin(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2883     ierr = PetscSFBcastEnd(pcbddc->benign_sf,MPIU_SCALAR,array,pcbddc->benign_p0);CHKERRQ(ierr);
2884     ierr = VecRestoreArrayRead(v,(const PetscScalar**)&array);CHKERRQ(ierr);
2885   } else {
2886     ierr = VecGetArray(v,&array);CHKERRQ(ierr);
2887     ierr = PetscSFReduceBegin(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2888     ierr = PetscSFReduceEnd(pcbddc->benign_sf,MPIU_SCALAR,pcbddc->benign_p0,array,MPIU_REPLACE);CHKERRQ(ierr);
2889     ierr = VecRestoreArray(v,&array);CHKERRQ(ierr);
2890   }
2891   PetscFunctionReturn(0);
2892 }
2893 
2894 PetscErrorCode PCBDDCBenignPopOrPushB0(PC pc, PetscBool pop)
2895 {
2896   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
2897   PetscErrorCode ierr;
2898 
2899   PetscFunctionBegin;
2900   /* TODO: add error checking
2901     - avoid nested pop (or push) calls.
2902     - cannot push before pop.
2903     - cannot call this if pcbddc->local_mat is NULL
2904   */
2905   if (!pcbddc->benign_n) {
2906     PetscFunctionReturn(0);
2907   }
2908   if (pop) {
2909     if (pcbddc->benign_change_explicit) {
2910       IS       is_p0;
2911       MatReuse reuse;
2912 
2913       /* extract B_0 */
2914       reuse = MAT_INITIAL_MATRIX;
2915       if (pcbddc->benign_B0) {
2916         reuse = MAT_REUSE_MATRIX;
2917       }
2918       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->benign_n,pcbddc->benign_p0_lidx,PETSC_COPY_VALUES,&is_p0);CHKERRQ(ierr);
2919       ierr = MatCreateSubMatrix(pcbddc->local_mat,is_p0,NULL,reuse,&pcbddc->benign_B0);CHKERRQ(ierr);
2920       /* remove rows and cols from local problem */
2921       ierr = MatSetOption(pcbddc->local_mat,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE);CHKERRQ(ierr);
2922       ierr = MatSetOption(pcbddc->local_mat,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
2923       ierr = MatZeroRowsColumnsIS(pcbddc->local_mat,is_p0,1.0,NULL,NULL);CHKERRQ(ierr);
2924       ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
2925     } else {
2926       Mat_IS      *matis = (Mat_IS*)pc->pmat->data;
2927       PetscScalar *vals;
2928       PetscInt    i,n,*idxs_ins;
2929 
2930       ierr = VecGetLocalSize(matis->y,&n);CHKERRQ(ierr);
2931       ierr = PetscMalloc2(n,&idxs_ins,n,&vals);CHKERRQ(ierr);
2932       if (!pcbddc->benign_B0) {
2933         PetscInt *nnz;
2934         ierr = MatCreate(PetscObjectComm((PetscObject)pcbddc->local_mat),&pcbddc->benign_B0);CHKERRQ(ierr);
2935         ierr = MatSetType(pcbddc->benign_B0,MATAIJ);CHKERRQ(ierr);
2936         ierr = MatSetSizes(pcbddc->benign_B0,pcbddc->benign_n,n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
2937         ierr = PetscMalloc1(pcbddc->benign_n,&nnz);CHKERRQ(ierr);
2938         for (i=0;i<pcbddc->benign_n;i++) {
2939           ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nnz[i]);CHKERRQ(ierr);
2940           nnz[i] = n - nnz[i];
2941         }
2942         ierr = MatSeqAIJSetPreallocation(pcbddc->benign_B0,0,nnz);CHKERRQ(ierr);
2943         ierr = PetscFree(nnz);CHKERRQ(ierr);
2944       }
2945 
2946       for (i=0;i<pcbddc->benign_n;i++) {
2947         PetscScalar *array;
2948         PetscInt    *idxs,j,nz,cum;
2949 
2950         ierr = VecSet(matis->x,0.);CHKERRQ(ierr);
2951         ierr = ISGetLocalSize(pcbddc->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
2952         ierr = ISGetIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2953         for (j=0;j<nz;j++) vals[j] = 1.;
2954         ierr = VecSetValues(matis->x,nz,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
2955         ierr = VecAssemblyBegin(matis->x);CHKERRQ(ierr);
2956         ierr = VecAssemblyEnd(matis->x);CHKERRQ(ierr);
2957         ierr = VecSet(matis->y,0.);CHKERRQ(ierr);
2958         ierr = MatMult(matis->A,matis->x,matis->y);CHKERRQ(ierr);
2959         ierr = VecGetArray(matis->y,&array);CHKERRQ(ierr);
2960         cum = 0;
2961         for (j=0;j<n;j++) {
2962           if (PetscUnlikely(PetscAbsScalar(array[j]) > PETSC_SMALL)) {
2963             vals[cum] = array[j];
2964             idxs_ins[cum] = j;
2965             cum++;
2966           }
2967         }
2968         ierr = MatSetValues(pcbddc->benign_B0,1,&i,cum,idxs_ins,vals,INSERT_VALUES);CHKERRQ(ierr);
2969         ierr = VecRestoreArray(matis->y,&array);CHKERRQ(ierr);
2970         ierr = ISRestoreIndices(pcbddc->benign_zerodiag_subs[i],(const PetscInt**)&idxs);CHKERRQ(ierr);
2971       }
2972       ierr = MatAssemblyBegin(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2973       ierr = MatAssemblyEnd(pcbddc->benign_B0,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2974       ierr = PetscFree2(idxs_ins,vals);CHKERRQ(ierr);
2975     }
2976   } else { /* push */
2977     if (pcbddc->benign_change_explicit) {
2978       PetscInt i;
2979 
2980       for (i=0;i<pcbddc->benign_n;i++) {
2981         PetscScalar *B0_vals;
2982         PetscInt    *B0_cols,B0_ncol;
2983 
2984         ierr = MatGetRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2985         ierr = MatSetValues(pcbddc->local_mat,1,pcbddc->benign_p0_lidx+i,B0_ncol,B0_cols,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2986         ierr = MatSetValues(pcbddc->local_mat,B0_ncol,B0_cols,1,pcbddc->benign_p0_lidx+i,B0_vals,INSERT_VALUES);CHKERRQ(ierr);
2987         ierr = MatSetValue(pcbddc->local_mat,pcbddc->benign_p0_lidx[i],pcbddc->benign_p0_lidx[i],0.0,INSERT_VALUES);CHKERRQ(ierr);
2988         ierr = MatRestoreRow(pcbddc->benign_B0,i,&B0_ncol,(const PetscInt**)&B0_cols,(const PetscScalar**)&B0_vals);CHKERRQ(ierr);
2989       }
2990       ierr = MatAssemblyBegin(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2991       ierr = MatAssemblyEnd(pcbddc->local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
2992     } else {
2993       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Cannot push B0!\n");
2994     }
2995   }
2996   PetscFunctionReturn(0);
2997 }
2998 
2999 PetscErrorCode PCBDDCAdaptiveSelection(PC pc)
3000 {
3001   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3002   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3003   PetscBLASInt    B_dummyint,B_neigs,B_ierr,B_lwork;
3004   PetscBLASInt    *B_iwork,*B_ifail;
3005   PetscScalar     *work,lwork;
3006   PetscScalar     *St,*S,*eigv;
3007   PetscScalar     *Sarray,*Starray;
3008   PetscReal       *eigs,thresh,lthresh,uthresh;
3009   PetscInt        i,nmax,nmin,nv,cum,mss,cum2,cumarray,maxneigs;
3010   PetscBool       allocated_S_St;
3011 #if defined(PETSC_USE_COMPLEX)
3012   PetscReal       *rwork;
3013 #endif
3014   PetscErrorCode  ierr;
3015 
3016   PetscFunctionBegin;
3017   if (!sub_schurs) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Adaptive selection of constraints requires SubSchurs data");
3018   if (!sub_schurs->schur_explicit) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Adaptive selection of constraints requires MUMPS and/or MKL_CPARDISO");
3019   if (sub_schurs->n_subs && (!sub_schurs->is_symmetric)) SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_SUP,"Adaptive selection not yet implemented for this matrix pencil (herm %d, symm %d, posdef %d)",sub_schurs->is_hermitian,sub_schurs->is_symmetric,sub_schurs->is_posdef);
3020 
3021   if (pcbddc->dbg_flag) {
3022     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3023     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
3024     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check adaptive selection of constraints\n");CHKERRQ(ierr);
3025     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
3026   }
3027 
3028   if (pcbddc->dbg_flag) {
3029     PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d cc %d (%d,%d).\n",PetscGlobalRank,sub_schurs->n_subs,sub_schurs->is_hermitian,sub_schurs->is_posdef);
3030   }
3031 
3032   /* max size of subsets */
3033   mss = 0;
3034   for (i=0;i<sub_schurs->n_subs;i++) {
3035     PetscInt subset_size;
3036 
3037     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3038     mss = PetscMax(mss,subset_size);
3039   }
3040 
3041   /* min/max and threshold */
3042   nmax = pcbddc->adaptive_nmax > 0 ? pcbddc->adaptive_nmax : mss;
3043   nmin = pcbddc->adaptive_nmin > 0 ? pcbddc->adaptive_nmin : 0;
3044   nmax = PetscMax(nmin,nmax);
3045   allocated_S_St = PETSC_FALSE;
3046   if (nmin || !sub_schurs->is_posdef) { /* XXX */
3047     allocated_S_St = PETSC_TRUE;
3048   }
3049 
3050   /* allocate lapack workspace */
3051   cum = cum2 = 0;
3052   maxneigs = 0;
3053   for (i=0;i<sub_schurs->n_subs;i++) {
3054     PetscInt n,subset_size;
3055 
3056     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3057     n = PetscMin(subset_size,nmax);
3058     cum += subset_size;
3059     cum2 += subset_size*n;
3060     maxneigs = PetscMax(maxneigs,n);
3061   }
3062   if (mss) {
3063     if (sub_schurs->is_symmetric) {
3064       PetscBLASInt B_itype = 1;
3065       PetscBLASInt B_N = mss;
3066       PetscReal    zero = 0.0;
3067       PetscReal    eps = 0.0; /* dlamch? */
3068 
3069       B_lwork = -1;
3070       S = NULL;
3071       St = NULL;
3072       eigs = NULL;
3073       eigv = NULL;
3074       B_iwork = NULL;
3075       B_ifail = NULL;
3076 #if defined(PETSC_USE_COMPLEX)
3077       rwork = NULL;
3078 #endif
3079       thresh = 1.0;
3080       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3081 #if defined(PETSC_USE_COMPLEX)
3082       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));
3083 #else
3084       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));
3085 #endif
3086       if (B_ierr != 0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYGVX Lapack routine %d",(int)B_ierr);
3087       ierr = PetscFPTrapPop();CHKERRQ(ierr);
3088     } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3089   } else {
3090     lwork = 0;
3091   }
3092 
3093   nv = 0;
3094   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) */
3095     ierr = ISGetLocalSize(sub_schurs->is_vertices,&nv);CHKERRQ(ierr);
3096   }
3097   ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lwork),&B_lwork);CHKERRQ(ierr);
3098   if (allocated_S_St) {
3099     ierr = PetscMalloc2(mss*mss,&S,mss*mss,&St);CHKERRQ(ierr);
3100   }
3101   ierr = PetscMalloc5(mss*mss,&eigv,mss,&eigs,B_lwork,&work,5*mss,&B_iwork,mss,&B_ifail);CHKERRQ(ierr);
3102 #if defined(PETSC_USE_COMPLEX)
3103   ierr = PetscMalloc1(7*mss,&rwork);CHKERRQ(ierr);
3104 #endif
3105   ierr = PetscMalloc5(nv+sub_schurs->n_subs,&pcbddc->adaptive_constraints_n,
3106                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_idxs_ptr,
3107                       nv+sub_schurs->n_subs+1,&pcbddc->adaptive_constraints_data_ptr,
3108                       nv+cum,&pcbddc->adaptive_constraints_idxs,
3109                       nv+cum2,&pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
3110   ierr = PetscMemzero(pcbddc->adaptive_constraints_n,(nv+sub_schurs->n_subs)*sizeof(PetscInt));CHKERRQ(ierr);
3111 
3112   maxneigs = 0;
3113   cum = cumarray = 0;
3114   pcbddc->adaptive_constraints_idxs_ptr[0] = 0;
3115   pcbddc->adaptive_constraints_data_ptr[0] = 0;
3116   if (sub_schurs->is_vertices && pcbddc->use_vertices) {
3117     const PetscInt *idxs;
3118 
3119     ierr = ISGetIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3120     for (cum=0;cum<nv;cum++) {
3121       pcbddc->adaptive_constraints_n[cum] = 1;
3122       pcbddc->adaptive_constraints_idxs[cum] = idxs[cum];
3123       pcbddc->adaptive_constraints_data[cum] = 1.0;
3124       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum]+1;
3125       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum]+1;
3126     }
3127     ierr = ISRestoreIndices(sub_schurs->is_vertices,&idxs);CHKERRQ(ierr);
3128   }
3129 
3130   if (mss) { /* multilevel */
3131     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3132     ierr = MatSeqAIJGetArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3133   }
3134 
3135   lthresh = pcbddc->adaptive_threshold[0];
3136   uthresh = pcbddc->adaptive_threshold[1];
3137   for (i=0;i<sub_schurs->n_subs;i++) {
3138     const PetscInt *idxs;
3139     PetscReal      upper,lower;
3140     PetscInt       j,subset_size,eigs_start = 0;
3141     PetscBLASInt   B_N;
3142     PetscBool      same_data = PETSC_FALSE;
3143     PetscBool      scal = PETSC_FALSE;
3144 
3145     if (pcbddc->use_deluxe_scaling) {
3146       upper = PETSC_MAX_REAL;
3147       lower = uthresh;
3148     } else {
3149       if (!sub_schurs->is_posdef) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented without deluxe scaling");
3150       upper = 1./uthresh;
3151       lower = 0.;
3152     }
3153     ierr = ISGetLocalSize(sub_schurs->is_subs[i],&subset_size);CHKERRQ(ierr);
3154     ierr = ISGetIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3155     ierr = PetscBLASIntCast(subset_size,&B_N);CHKERRQ(ierr);
3156     /* this is experimental: we assume the dofs have been properly grouped to have
3157        the diagonal blocks Schur complements either positive or negative definite (true for Stokes) */
3158     if (!sub_schurs->is_posdef) {
3159       Mat T;
3160 
3161       for (j=0;j<subset_size;j++) {
3162         if (PetscRealPart(*(Sarray+cumarray+j*(subset_size+1))) < 0.0) {
3163           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Sarray+cumarray,&T);CHKERRQ(ierr);
3164           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3165           ierr = MatDestroy(&T);CHKERRQ(ierr);
3166           ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,subset_size,Starray+cumarray,&T);CHKERRQ(ierr);
3167           ierr = MatScale(T,-1.0);CHKERRQ(ierr);
3168           ierr = MatDestroy(&T);CHKERRQ(ierr);
3169           if (sub_schurs->change_primal_sub) {
3170             PetscInt       nz,k;
3171             const PetscInt *idxs;
3172 
3173             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nz);CHKERRQ(ierr);
3174             ierr = ISGetIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3175             for (k=0;k<nz;k++) {
3176               *( Sarray + cumarray + idxs[k]*(subset_size+1)) *= -1.0;
3177               *(Starray + cumarray + idxs[k]*(subset_size+1))  = 0.0;
3178             }
3179             ierr = ISRestoreIndices(sub_schurs->change_primal_sub[i],&idxs);CHKERRQ(ierr);
3180           }
3181           scal = PETSC_TRUE;
3182           break;
3183         }
3184       }
3185     }
3186 
3187     if (allocated_S_St) { /* S and S_t should be copied since we could need them later */
3188       if (sub_schurs->is_symmetric) {
3189         PetscInt j,k;
3190         if (sub_schurs->n_subs == 1) { /* zeroing memory to use PetscMemcmp later */
3191           ierr = PetscMemzero(S,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3192           ierr = PetscMemzero(St,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3193         }
3194         for (j=0;j<subset_size;j++) {
3195           for (k=j;k<subset_size;k++) {
3196             S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3197             St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3198           }
3199         }
3200       } else {
3201         ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3202         ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3203       }
3204     } else {
3205       S = Sarray + cumarray;
3206       St = Starray + cumarray;
3207     }
3208     /* see if we can save some work */
3209     if (sub_schurs->n_subs == 1 && pcbddc->use_deluxe_scaling) {
3210       ierr = PetscMemcmp(S,St,subset_size*subset_size*sizeof(PetscScalar),&same_data);CHKERRQ(ierr);
3211     }
3212 
3213     if (same_data && !sub_schurs->change) { /* there's no need of constraints here */
3214       B_neigs = 0;
3215     } else {
3216       if (sub_schurs->is_symmetric) {
3217         PetscBLASInt B_itype = 1;
3218         PetscBLASInt B_IL, B_IU;
3219         PetscReal    eps = -1.0; /* dlamch? */
3220         PetscInt     nmin_s;
3221         PetscBool    compute_range;
3222 
3223         B_neigs = 0;
3224         compute_range = (PetscBool)!same_data;
3225         if (nmin >= subset_size) compute_range = PETSC_FALSE;
3226 
3227         if (pcbddc->dbg_flag) {
3228           PetscInt nc = 0;
3229 
3230           if (sub_schurs->change_primal_sub) {
3231             ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nc);CHKERRQ(ierr);
3232           }
3233           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Computing for sub %d/%d size %d count %d fid %d (range %d) (change %d).\n",i,sub_schurs->n_subs,subset_size,pcbddc->mat_graph->count[idxs[0]]+1,pcbddc->mat_graph->which_dof[idxs[0]],compute_range,nc);CHKERRQ(ierr);
3234         }
3235 
3236         ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3237         if (compute_range) {
3238 
3239           /* ask for eigenvalues larger than thresh */
3240           if (sub_schurs->is_posdef) {
3241 #if defined(PETSC_USE_COMPLEX)
3242             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));
3243 #else
3244             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));
3245 #endif
3246           } else { /* no theory so far, but it works nicely */
3247             PetscInt  recipe = 0,recipe_m = 1;
3248             PetscReal bb[2];
3249 
3250             ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe",&recipe,NULL);CHKERRQ(ierr);
3251             switch (recipe) {
3252             case 0:
3253               if (scal) { bb[0] = PETSC_MIN_REAL; bb[1] = lthresh; }
3254               else { bb[0] = uthresh; bb[1] = PETSC_MAX_REAL; }
3255 #if defined(PETSC_USE_COMPLEX)
3256               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3257 #else
3258               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3259 #endif
3260               break;
3261             case 1:
3262               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh*lthresh;
3263 #if defined(PETSC_USE_COMPLEX)
3264               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3265 #else
3266               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3267 #endif
3268               if (!scal) {
3269                 PetscBLASInt B_neigs2 = 0;
3270 
3271                 bb[0] = PetscMax(lthresh*lthresh,uthresh); bb[1] = PETSC_MAX_REAL;
3272                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3273                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3274 #if defined(PETSC_USE_COMPLEX)
3275                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3276 #else
3277                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3278 #endif
3279                 B_neigs += B_neigs2;
3280               }
3281               break;
3282             case 2:
3283               if (scal) {
3284                 bb[0] = PETSC_MIN_REAL;
3285                 bb[1] = 0;
3286 #if defined(PETSC_USE_COMPLEX)
3287                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3288 #else
3289                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3290 #endif
3291               } else {
3292                 PetscBLASInt B_neigs2 = 0;
3293                 PetscBool    import = PETSC_FALSE;
3294 
3295                 lthresh = PetscMax(lthresh,0.0);
3296                 if (lthresh > 0.0) {
3297                   bb[0] = PETSC_MIN_REAL;
3298                   bb[1] = lthresh*lthresh;
3299 
3300                   import = PETSC_TRUE;
3301 #if defined(PETSC_USE_COMPLEX)
3302                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3303 #else
3304                   PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3305 #endif
3306                 }
3307                 bb[0] = PetscMax(lthresh*lthresh,uthresh);
3308                 bb[1] = PETSC_MAX_REAL;
3309                 if (import) {
3310                   ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3311                   ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3312                 }
3313 #if defined(PETSC_USE_COMPLEX)
3314                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3315 #else
3316                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3317 #endif
3318                 B_neigs += B_neigs2;
3319               }
3320               break;
3321             case 3:
3322               if (scal) {
3323                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min_scal",&recipe_m,NULL);CHKERRQ(ierr);
3324               } else {
3325                 ierr = PetscOptionsGetInt(NULL,((PetscObject)pc)->prefix,"-pc_bddc_adaptive_recipe3_min",&recipe_m,NULL);CHKERRQ(ierr);
3326               }
3327               if (!scal) {
3328                 bb[0] = uthresh;
3329                 bb[1] = PETSC_MAX_REAL;
3330 #if defined(PETSC_USE_COMPLEX)
3331                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3332 #else
3333                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3334 #endif
3335               }
3336               if (recipe_m > 0 && B_N - B_neigs > 0) {
3337                 PetscBLASInt B_neigs2 = 0;
3338 
3339                 B_IL = 1;
3340                 ierr = PetscBLASIntCast(PetscMin(recipe_m,B_N - B_neigs),&B_IU);CHKERRQ(ierr);
3341                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3342                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3343 #if defined(PETSC_USE_COMPLEX)
3344                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3345 #else
3346                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","I","L",&B_N,St,&B_N,S,&B_N,&lower,&upper,&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3347 #endif
3348                 B_neigs += B_neigs2;
3349               }
3350               break;
3351             case 4:
3352               bb[0] = PETSC_MIN_REAL; bb[1] = lthresh;
3353 #if defined(PETSC_USE_COMPLEX)
3354               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3355 #else
3356               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3357 #endif
3358               {
3359                 PetscBLASInt B_neigs2 = 0;
3360 
3361                 bb[0] = PetscMax(lthresh+PETSC_SMALL,uthresh); bb[1] = PETSC_MAX_REAL;
3362                 ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3363                 ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3364 #if defined(PETSC_USE_COMPLEX)
3365                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3366 #else
3367                 PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","V","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs2,eigs+B_neigs,eigv+B_neigs*B_N,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3368 #endif
3369                 B_neigs += B_neigs2;
3370               }
3371               break;
3372             case 5: /* same as before: first compute all eigenvalues, then filter */
3373 #if defined(PETSC_USE_COMPLEX)
3374               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,rwork,B_iwork,B_ifail,&B_ierr));
3375 #else
3376               PetscStackCallBLAS("LAPACKsygvx",LAPACKsygvx_(&B_itype,"V","A","L",&B_N,St,&B_N,S,&B_N,&bb[0],&bb[1],&B_IL,&B_IU,&eps,&B_neigs,eigs,eigv,&B_N,work,&B_lwork,B_iwork,B_ifail,&B_ierr));
3377 #endif
3378               {
3379                 PetscInt e,k,ne;
3380                 for (e=0,ne=0;e<B_neigs;e++) {
3381                   if (eigs[e] < lthresh || eigs[e] > uthresh) {
3382                     for (k=0;k<B_N;k++) S[ne*B_N+k] = eigv[e*B_N+k];
3383                     eigs[ne] = eigs[e];
3384                     ne++;
3385                   }
3386                 }
3387                 ierr = PetscMemcpy(eigv,S,B_N*ne*sizeof(PetscScalar));CHKERRQ(ierr);
3388                 B_neigs = ne;
3389               }
3390               break;
3391             default:
3392               SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_SUP,"Unknown recipe %D",recipe);
3393               break;
3394             }
3395           }
3396         } else if (!same_data) { /* this is just to see all the eigenvalues */
3397           B_IU = PetscMax(1,PetscMin(B_N,nmax));
3398           B_IL = 1;
3399 #if defined(PETSC_USE_COMPLEX)
3400           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));
3401 #else
3402           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));
3403 #endif
3404         } else { /* same_data is true, so just get the adaptive functional requested by the user */
3405           PetscInt k;
3406           if (!sub_schurs->change_primal_sub) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
3407           ierr = ISGetLocalSize(sub_schurs->change_primal_sub[i],&nmax);CHKERRQ(ierr);
3408           ierr = PetscBLASIntCast(nmax,&B_neigs);CHKERRQ(ierr);
3409           nmin = nmax;
3410           ierr = PetscMemzero(eigv,subset_size*nmax*sizeof(PetscScalar));CHKERRQ(ierr);
3411           for (k=0;k<nmax;k++) {
3412             eigs[k] = 1./PETSC_SMALL;
3413             eigv[k*(subset_size+1)] = 1.0;
3414           }
3415         }
3416         ierr = PetscFPTrapPop();CHKERRQ(ierr);
3417         if (B_ierr) {
3418           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3419           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);
3420           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);
3421         }
3422 
3423         if (B_neigs > nmax) {
3424           if (pcbddc->dbg_flag) {
3425             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   found %d eigs, more than maximum required %d.\n",B_neigs,nmax);CHKERRQ(ierr);
3426           }
3427           if (pcbddc->use_deluxe_scaling) eigs_start = scal ? 0 : B_neigs-nmax;
3428           B_neigs = nmax;
3429         }
3430 
3431         nmin_s = PetscMin(nmin,B_N);
3432         if (B_neigs < nmin_s) {
3433           PetscBLASInt B_neigs2 = 0;
3434 
3435           if (pcbddc->use_deluxe_scaling) {
3436             if (scal) {
3437               B_IU = nmin_s;
3438               B_IL = B_neigs + 1;
3439             } else {
3440               B_IL = B_N - nmin_s + 1;
3441               B_IU = B_N - B_neigs;
3442             }
3443           } else {
3444             B_IL = B_neigs + 1;
3445             B_IU = nmin_s;
3446           }
3447           if (pcbddc->dbg_flag) {
3448             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);
3449           }
3450           if (sub_schurs->is_symmetric) {
3451             PetscInt j,k;
3452             for (j=0;j<subset_size;j++) {
3453               for (k=j;k<subset_size;k++) {
3454                 S [j*subset_size+k] = Sarray [cumarray+j*subset_size+k];
3455                 St[j*subset_size+k] = Starray[cumarray+j*subset_size+k];
3456               }
3457             }
3458           } else {
3459             ierr = PetscMemcpy(S,Sarray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3460             ierr = PetscMemcpy(St,Starray+cumarray,subset_size*subset_size*sizeof(PetscScalar));CHKERRQ(ierr);
3461           }
3462           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
3463 #if defined(PETSC_USE_COMPLEX)
3464           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));
3465 #else
3466           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));
3467 #endif
3468           ierr = PetscFPTrapPop();CHKERRQ(ierr);
3469           B_neigs += B_neigs2;
3470         }
3471         if (B_ierr) {
3472           if (B_ierr < 0 ) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYGVX Lapack routine: illegal value for argument %d",-(int)B_ierr);
3473           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);
3474           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);
3475         }
3476         if (pcbddc->dbg_flag) {
3477           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Got %d eigs\n",B_neigs);CHKERRQ(ierr);
3478           for (j=0;j<B_neigs;j++) {
3479             if (eigs[j] == 0.0) {
3480               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     Inf\n");CHKERRQ(ierr);
3481             } else {
3482               if (pcbddc->use_deluxe_scaling) {
3483                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",eigs[j+eigs_start]);CHKERRQ(ierr);
3484               } else {
3485                 ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"     %1.6e\n",1./eigs[j+eigs_start]);CHKERRQ(ierr);
3486               }
3487             }
3488           }
3489         }
3490       } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented");
3491     }
3492     /* change the basis back to the original one */
3493     if (sub_schurs->change) {
3494       Mat change,phi,phit;
3495 
3496       if (pcbddc->dbg_flag > 2) {
3497         PetscInt ii;
3498         for (ii=0;ii<B_neigs;ii++) {
3499           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector (old basis) %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3500           for (j=0;j<B_N;j++) {
3501 #if defined(PETSC_USE_COMPLEX)
3502             PetscReal r = PetscRealPart(eigv[(ii+eigs_start)*subset_size+j]);
3503             PetscReal c = PetscImaginaryPart(eigv[(ii+eigs_start)*subset_size+j]);
3504             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3505 #else
3506             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",eigv[(ii+eigs_start)*subset_size+j]);CHKERRQ(ierr);
3507 #endif
3508           }
3509         }
3510       }
3511       ierr = KSPGetOperators(sub_schurs->change[i],&change,NULL);CHKERRQ(ierr);
3512       ierr = MatCreateSeqDense(PETSC_COMM_SELF,subset_size,B_neigs,eigv+eigs_start*subset_size,&phit);CHKERRQ(ierr);
3513       ierr = MatMatMult(change,phit,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&phi);CHKERRQ(ierr);
3514       ierr = MatCopy(phi,phit,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
3515       ierr = MatDestroy(&phit);CHKERRQ(ierr);
3516       ierr = MatDestroy(&phi);CHKERRQ(ierr);
3517     }
3518     maxneigs = PetscMax(B_neigs,maxneigs);
3519     pcbddc->adaptive_constraints_n[i+nv] = B_neigs;
3520     if (B_neigs) {
3521       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);
3522 
3523       if (pcbddc->dbg_flag > 1) {
3524         PetscInt ii;
3525         for (ii=0;ii<B_neigs;ii++) {
3526           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"   -> Eigenvector %d/%d (%d)\n",ii,B_neigs,B_N);CHKERRQ(ierr);
3527           for (j=0;j<B_N;j++) {
3528 #if defined(PETSC_USE_COMPLEX)
3529             PetscReal r = PetscRealPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3530             PetscReal c = PetscImaginaryPart(pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);
3531             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e + %1.4e i\n",r,c);CHKERRQ(ierr);
3532 #else
3533             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"       %1.4e\n",pcbddc->adaptive_constraints_data[ii*subset_size+j+pcbddc->adaptive_constraints_data_ptr[cum]]);CHKERRQ(ierr);
3534 #endif
3535           }
3536         }
3537       }
3538       ierr = PetscMemcpy(pcbddc->adaptive_constraints_idxs+pcbddc->adaptive_constraints_idxs_ptr[cum],idxs,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
3539       pcbddc->adaptive_constraints_idxs_ptr[cum+1] = pcbddc->adaptive_constraints_idxs_ptr[cum] + subset_size;
3540       pcbddc->adaptive_constraints_data_ptr[cum+1] = pcbddc->adaptive_constraints_data_ptr[cum] + subset_size*B_neigs;
3541       cum++;
3542     }
3543     ierr = ISRestoreIndices(sub_schurs->is_subs[i],&idxs);CHKERRQ(ierr);
3544     /* shift for next computation */
3545     cumarray += subset_size*subset_size;
3546   }
3547   if (pcbddc->dbg_flag) {
3548     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
3549   }
3550 
3551   if (mss) {
3552     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_inv_all,&Sarray);CHKERRQ(ierr);
3553     ierr = MatSeqAIJRestoreArray(sub_schurs->sum_S_Ej_tilda_all,&Starray);CHKERRQ(ierr);
3554     /* destroy matrices (junk) */
3555     ierr = MatDestroy(&sub_schurs->sum_S_Ej_inv_all);CHKERRQ(ierr);
3556     ierr = MatDestroy(&sub_schurs->sum_S_Ej_tilda_all);CHKERRQ(ierr);
3557   }
3558   if (allocated_S_St) {
3559     ierr = PetscFree2(S,St);CHKERRQ(ierr);
3560   }
3561   ierr = PetscFree5(eigv,eigs,work,B_iwork,B_ifail);CHKERRQ(ierr);
3562 #if defined(PETSC_USE_COMPLEX)
3563   ierr = PetscFree(rwork);CHKERRQ(ierr);
3564 #endif
3565   if (pcbddc->dbg_flag) {
3566     PetscInt maxneigs_r;
3567     ierr = MPIU_Allreduce(&maxneigs,&maxneigs_r,1,MPIU_INT,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
3568     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of constraints per cc %d\n",maxneigs_r);CHKERRQ(ierr);
3569   }
3570   PetscFunctionReturn(0);
3571 }
3572 
3573 PetscErrorCode PCBDDCSetUpSolvers(PC pc)
3574 {
3575   PetscScalar    *coarse_submat_vals;
3576   PetscErrorCode ierr;
3577 
3578   PetscFunctionBegin;
3579   /* Setup local scatters R_to_B and (optionally) R_to_D */
3580   /* PCBDDCSetUpLocalWorkVectors should be called first! */
3581   ierr = PCBDDCSetUpLocalScatters(pc);CHKERRQ(ierr);
3582 
3583   /* Setup local neumann solver ksp_R */
3584   /* PCBDDCSetUpLocalScatters should be called first! */
3585   ierr = PCBDDCSetUpLocalSolvers(pc,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
3586 
3587   /*
3588      Setup local correction and local part of coarse basis.
3589      Gives back the dense local part of the coarse matrix in column major ordering
3590   */
3591   ierr = PCBDDCSetUpCorrection(pc,&coarse_submat_vals);CHKERRQ(ierr);
3592 
3593   /* Compute total number of coarse nodes and setup coarse solver */
3594   ierr = PCBDDCSetUpCoarseSolver(pc,coarse_submat_vals);CHKERRQ(ierr);
3595 
3596   /* free */
3597   ierr = PetscFree(coarse_submat_vals);CHKERRQ(ierr);
3598   PetscFunctionReturn(0);
3599 }
3600 
3601 PetscErrorCode PCBDDCResetCustomization(PC pc)
3602 {
3603   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3604   PetscErrorCode ierr;
3605 
3606   PetscFunctionBegin;
3607   ierr = ISDestroy(&pcbddc->user_primal_vertices);CHKERRQ(ierr);
3608   ierr = ISDestroy(&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
3609   ierr = ISDestroy(&pcbddc->NeumannBoundaries);CHKERRQ(ierr);
3610   ierr = ISDestroy(&pcbddc->NeumannBoundariesLocal);CHKERRQ(ierr);
3611   ierr = ISDestroy(&pcbddc->DirichletBoundaries);CHKERRQ(ierr);
3612   ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
3613   ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
3614   ierr = ISDestroy(&pcbddc->DirichletBoundariesLocal);CHKERRQ(ierr);
3615   ierr = PCBDDCSetDofsSplitting(pc,0,NULL);CHKERRQ(ierr);
3616   ierr = PCBDDCSetDofsSplittingLocal(pc,0,NULL);CHKERRQ(ierr);
3617   PetscFunctionReturn(0);
3618 }
3619 
3620 PetscErrorCode PCBDDCResetTopography(PC pc)
3621 {
3622   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3623   PetscInt       i;
3624   PetscErrorCode ierr;
3625 
3626   PetscFunctionBegin;
3627   ierr = MatDestroy(&pcbddc->nedcG);CHKERRQ(ierr);
3628   ierr = ISDestroy(&pcbddc->nedclocal);CHKERRQ(ierr);
3629   ierr = MatDestroy(&pcbddc->discretegradient);CHKERRQ(ierr);
3630   ierr = MatDestroy(&pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
3631   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
3632   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
3633   ierr = VecDestroy(&pcbddc->work_change);CHKERRQ(ierr);
3634   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
3635   ierr = MatDestroy(&pcbddc->divudotp);CHKERRQ(ierr);
3636   ierr = ISDestroy(&pcbddc->divudotp_vl2l);CHKERRQ(ierr);
3637   ierr = PCBDDCGraphDestroy(&pcbddc->mat_graph);CHKERRQ(ierr);
3638   for (i=0;i<pcbddc->n_local_subs;i++) {
3639     ierr = ISDestroy(&pcbddc->local_subs[i]);CHKERRQ(ierr);
3640   }
3641   pcbddc->n_local_subs = 0;
3642   ierr = PetscFree(pcbddc->local_subs);CHKERRQ(ierr);
3643   ierr = PCBDDCSubSchursDestroy(&pcbddc->sub_schurs);CHKERRQ(ierr);
3644   pcbddc->graphanalyzed        = PETSC_FALSE;
3645   pcbddc->recompute_topography = PETSC_TRUE;
3646   pcbddc->corner_selected      = PETSC_FALSE;
3647   PetscFunctionReturn(0);
3648 }
3649 
3650 PetscErrorCode PCBDDCResetSolvers(PC pc)
3651 {
3652   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3653   PetscErrorCode ierr;
3654 
3655   PetscFunctionBegin;
3656   ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
3657   if (pcbddc->coarse_phi_B) {
3658     PetscScalar *array;
3659     ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&array);CHKERRQ(ierr);
3660     ierr = PetscFree(array);CHKERRQ(ierr);
3661   }
3662   ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
3663   ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
3664   ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
3665   ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
3666   ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3667   ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3668   ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3669   ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3670   ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3671   ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3672   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
3673   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
3674   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
3675   ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
3676   ierr = KSPReset(pcbddc->ksp_D);CHKERRQ(ierr);
3677   ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
3678   ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
3679   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
3680   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
3681   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
3682   ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
3683   ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
3684   ierr = MatDestroy(&pcbddc->benign_change);CHKERRQ(ierr);
3685   ierr = VecDestroy(&pcbddc->benign_vec);CHKERRQ(ierr);
3686   ierr = PCBDDCBenignShellMat(pc,PETSC_TRUE);CHKERRQ(ierr);
3687   ierr = MatDestroy(&pcbddc->benign_B0);CHKERRQ(ierr);
3688   ierr = PetscSFDestroy(&pcbddc->benign_sf);CHKERRQ(ierr);
3689   if (pcbddc->benign_zerodiag_subs) {
3690     PetscInt i;
3691     for (i=0;i<pcbddc->benign_n;i++) {
3692       ierr = ISDestroy(&pcbddc->benign_zerodiag_subs[i]);CHKERRQ(ierr);
3693     }
3694     ierr = PetscFree(pcbddc->benign_zerodiag_subs);CHKERRQ(ierr);
3695   }
3696   ierr = PetscFree3(pcbddc->benign_p0_lidx,pcbddc->benign_p0_gidx,pcbddc->benign_p0);CHKERRQ(ierr);
3697   PetscFunctionReturn(0);
3698 }
3699 
3700 PetscErrorCode PCBDDCSetUpLocalWorkVectors(PC pc)
3701 {
3702   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
3703   PC_IS          *pcis = (PC_IS*)pc->data;
3704   VecType        impVecType;
3705   PetscInt       n_constraints,n_R,old_size;
3706   PetscErrorCode ierr;
3707 
3708   PetscFunctionBegin;
3709   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - pcbddc->n_vertices;
3710   n_R = pcis->n - pcbddc->n_vertices;
3711   ierr = VecGetType(pcis->vec1_N,&impVecType);CHKERRQ(ierr);
3712   /* local work vectors (try to avoid unneeded work)*/
3713   /* R nodes */
3714   old_size = -1;
3715   if (pcbddc->vec1_R) {
3716     ierr = VecGetSize(pcbddc->vec1_R,&old_size);CHKERRQ(ierr);
3717   }
3718   if (n_R != old_size) {
3719     ierr = VecDestroy(&pcbddc->vec1_R);CHKERRQ(ierr);
3720     ierr = VecDestroy(&pcbddc->vec2_R);CHKERRQ(ierr);
3721     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_R);CHKERRQ(ierr);
3722     ierr = VecSetSizes(pcbddc->vec1_R,PETSC_DECIDE,n_R);CHKERRQ(ierr);
3723     ierr = VecSetType(pcbddc->vec1_R,impVecType);CHKERRQ(ierr);
3724     ierr = VecDuplicate(pcbddc->vec1_R,&pcbddc->vec2_R);CHKERRQ(ierr);
3725   }
3726   /* local primal dofs */
3727   old_size = -1;
3728   if (pcbddc->vec1_P) {
3729     ierr = VecGetSize(pcbddc->vec1_P,&old_size);CHKERRQ(ierr);
3730   }
3731   if (pcbddc->local_primal_size != old_size) {
3732     ierr = VecDestroy(&pcbddc->vec1_P);CHKERRQ(ierr);
3733     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_P);CHKERRQ(ierr);
3734     ierr = VecSetSizes(pcbddc->vec1_P,PETSC_DECIDE,pcbddc->local_primal_size);CHKERRQ(ierr);
3735     ierr = VecSetType(pcbddc->vec1_P,impVecType);CHKERRQ(ierr);
3736   }
3737   /* local explicit constraints */
3738   old_size = -1;
3739   if (pcbddc->vec1_C) {
3740     ierr = VecGetSize(pcbddc->vec1_C,&old_size);CHKERRQ(ierr);
3741   }
3742   if (n_constraints && n_constraints != old_size) {
3743     ierr = VecDestroy(&pcbddc->vec1_C);CHKERRQ(ierr);
3744     ierr = VecCreate(PetscObjectComm((PetscObject)pcis->vec1_N),&pcbddc->vec1_C);CHKERRQ(ierr);
3745     ierr = VecSetSizes(pcbddc->vec1_C,PETSC_DECIDE,n_constraints);CHKERRQ(ierr);
3746     ierr = VecSetType(pcbddc->vec1_C,impVecType);CHKERRQ(ierr);
3747   }
3748   PetscFunctionReturn(0);
3749 }
3750 
3751 PetscErrorCode PCBDDCSetUpCorrection(PC pc, PetscScalar **coarse_submat_vals_n)
3752 {
3753   PetscErrorCode  ierr;
3754   /* pointers to pcis and pcbddc */
3755   PC_IS*          pcis = (PC_IS*)pc->data;
3756   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
3757   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
3758   /* submatrices of local problem */
3759   Mat             A_RV,A_VR,A_VV,local_auxmat2_R;
3760   /* submatrices of local coarse problem */
3761   Mat             S_VV,S_CV,S_VC,S_CC;
3762   /* working matrices */
3763   Mat             C_CR;
3764   /* additional working stuff */
3765   PC              pc_R;
3766   Mat             F,Brhs = NULL;
3767   Vec             dummy_vec;
3768   PetscBool       isLU,isCHOL,isILU,need_benign_correction,sparserhs;
3769   PetscScalar     *coarse_submat_vals; /* TODO: use a PETSc matrix */
3770   PetscScalar     *work;
3771   PetscInt        *idx_V_B;
3772   PetscInt        lda_rhs,n,n_vertices,n_constraints,*p0_lidx_I;
3773   PetscInt        i,n_R,n_D,n_B;
3774 
3775   /* some shortcuts to scalars */
3776   PetscScalar     one=1.0,m_one=-1.0;
3777 
3778   PetscFunctionBegin;
3779   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");
3780 
3781   /* Set Non-overlapping dimensions */
3782   n_vertices = pcbddc->n_vertices;
3783   n_constraints = pcbddc->local_primal_size - pcbddc->benign_n - n_vertices;
3784   n_B = pcis->n_B;
3785   n_D = pcis->n - n_B;
3786   n_R = pcis->n - n_vertices;
3787 
3788   /* vertices in boundary numbering */
3789   ierr = PetscMalloc1(n_vertices,&idx_V_B);CHKERRQ(ierr);
3790   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,n_vertices,pcbddc->local_primal_ref_node,&i,idx_V_B);CHKERRQ(ierr);
3791   if (i != n_vertices) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error in boundary numbering for BDDC vertices! %D != %D\n",n_vertices,i);
3792 
3793   /* Subdomain contribution (Non-overlapping) to coarse matrix  */
3794   ierr = PetscCalloc1(pcbddc->local_primal_size*pcbddc->local_primal_size,&coarse_submat_vals);CHKERRQ(ierr);
3795   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_vertices,coarse_submat_vals,&S_VV);CHKERRQ(ierr);
3796   ierr = MatSeqDenseSetLDA(S_VV,pcbddc->local_primal_size);CHKERRQ(ierr);
3797   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_vertices,coarse_submat_vals+n_vertices,&S_CV);CHKERRQ(ierr);
3798   ierr = MatSeqDenseSetLDA(S_CV,pcbddc->local_primal_size);CHKERRQ(ierr);
3799   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_vertices,n_constraints,coarse_submat_vals+pcbddc->local_primal_size*n_vertices,&S_VC);CHKERRQ(ierr);
3800   ierr = MatSeqDenseSetLDA(S_VC,pcbddc->local_primal_size);CHKERRQ(ierr);
3801   ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_constraints,n_constraints,coarse_submat_vals+(pcbddc->local_primal_size+1)*n_vertices,&S_CC);CHKERRQ(ierr);
3802   ierr = MatSeqDenseSetLDA(S_CC,pcbddc->local_primal_size);CHKERRQ(ierr);
3803 
3804   /* determine if can use MatSolve routines instead of calling KSPSolve on ksp_R */
3805   ierr = KSPGetPC(pcbddc->ksp_R,&pc_R);CHKERRQ(ierr);
3806   ierr = PCSetUp(pc_R);CHKERRQ(ierr);
3807   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCLU,&isLU);CHKERRQ(ierr);
3808   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCILU,&isILU);CHKERRQ(ierr);
3809   ierr = PetscObjectTypeCompare((PetscObject)pc_R,PCCHOLESKY,&isCHOL);CHKERRQ(ierr);
3810   lda_rhs = n_R;
3811   need_benign_correction = PETSC_FALSE;
3812   if (isLU || isILU || isCHOL) {
3813     ierr = PCFactorGetMatrix(pc_R,&F);CHKERRQ(ierr);
3814   } else if (sub_schurs && sub_schurs->reuse_solver) {
3815     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3816     MatFactorType      type;
3817 
3818     F = reuse_solver->F;
3819     ierr = MatGetFactorType(F,&type);CHKERRQ(ierr);
3820     if (type == MAT_FACTOR_CHOLESKY) isCHOL = PETSC_TRUE;
3821     ierr = MatGetSize(F,&lda_rhs,NULL);CHKERRQ(ierr);
3822     need_benign_correction = (PetscBool)(!!reuse_solver->benign_n);
3823   } else {
3824     F = NULL;
3825   }
3826 
3827   /* determine if we can use a sparse right-hand side */
3828   sparserhs = PETSC_FALSE;
3829   if (F) {
3830     MatSolverType solver;
3831 
3832     ierr = MatFactorGetSolverType(F,&solver);CHKERRQ(ierr);
3833     ierr = PetscStrcmp(solver,MATSOLVERMUMPS,&sparserhs);CHKERRQ(ierr);
3834   }
3835 
3836   /* allocate workspace */
3837   n = 0;
3838   if (n_constraints) {
3839     n += lda_rhs*n_constraints;
3840   }
3841   if (n_vertices) {
3842     n = PetscMax(2*lda_rhs*n_vertices,n);
3843     n = PetscMax((lda_rhs+n_B)*n_vertices,n);
3844   }
3845   if (!pcbddc->symmetric_primal) {
3846     n = PetscMax(2*lda_rhs*pcbddc->local_primal_size,n);
3847   }
3848   ierr = PetscMalloc1(n,&work);CHKERRQ(ierr);
3849 
3850   /* create dummy vector to modify rhs and sol of MatMatSolve (work array will never be used) */
3851   dummy_vec = NULL;
3852   if (need_benign_correction && lda_rhs != n_R && F) {
3853     ierr = VecCreateSeqWithArray(PETSC_COMM_SELF,1,lda_rhs,work,&dummy_vec);CHKERRQ(ierr);
3854   }
3855 
3856   /* Precompute stuffs needed for preprocessing and application of BDDC*/
3857   if (n_constraints) {
3858     Mat         M3,C_B;
3859     IS          is_aux;
3860     PetscScalar *array,*array2;
3861 
3862     ierr = MatDestroy(&pcbddc->local_auxmat1);CHKERRQ(ierr);
3863     ierr = MatDestroy(&pcbddc->local_auxmat2);CHKERRQ(ierr);
3864 
3865     /* Extract constraints on R nodes: C_{CR}  */
3866     ierr = ISCreateStride(PETSC_COMM_SELF,n_constraints,n_vertices,1,&is_aux);CHKERRQ(ierr);
3867     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&C_CR);CHKERRQ(ierr);
3868     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_aux,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
3869 
3870     /* Assemble         local_auxmat2_R =        (- A_{RR}^{-1} C^T_{CR}) needed by BDDC setup */
3871     /* Assemble pcbddc->local_auxmat2   = R_to_B (- A_{RR}^{-1} C^T_{CR}) needed by BDDC application */
3872     if (!sparserhs) {
3873       ierr = PetscMemzero(work,lda_rhs*n_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
3874       for (i=0;i<n_constraints;i++) {
3875         const PetscScalar *row_cmat_values;
3876         const PetscInt    *row_cmat_indices;
3877         PetscInt          size_of_constraint,j;
3878 
3879         ierr = MatGetRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3880         for (j=0;j<size_of_constraint;j++) {
3881           work[row_cmat_indices[j]+i*lda_rhs] = -row_cmat_values[j];
3882         }
3883         ierr = MatRestoreRow(C_CR,i,&size_of_constraint,&row_cmat_indices,&row_cmat_values);CHKERRQ(ierr);
3884       }
3885       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&Brhs);CHKERRQ(ierr);
3886     } else {
3887       Mat tC_CR;
3888 
3889       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3890       if (lda_rhs != n_R) {
3891         PetscScalar *aa;
3892         PetscInt    r,*ii,*jj;
3893         PetscBool   done;
3894 
3895         ierr = MatGetRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3896         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
3897         ierr = MatSeqAIJGetArray(C_CR,&aa);CHKERRQ(ierr);
3898         ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_constraints,lda_rhs,ii,jj,aa,&tC_CR);CHKERRQ(ierr);
3899         ierr = MatRestoreRowIJ(C_CR,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
3900         if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
3901       } else {
3902         ierr  = PetscObjectReference((PetscObject)C_CR);CHKERRQ(ierr);
3903         tC_CR = C_CR;
3904       }
3905       ierr = MatCreateTranspose(tC_CR,&Brhs);CHKERRQ(ierr);
3906       ierr = MatDestroy(&tC_CR);CHKERRQ(ierr);
3907     }
3908     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,NULL,&local_auxmat2_R);CHKERRQ(ierr);
3909     if (F) {
3910       if (need_benign_correction) {
3911         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3912 
3913         /* rhs is already zero on interior dofs, no need to change the rhs */
3914         ierr = PetscMemzero(reuse_solver->benign_save_vals,pcbddc->benign_n*sizeof(PetscScalar));CHKERRQ(ierr);
3915       }
3916       ierr = MatMatSolve(F,Brhs,local_auxmat2_R);CHKERRQ(ierr);
3917       if (need_benign_correction) {
3918         PetscScalar        *marr;
3919         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
3920 
3921         ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3922         if (lda_rhs != n_R) {
3923           for (i=0;i<n_constraints;i++) {
3924             ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
3925             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3926             ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
3927           }
3928         } else {
3929           for (i=0;i<n_constraints;i++) {
3930             ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
3931             ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
3932             ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3933           }
3934         }
3935         ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3936       }
3937     } else {
3938       PetscScalar *marr;
3939 
3940       ierr = MatDenseGetArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3941       for (i=0;i<n_constraints;i++) {
3942         ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
3943         ierr = VecPlaceArray(pcbddc->vec2_R,marr+i*lda_rhs);CHKERRQ(ierr);
3944         ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
3945         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3946         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
3947       }
3948       ierr = MatDenseRestoreArray(local_auxmat2_R,&marr);CHKERRQ(ierr);
3949     }
3950     if (sparserhs) {
3951       ierr = MatScale(C_CR,-1.0);CHKERRQ(ierr);
3952     }
3953     ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
3954     if (!pcbddc->switch_static) {
3955       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_constraints,NULL,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3956       ierr = MatDenseGetArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3957       ierr = MatDenseGetArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3958       for (i=0;i<n_constraints;i++) {
3959         ierr = VecPlaceArray(pcbddc->vec1_R,array2+i*lda_rhs);CHKERRQ(ierr);
3960         ierr = VecPlaceArray(pcis->vec1_B,array+i*n_B);CHKERRQ(ierr);
3961         ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3962         ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
3963         ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
3964         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
3965       }
3966       ierr = MatDenseRestoreArray(local_auxmat2_R,&array2);CHKERRQ(ierr);
3967       ierr = MatDenseRestoreArray(pcbddc->local_auxmat2,&array);CHKERRQ(ierr);
3968       ierr = MatMatMult(C_B,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3969     } else {
3970       if (lda_rhs != n_R) {
3971         IS dummy;
3972 
3973         ierr = ISCreateStride(PETSC_COMM_SELF,n_R,0,1,&dummy);CHKERRQ(ierr);
3974         ierr = MatCreateSubMatrix(local_auxmat2_R,dummy,NULL,MAT_INITIAL_MATRIX,&pcbddc->local_auxmat2);CHKERRQ(ierr);
3975         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
3976       } else {
3977         ierr = PetscObjectReference((PetscObject)local_auxmat2_R);CHKERRQ(ierr);
3978         pcbddc->local_auxmat2 = local_auxmat2_R;
3979       }
3980       ierr = MatMatMult(C_CR,pcbddc->local_auxmat2,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&M3);CHKERRQ(ierr);
3981     }
3982     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
3983     /* Assemble explicitly S_CC = ( C_{CR} A_{RR}^{-1} C^T_{CR} )^{-1}  */
3984     ierr = MatScale(M3,m_one);CHKERRQ(ierr);
3985     if (isCHOL) {
3986       ierr = MatCholeskyFactor(M3,NULL,NULL);CHKERRQ(ierr);
3987     } else {
3988       ierr = MatLUFactor(M3,NULL,NULL,NULL);CHKERRQ(ierr);
3989     }
3990     ierr = MatSeqDenseInvertFactors_Private(M3);CHKERRQ(ierr);
3991     /* Assemble local_auxmat1 = S_CC*C_{CB} needed by BDDC application in KSP and in preproc */
3992     ierr = MatMatMult(M3,C_B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->local_auxmat1);CHKERRQ(ierr);
3993     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
3994     ierr = MatCopy(M3,S_CC,SAME_NONZERO_PATTERN);CHKERRQ(ierr); /* S_CC can have a different LDA, MatMatSolve doesn't support it */
3995     ierr = MatDestroy(&M3);CHKERRQ(ierr);
3996   }
3997 
3998   /* Get submatrices from subdomain matrix */
3999   if (n_vertices) {
4000     IS        is_aux;
4001     PetscBool isseqaij;
4002 
4003     if (sub_schurs && sub_schurs->reuse_solver) { /* is_R_local is not sorted, ISComplement doesn't like it */
4004       IS tis;
4005 
4006       ierr = ISDuplicate(pcbddc->is_R_local,&tis);CHKERRQ(ierr);
4007       ierr = ISSort(tis);CHKERRQ(ierr);
4008       ierr = ISComplement(tis,0,pcis->n,&is_aux);CHKERRQ(ierr);
4009       ierr = ISDestroy(&tis);CHKERRQ(ierr);
4010     } else {
4011       ierr = ISComplement(pcbddc->is_R_local,0,pcis->n,&is_aux);CHKERRQ(ierr);
4012     }
4013     ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,is_aux,MAT_INITIAL_MATRIX,&A_RV);CHKERRQ(ierr);
4014     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_VR);CHKERRQ(ierr);
4015     ierr = PetscObjectTypeCompare((PetscObject)A_VR,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4016     if (!isseqaij) { /* MatMatMult(A_VR,A_RRmA_RV) below will raise an error */
4017       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4018     }
4019     ierr = MatCreateSubMatrix(pcbddc->local_mat,is_aux,is_aux,MAT_INITIAL_MATRIX,&A_VV);CHKERRQ(ierr);
4020     ierr = ISDestroy(&is_aux);CHKERRQ(ierr);
4021   }
4022 
4023   /* Matrix of coarse basis functions (local) */
4024   if (pcbddc->coarse_phi_B) {
4025     PetscInt on_B,on_primal,on_D=n_D;
4026     if (pcbddc->coarse_phi_D) {
4027       ierr = MatGetSize(pcbddc->coarse_phi_D,&on_D,NULL);CHKERRQ(ierr);
4028     }
4029     ierr = MatGetSize(pcbddc->coarse_phi_B,&on_B,&on_primal);CHKERRQ(ierr);
4030     if (on_B != n_B || on_primal != pcbddc->local_primal_size || on_D != n_D) {
4031       PetscScalar *marray;
4032 
4033       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&marray);CHKERRQ(ierr);
4034       ierr = PetscFree(marray);CHKERRQ(ierr);
4035       ierr = MatDestroy(&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4036       ierr = MatDestroy(&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4037       ierr = MatDestroy(&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4038       ierr = MatDestroy(&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4039     }
4040   }
4041 
4042   if (!pcbddc->coarse_phi_B) {
4043     PetscScalar *marr;
4044 
4045     /* memory size */
4046     n = n_B*pcbddc->local_primal_size;
4047     if (pcbddc->switch_static || pcbddc->dbg_flag) n += n_D*pcbddc->local_primal_size;
4048     if (!pcbddc->symmetric_primal) n *= 2;
4049     ierr  = PetscCalloc1(n,&marr);CHKERRQ(ierr);
4050     ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_B);CHKERRQ(ierr);
4051     marr += n_B*pcbddc->local_primal_size;
4052     if (pcbddc->switch_static || pcbddc->dbg_flag) {
4053       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_phi_D);CHKERRQ(ierr);
4054       marr += n_D*pcbddc->local_primal_size;
4055     }
4056     if (!pcbddc->symmetric_primal) {
4057       ierr  = MatCreateSeqDense(PETSC_COMM_SELF,n_B,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_B);CHKERRQ(ierr);
4058       marr += n_B*pcbddc->local_primal_size;
4059       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4060         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_D,pcbddc->local_primal_size,marr,&pcbddc->coarse_psi_D);CHKERRQ(ierr);
4061       }
4062     } else {
4063       ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_B);CHKERRQ(ierr);
4064       pcbddc->coarse_psi_B = pcbddc->coarse_phi_B;
4065       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4066         ierr = PetscObjectReference((PetscObject)pcbddc->coarse_phi_D);CHKERRQ(ierr);
4067         pcbddc->coarse_psi_D = pcbddc->coarse_phi_D;
4068       }
4069     }
4070   }
4071 
4072   /* We are now ready to evaluate coarse basis functions and subdomain contribution to coarse problem */
4073   p0_lidx_I = NULL;
4074   if (pcbddc->benign_n && (pcbddc->switch_static || pcbddc->dbg_flag)) {
4075     const PetscInt *idxs;
4076 
4077     ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4078     ierr = PetscMalloc1(pcbddc->benign_n,&p0_lidx_I);CHKERRQ(ierr);
4079     for (i=0;i<pcbddc->benign_n;i++) {
4080       ierr = PetscFindInt(pcbddc->benign_p0_lidx[i],pcis->n-pcis->n_B,idxs,&p0_lidx_I[i]);CHKERRQ(ierr);
4081     }
4082     ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
4083   }
4084 
4085   /* vertices */
4086   if (n_vertices) {
4087     PetscBool restoreavr = PETSC_FALSE;
4088 
4089     ierr = MatConvert(A_VV,MATDENSE,MAT_INPLACE_MATRIX,&A_VV);CHKERRQ(ierr);
4090 
4091     if (n_R) {
4092       Mat          A_RRmA_RV,A_RV_bcorr=NULL,S_VVt; /* S_VVt with LDA=N */
4093       PetscBLASInt B_N,B_one = 1;
4094       PetscScalar  *x,*y;
4095 
4096       ierr = MatScale(A_RV,m_one);CHKERRQ(ierr);
4097       if (need_benign_correction) {
4098         ISLocalToGlobalMapping RtoN;
4099         IS                     is_p0;
4100         PetscInt               *idxs_p0,n;
4101 
4102         ierr = PetscMalloc1(pcbddc->benign_n,&idxs_p0);CHKERRQ(ierr);
4103         ierr = ISLocalToGlobalMappingCreateIS(pcbddc->is_R_local,&RtoN);CHKERRQ(ierr);
4104         ierr = ISGlobalToLocalMappingApply(RtoN,IS_GTOLM_DROP,pcbddc->benign_n,pcbddc->benign_p0_lidx,&n,idxs_p0);CHKERRQ(ierr);
4105         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);
4106         ierr = ISLocalToGlobalMappingDestroy(&RtoN);CHKERRQ(ierr);
4107         ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxs_p0,PETSC_OWN_POINTER,&is_p0);CHKERRQ(ierr);
4108         ierr = MatCreateSubMatrix(A_RV,is_p0,NULL,MAT_INITIAL_MATRIX,&A_RV_bcorr);CHKERRQ(ierr);
4109         ierr = ISDestroy(&is_p0);CHKERRQ(ierr);
4110       }
4111 
4112       ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4113       if (!sparserhs || need_benign_correction) {
4114         if (lda_rhs == n_R) {
4115           ierr = MatConvert(A_RV,MATDENSE,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4116         } else {
4117           PetscScalar    *av,*array;
4118           const PetscInt *xadj,*adjncy;
4119           PetscInt       n;
4120           PetscBool      flg_row;
4121 
4122           array = work+lda_rhs*n_vertices;
4123           ierr = PetscMemzero(array,lda_rhs*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4124           ierr = MatConvert(A_RV,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_RV);CHKERRQ(ierr);
4125           ierr = MatGetRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4126           ierr = MatSeqAIJGetArray(A_RV,&av);CHKERRQ(ierr);
4127           for (i=0;i<n;i++) {
4128             PetscInt j;
4129             for (j=xadj[i];j<xadj[i+1];j++) array[lda_rhs*adjncy[j]+i] = av[j];
4130           }
4131           ierr = MatRestoreRowIJ(A_RV,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4132           ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4133           ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,array,&A_RV);CHKERRQ(ierr);
4134         }
4135         if (need_benign_correction) {
4136           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4137           PetscScalar        *marr;
4138 
4139           ierr = MatDenseGetArray(A_RV,&marr);CHKERRQ(ierr);
4140           /* need \Phi^T A_RV = (I+L)A_RV, L given by
4141 
4142                  | 0 0  0 | (V)
4143              L = | 0 0 -1 | (P-p0)
4144                  | 0 0 -1 | (p0)
4145 
4146           */
4147           for (i=0;i<reuse_solver->benign_n;i++) {
4148             const PetscScalar *vals;
4149             const PetscInt    *idxs,*idxs_zero;
4150             PetscInt          n,j,nz;
4151 
4152             ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4153             ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4154             ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4155             for (j=0;j<n;j++) {
4156               PetscScalar val = vals[j];
4157               PetscInt    k,col = idxs[j];
4158               for (k=0;k<nz;k++) marr[idxs_zero[k]+lda_rhs*col] -= val;
4159             }
4160             ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4161             ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4162           }
4163           ierr = MatDenseRestoreArray(A_RV,&marr);CHKERRQ(ierr);
4164         }
4165         ierr = PetscObjectReference((PetscObject)A_RV);CHKERRQ(ierr);
4166         Brhs = A_RV;
4167       } else {
4168         Mat tA_RVT,A_RVT;
4169 
4170         if (!pcbddc->symmetric_primal) {
4171           /* A_RV already scaled by -1 */
4172           ierr = MatTranspose(A_RV,MAT_INITIAL_MATRIX,&A_RVT);CHKERRQ(ierr);
4173         } else {
4174           restoreavr = PETSC_TRUE;
4175           ierr  = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4176           ierr  = PetscObjectReference((PetscObject)A_VR);CHKERRQ(ierr);
4177           A_RVT = A_VR;
4178         }
4179         if (lda_rhs != n_R) {
4180           PetscScalar *aa;
4181           PetscInt    r,*ii,*jj;
4182           PetscBool   done;
4183 
4184           ierr = MatGetRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4185           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"GetRowIJ failed");
4186           ierr = MatSeqAIJGetArray(A_RVT,&aa);CHKERRQ(ierr);
4187           ierr = MatCreateSeqAIJWithArrays(PETSC_COMM_SELF,n_vertices,lda_rhs,ii,jj,aa,&tA_RVT);CHKERRQ(ierr);
4188           ierr = MatRestoreRowIJ(A_RVT,0,PETSC_FALSE,PETSC_FALSE,&r,(const PetscInt**)&ii,(const PetscInt**)&jj,&done);CHKERRQ(ierr);
4189           if (!done) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"RestoreRowIJ failed");
4190         } else {
4191           ierr   = PetscObjectReference((PetscObject)A_RVT);CHKERRQ(ierr);
4192           tA_RVT = A_RVT;
4193         }
4194         ierr = MatCreateTranspose(tA_RVT,&Brhs);CHKERRQ(ierr);
4195         ierr = MatDestroy(&tA_RVT);CHKERRQ(ierr);
4196         ierr = MatDestroy(&A_RVT);CHKERRQ(ierr);
4197       }
4198       if (F) {
4199         /* need to correct the rhs */
4200         if (need_benign_correction) {
4201           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4202           PetscScalar        *marr;
4203 
4204           ierr = MatDenseGetArray(Brhs,&marr);CHKERRQ(ierr);
4205           if (lda_rhs != n_R) {
4206             for (i=0;i<n_vertices;i++) {
4207               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4208               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4209               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4210             }
4211           } else {
4212             for (i=0;i<n_vertices;i++) {
4213               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4214               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
4215               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4216             }
4217           }
4218           ierr = MatDenseRestoreArray(Brhs,&marr);CHKERRQ(ierr);
4219         }
4220         ierr = MatMatSolve(F,Brhs,A_RRmA_RV);CHKERRQ(ierr);
4221         if (restoreavr) {
4222           ierr = MatScale(A_VR,-1.0);CHKERRQ(ierr);
4223         }
4224         /* need to correct the solution */
4225         if (need_benign_correction) {
4226           PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4227           PetscScalar        *marr;
4228 
4229           ierr = MatDenseGetArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4230           if (lda_rhs != n_R) {
4231             for (i=0;i<n_vertices;i++) {
4232               ierr = VecPlaceArray(dummy_vec,marr+i*lda_rhs);CHKERRQ(ierr);
4233               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,dummy_vec,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4234               ierr = VecResetArray(dummy_vec);CHKERRQ(ierr);
4235             }
4236           } else {
4237             for (i=0;i<n_vertices;i++) {
4238               ierr = VecPlaceArray(pcbddc->vec1_R,marr+i*lda_rhs);CHKERRQ(ierr);
4239               ierr = PCBDDCReuseSolversBenignAdapt(reuse_solver,pcbddc->vec1_R,NULL,PETSC_TRUE,PETSC_TRUE);CHKERRQ(ierr);
4240               ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4241             }
4242           }
4243           ierr = MatDenseRestoreArray(A_RRmA_RV,&marr);CHKERRQ(ierr);
4244         }
4245       } else {
4246         ierr = MatDenseGetArray(Brhs,&y);CHKERRQ(ierr);
4247         for (i=0;i<n_vertices;i++) {
4248           ierr = VecPlaceArray(pcbddc->vec1_R,y+i*lda_rhs);CHKERRQ(ierr);
4249           ierr = VecPlaceArray(pcbddc->vec2_R,work+i*lda_rhs);CHKERRQ(ierr);
4250           ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4251           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4252           ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4253         }
4254         ierr = MatDenseRestoreArray(Brhs,&y);CHKERRQ(ierr);
4255       }
4256       ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4257       ierr = MatDestroy(&Brhs);CHKERRQ(ierr);
4258       /* S_VV and S_CV */
4259       if (n_constraints) {
4260         Mat B;
4261 
4262         ierr = PetscMemzero(work+lda_rhs*n_vertices,n_B*n_vertices*sizeof(PetscScalar));CHKERRQ(ierr);
4263         for (i=0;i<n_vertices;i++) {
4264           ierr = VecPlaceArray(pcbddc->vec1_R,work+i*lda_rhs);CHKERRQ(ierr);
4265           ierr = VecPlaceArray(pcis->vec1_B,work+lda_rhs*n_vertices+i*n_B);CHKERRQ(ierr);
4266           ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4267           ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4268           ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4269           ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4270         }
4271         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_B,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4272         ierr = MatMatMult(pcbddc->local_auxmat1,B,MAT_REUSE_MATRIX,PETSC_DEFAULT,&S_CV);CHKERRQ(ierr);
4273         ierr = MatDestroy(&B);CHKERRQ(ierr);
4274         ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_vertices,work+lda_rhs*n_vertices,&B);CHKERRQ(ierr);
4275         ierr = MatMatMult(local_auxmat2_R,S_CV,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4276         ierr = MatScale(S_CV,m_one);CHKERRQ(ierr);
4277         ierr = PetscBLASIntCast(lda_rhs*n_vertices,&B_N);CHKERRQ(ierr);
4278         PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,work+lda_rhs*n_vertices,&B_one,work,&B_one));
4279         ierr = MatDestroy(&B);CHKERRQ(ierr);
4280       }
4281       if (lda_rhs != n_R) {
4282         ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4283         ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,work,&A_RRmA_RV);CHKERRQ(ierr);
4284         ierr = MatSeqDenseSetLDA(A_RRmA_RV,lda_rhs);CHKERRQ(ierr);
4285       }
4286       ierr = MatMatMult(A_VR,A_RRmA_RV,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VVt);CHKERRQ(ierr);
4287       /* need A_VR * \Phi * A_RRmA_RV = A_VR * (I+L)^T * A_RRmA_RV, L given as before */
4288       if (need_benign_correction) {
4289         PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
4290         PetscScalar      *marr,*sums;
4291 
4292         ierr = PetscMalloc1(n_vertices,&sums);CHKERRQ(ierr);
4293         ierr = MatDenseGetArray(S_VVt,&marr);CHKERRQ(ierr);
4294         for (i=0;i<reuse_solver->benign_n;i++) {
4295           const PetscScalar *vals;
4296           const PetscInt    *idxs,*idxs_zero;
4297           PetscInt          n,j,nz;
4298 
4299           ierr = ISGetLocalSize(reuse_solver->benign_zerodiag_subs[i],&nz);CHKERRQ(ierr);
4300           ierr = ISGetIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4301           for (j=0;j<n_vertices;j++) {
4302             PetscInt k;
4303             sums[j] = 0.;
4304             for (k=0;k<nz;k++) sums[j] += work[idxs_zero[k]+j*lda_rhs];
4305           }
4306           ierr = MatGetRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4307           for (j=0;j<n;j++) {
4308             PetscScalar val = vals[j];
4309             PetscInt k;
4310             for (k=0;k<n_vertices;k++) {
4311               marr[idxs[j]+k*n_vertices] += val*sums[k];
4312             }
4313           }
4314           ierr = MatRestoreRow(A_RV_bcorr,i,&n,&idxs,&vals);CHKERRQ(ierr);
4315           ierr = ISRestoreIndices(reuse_solver->benign_zerodiag_subs[i],&idxs_zero);CHKERRQ(ierr);
4316         }
4317         ierr = PetscFree(sums);CHKERRQ(ierr);
4318         ierr = MatDenseRestoreArray(S_VVt,&marr);CHKERRQ(ierr);
4319         ierr = MatDestroy(&A_RV_bcorr);CHKERRQ(ierr);
4320       }
4321       ierr = MatDestroy(&A_RRmA_RV);CHKERRQ(ierr);
4322       ierr = PetscBLASIntCast(n_vertices*n_vertices,&B_N);CHKERRQ(ierr);
4323       ierr = MatDenseGetArray(A_VV,&x);CHKERRQ(ierr);
4324       ierr = MatDenseGetArray(S_VVt,&y);CHKERRQ(ierr);
4325       PetscStackCallBLAS("BLASaxpy",BLASaxpy_(&B_N,&one,x,&B_one,y,&B_one));
4326       ierr = MatDenseRestoreArray(A_VV,&x);CHKERRQ(ierr);
4327       ierr = MatDenseRestoreArray(S_VVt,&y);CHKERRQ(ierr);
4328       ierr = MatCopy(S_VVt,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4329       ierr = MatDestroy(&S_VVt);CHKERRQ(ierr);
4330     } else {
4331       ierr = MatCopy(A_VV,S_VV,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4332     }
4333     ierr = MatDestroy(&A_VV);CHKERRQ(ierr);
4334 
4335     /* coarse basis functions */
4336     for (i=0;i<n_vertices;i++) {
4337       PetscScalar *y;
4338 
4339       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4340       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4341       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4342       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4343       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4344       y[n_B*i+idx_V_B[i]] = 1.0;
4345       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4346       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4347 
4348       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4349         PetscInt j;
4350 
4351         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4352         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4353         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4354         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4355         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4356         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4357         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4358       }
4359       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4360     }
4361     /* if n_R == 0 the object is not destroyed */
4362     ierr = MatDestroy(&A_RV);CHKERRQ(ierr);
4363   }
4364   ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
4365 
4366   if (n_constraints) {
4367     Mat B;
4368 
4369     ierr = MatCreateSeqDense(PETSC_COMM_SELF,lda_rhs,n_constraints,work,&B);CHKERRQ(ierr);
4370     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4371     ierr = MatMatMult(local_auxmat2_R,S_CC,MAT_REUSE_MATRIX,PETSC_DEFAULT,&B);CHKERRQ(ierr);
4372     ierr = MatScale(S_CC,m_one);CHKERRQ(ierr);
4373     if (n_vertices) {
4374       if (isCHOL || need_benign_correction) { /* if we can solve the interior problem with cholesky, we should also be fine with transposing here */
4375         ierr = MatTranspose(S_CV,MAT_REUSE_MATRIX,&S_VC);CHKERRQ(ierr);
4376       } else {
4377         Mat S_VCt;
4378 
4379         if (lda_rhs != n_R) {
4380           ierr = MatDestroy(&B);CHKERRQ(ierr);
4381           ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_constraints,work,&B);CHKERRQ(ierr);
4382           ierr = MatSeqDenseSetLDA(B,lda_rhs);CHKERRQ(ierr);
4383         }
4384         ierr = MatMatMult(A_VR,B,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&S_VCt);CHKERRQ(ierr);
4385         ierr = MatCopy(S_VCt,S_VC,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
4386         ierr = MatDestroy(&S_VCt);CHKERRQ(ierr);
4387       }
4388     }
4389     ierr = MatDestroy(&B);CHKERRQ(ierr);
4390     /* coarse basis functions */
4391     for (i=0;i<n_constraints;i++) {
4392       PetscScalar *y;
4393 
4394       ierr = VecPlaceArray(pcbddc->vec1_R,work+lda_rhs*i);CHKERRQ(ierr);
4395       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4396       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*(i+n_vertices));CHKERRQ(ierr);
4397       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4398       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4399       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&y);CHKERRQ(ierr);
4400       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4401       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4402         PetscInt j;
4403 
4404         ierr = MatDenseGetArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4405         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*(i+n_vertices));CHKERRQ(ierr);
4406         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4407         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4408         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4409         for (j=0;j<pcbddc->benign_n;j++) y[n_D*i+p0_lidx_I[j]] = 0.0;
4410         ierr = MatDenseRestoreArray(pcbddc->coarse_phi_D,&y);CHKERRQ(ierr);
4411       }
4412       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4413     }
4414   }
4415   if (n_constraints) {
4416     ierr = MatDestroy(&local_auxmat2_R);CHKERRQ(ierr);
4417   }
4418   ierr = PetscFree(p0_lidx_I);CHKERRQ(ierr);
4419 
4420   /* coarse matrix entries relative to B_0 */
4421   if (pcbddc->benign_n) {
4422     Mat         B0_B,B0_BPHI;
4423     IS          is_dummy;
4424     PetscScalar *data;
4425     PetscInt    j;
4426 
4427     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4428     ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4429     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4430     ierr = MatMatMult(B0_B,pcbddc->coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4431     ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4432     ierr = MatDenseGetArray(B0_BPHI,&data);CHKERRQ(ierr);
4433     for (j=0;j<pcbddc->benign_n;j++) {
4434       PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4435       for (i=0;i<pcbddc->local_primal_size;i++) {
4436         coarse_submat_vals[primal_idx*pcbddc->local_primal_size+i] = data[i*pcbddc->benign_n+j];
4437         coarse_submat_vals[i*pcbddc->local_primal_size+primal_idx] = data[i*pcbddc->benign_n+j];
4438       }
4439     }
4440     ierr = MatDenseRestoreArray(B0_BPHI,&data);CHKERRQ(ierr);
4441     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4442     ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4443   }
4444 
4445   /* compute other basis functions for non-symmetric problems */
4446   if (!pcbddc->symmetric_primal) {
4447     Mat         B_V=NULL,B_C=NULL;
4448     PetscScalar *marray;
4449 
4450     if (n_constraints) {
4451       Mat S_CCT,C_CRT;
4452 
4453       ierr = MatTranspose(C_CR,MAT_INITIAL_MATRIX,&C_CRT);CHKERRQ(ierr);
4454       ierr = MatTranspose(S_CC,MAT_INITIAL_MATRIX,&S_CCT);CHKERRQ(ierr);
4455       ierr = MatMatMult(C_CRT,S_CCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_C);CHKERRQ(ierr);
4456       ierr = MatDestroy(&S_CCT);CHKERRQ(ierr);
4457       if (n_vertices) {
4458         Mat S_VCT;
4459 
4460         ierr = MatTranspose(S_VC,MAT_INITIAL_MATRIX,&S_VCT);CHKERRQ(ierr);
4461         ierr = MatMatMult(C_CRT,S_VCT,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&B_V);CHKERRQ(ierr);
4462         ierr = MatDestroy(&S_VCT);CHKERRQ(ierr);
4463       }
4464       ierr = MatDestroy(&C_CRT);CHKERRQ(ierr);
4465     } else {
4466       ierr = MatCreateSeqDense(PETSC_COMM_SELF,n_R,n_vertices,NULL,&B_V);CHKERRQ(ierr);
4467     }
4468     if (n_vertices && n_R) {
4469       PetscScalar    *av,*marray;
4470       const PetscInt *xadj,*adjncy;
4471       PetscInt       n;
4472       PetscBool      flg_row;
4473 
4474       /* B_V = B_V - A_VR^T */
4475       ierr = MatConvert(A_VR,MATSEQAIJ,MAT_INPLACE_MATRIX,&A_VR);CHKERRQ(ierr);
4476       ierr = MatGetRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4477       ierr = MatSeqAIJGetArray(A_VR,&av);CHKERRQ(ierr);
4478       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4479       for (i=0;i<n;i++) {
4480         PetscInt j;
4481         for (j=xadj[i];j<xadj[i+1];j++) marray[i*n_R + adjncy[j]] -= av[j];
4482       }
4483       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4484       ierr = MatRestoreRowIJ(A_VR,0,PETSC_FALSE,PETSC_FALSE,&n,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
4485       ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4486     }
4487 
4488     /* currently there's no support for MatTransposeMatSolve(F,B,X) */
4489     if (n_vertices) {
4490       ierr = MatDenseGetArray(B_V,&marray);CHKERRQ(ierr);
4491       for (i=0;i<n_vertices;i++) {
4492         ierr = VecPlaceArray(pcbddc->vec1_R,marray+i*n_R);CHKERRQ(ierr);
4493         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4494         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4495         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4496         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4497       }
4498       ierr = MatDenseRestoreArray(B_V,&marray);CHKERRQ(ierr);
4499     }
4500     if (B_C) {
4501       ierr = MatDenseGetArray(B_C,&marray);CHKERRQ(ierr);
4502       for (i=n_vertices;i<n_constraints+n_vertices;i++) {
4503         ierr = VecPlaceArray(pcbddc->vec1_R,marray+(i-n_vertices)*n_R);CHKERRQ(ierr);
4504         ierr = VecPlaceArray(pcbddc->vec2_R,work+i*n_R);CHKERRQ(ierr);
4505         ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
4506         ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4507         ierr = VecResetArray(pcbddc->vec2_R);CHKERRQ(ierr);
4508       }
4509       ierr = MatDenseRestoreArray(B_C,&marray);CHKERRQ(ierr);
4510     }
4511     /* coarse basis functions */
4512     for (i=0;i<pcbddc->local_primal_size;i++) {
4513       PetscScalar *y;
4514 
4515       ierr = VecPlaceArray(pcbddc->vec1_R,work+i*n_R);CHKERRQ(ierr);
4516       ierr = MatDenseGetArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4517       ierr = VecPlaceArray(pcis->vec1_B,y+n_B*i);CHKERRQ(ierr);
4518       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4519       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4520       if (i<n_vertices) {
4521         y[n_B*i+idx_V_B[i]] = 1.0;
4522       }
4523       ierr = MatDenseRestoreArray(pcbddc->coarse_psi_B,&y);CHKERRQ(ierr);
4524       ierr = VecResetArray(pcis->vec1_B);CHKERRQ(ierr);
4525 
4526       if (pcbddc->switch_static || pcbddc->dbg_flag) {
4527         ierr = MatDenseGetArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4528         ierr = VecPlaceArray(pcis->vec1_D,y+n_D*i);CHKERRQ(ierr);
4529         ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4530         ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,pcis->vec1_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4531         ierr = VecResetArray(pcis->vec1_D);CHKERRQ(ierr);
4532         ierr = MatDenseRestoreArray(pcbddc->coarse_psi_D,&y);CHKERRQ(ierr);
4533       }
4534       ierr = VecResetArray(pcbddc->vec1_R);CHKERRQ(ierr);
4535     }
4536     ierr = MatDestroy(&B_V);CHKERRQ(ierr);
4537     ierr = MatDestroy(&B_C);CHKERRQ(ierr);
4538   }
4539 
4540   /* free memory */
4541   ierr = PetscFree(idx_V_B);CHKERRQ(ierr);
4542   ierr = MatDestroy(&S_VV);CHKERRQ(ierr);
4543   ierr = MatDestroy(&S_CV);CHKERRQ(ierr);
4544   ierr = MatDestroy(&S_VC);CHKERRQ(ierr);
4545   ierr = MatDestroy(&S_CC);CHKERRQ(ierr);
4546   ierr = PetscFree(work);CHKERRQ(ierr);
4547   if (n_vertices) {
4548     ierr = MatDestroy(&A_VR);CHKERRQ(ierr);
4549   }
4550   if (n_constraints) {
4551     ierr = MatDestroy(&C_CR);CHKERRQ(ierr);
4552   }
4553   /* Checking coarse_sub_mat and coarse basis functios */
4554   /* Symmetric case     : It should be \Phi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4555   /* Non-symmetric case : It should be \Psi^{(j)^T} A^{(j)} \Phi^{(j)}=coarse_sub_mat */
4556   if (pcbddc->dbg_flag) {
4557     Mat         coarse_sub_mat;
4558     Mat         AUXMAT,TM1,TM2,TM3,TM4;
4559     Mat         coarse_phi_D,coarse_phi_B;
4560     Mat         coarse_psi_D,coarse_psi_B;
4561     Mat         A_II,A_BB,A_IB,A_BI;
4562     Mat         C_B,CPHI;
4563     IS          is_dummy;
4564     Vec         mones;
4565     MatType     checkmattype=MATSEQAIJ;
4566     PetscReal   real_value;
4567 
4568     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
4569       Mat A;
4570       ierr = PCBDDCBenignProject(pc,NULL,NULL,&A);CHKERRQ(ierr);
4571       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4572       ierr = MatCreateSubMatrix(A,pcis->is_I_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4573       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_I_local,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4574       ierr = MatCreateSubMatrix(A,pcis->is_B_local,pcis->is_B_local,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4575       ierr = MatDestroy(&A);CHKERRQ(ierr);
4576     } else {
4577       ierr = MatConvert(pcis->A_II,checkmattype,MAT_INITIAL_MATRIX,&A_II);CHKERRQ(ierr);
4578       ierr = MatConvert(pcis->A_IB,checkmattype,MAT_INITIAL_MATRIX,&A_IB);CHKERRQ(ierr);
4579       ierr = MatConvert(pcis->A_BI,checkmattype,MAT_INITIAL_MATRIX,&A_BI);CHKERRQ(ierr);
4580       ierr = MatConvert(pcis->A_BB,checkmattype,MAT_INITIAL_MATRIX,&A_BB);CHKERRQ(ierr);
4581     }
4582     ierr = MatConvert(pcbddc->coarse_phi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_D);CHKERRQ(ierr);
4583     ierr = MatConvert(pcbddc->coarse_phi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_phi_B);CHKERRQ(ierr);
4584     if (!pcbddc->symmetric_primal) {
4585       ierr = MatConvert(pcbddc->coarse_psi_D,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_D);CHKERRQ(ierr);
4586       ierr = MatConvert(pcbddc->coarse_psi_B,checkmattype,MAT_INITIAL_MATRIX,&coarse_psi_B);CHKERRQ(ierr);
4587     }
4588     ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,coarse_submat_vals,&coarse_sub_mat);CHKERRQ(ierr);
4589 
4590     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
4591     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse sub mat computation (symmetric %d)\n",pcbddc->symmetric_primal);CHKERRQ(ierr);
4592     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4593     if (!pcbddc->symmetric_primal) {
4594       ierr = MatMatMult(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4595       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4596       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4597       ierr = MatMatMult(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4598       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4599       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4600       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4601       ierr = MatTransposeMatMult(coarse_psi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4602       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4603       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4604       ierr = MatTransposeMatMult(coarse_psi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4605       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4606     } else {
4607       ierr = MatPtAP(A_II,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&TM1);CHKERRQ(ierr);
4608       ierr = MatPtAP(A_BB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&TM2);CHKERRQ(ierr);
4609       ierr = MatMatMult(A_IB,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4610       ierr = MatTransposeMatMult(coarse_phi_D,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM3);CHKERRQ(ierr);
4611       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4612       ierr = MatMatMult(A_BI,coarse_phi_D,MAT_INITIAL_MATRIX,1.0,&AUXMAT);CHKERRQ(ierr);
4613       ierr = MatTransposeMatMult(coarse_phi_B,AUXMAT,MAT_INITIAL_MATRIX,1.0,&TM4);CHKERRQ(ierr);
4614       ierr = MatDestroy(&AUXMAT);CHKERRQ(ierr);
4615     }
4616     ierr = MatAXPY(TM1,one,TM2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4617     ierr = MatAXPY(TM1,one,TM3,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4618     ierr = MatAXPY(TM1,one,TM4,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4619     ierr = MatConvert(TM1,MATSEQDENSE,MAT_INPLACE_MATRIX,&TM1);CHKERRQ(ierr);
4620     if (pcbddc->benign_n) {
4621       Mat         B0_B,B0_BPHI;
4622       PetscScalar *data,*data2;
4623       PetscInt    j;
4624 
4625       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4626       ierr = MatCreateSubMatrix(pcbddc->benign_B0,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
4627       ierr = MatMatMult(B0_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&B0_BPHI);CHKERRQ(ierr);
4628       ierr = MatConvert(B0_BPHI,MATSEQDENSE,MAT_INPLACE_MATRIX,&B0_BPHI);CHKERRQ(ierr);
4629       ierr = MatDenseGetArray(TM1,&data);CHKERRQ(ierr);
4630       ierr = MatDenseGetArray(B0_BPHI,&data2);CHKERRQ(ierr);
4631       for (j=0;j<pcbddc->benign_n;j++) {
4632         PetscInt primal_idx = pcbddc->local_primal_size - pcbddc->benign_n + j;
4633         for (i=0;i<pcbddc->local_primal_size;i++) {
4634           data[primal_idx*pcbddc->local_primal_size+i] += data2[i*pcbddc->benign_n+j];
4635           data[i*pcbddc->local_primal_size+primal_idx] += data2[i*pcbddc->benign_n+j];
4636         }
4637       }
4638       ierr = MatDenseRestoreArray(TM1,&data);CHKERRQ(ierr);
4639       ierr = MatDenseRestoreArray(B0_BPHI,&data2);CHKERRQ(ierr);
4640       ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
4641       ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4642       ierr = MatDestroy(&B0_BPHI);CHKERRQ(ierr);
4643     }
4644 #if 0
4645   {
4646     PetscViewer viewer;
4647     char filename[256];
4648     sprintf(filename,"details_local_coarse_mat%d_level%d.m",PetscGlobalRank,pcbddc->current_level);
4649     ierr = PetscViewerASCIIOpen(PETSC_COMM_SELF,filename,&viewer);CHKERRQ(ierr);
4650     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
4651     ierr = PetscObjectSetName((PetscObject)coarse_sub_mat,"computed");CHKERRQ(ierr);
4652     ierr = MatView(coarse_sub_mat,viewer);CHKERRQ(ierr);
4653     ierr = PetscObjectSetName((PetscObject)TM1,"projected");CHKERRQ(ierr);
4654     ierr = MatView(TM1,viewer);CHKERRQ(ierr);
4655     if (pcbddc->coarse_phi_B) {
4656       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_B,"phi_B");CHKERRQ(ierr);
4657       ierr = MatView(pcbddc->coarse_phi_B,viewer);CHKERRQ(ierr);
4658     }
4659     if (pcbddc->coarse_phi_D) {
4660       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_phi_D,"phi_D");CHKERRQ(ierr);
4661       ierr = MatView(pcbddc->coarse_phi_D,viewer);CHKERRQ(ierr);
4662     }
4663     if (pcbddc->coarse_psi_B) {
4664       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_B,"psi_B");CHKERRQ(ierr);
4665       ierr = MatView(pcbddc->coarse_psi_B,viewer);CHKERRQ(ierr);
4666     }
4667     if (pcbddc->coarse_psi_D) {
4668       ierr = PetscObjectSetName((PetscObject)pcbddc->coarse_psi_D,"psi_D");CHKERRQ(ierr);
4669       ierr = MatView(pcbddc->coarse_psi_D,viewer);CHKERRQ(ierr);
4670     }
4671     ierr = PetscObjectSetName((PetscObject)pcbddc->local_mat,"A");CHKERRQ(ierr);
4672     ierr = MatView(pcbddc->local_mat,viewer);CHKERRQ(ierr);
4673     ierr = PetscObjectSetName((PetscObject)pcbddc->ConstraintMatrix,"C");CHKERRQ(ierr);
4674     ierr = MatView(pcbddc->ConstraintMatrix,viewer);CHKERRQ(ierr);
4675     ierr = PetscObjectSetName((PetscObject)pcis->is_I_local,"I");CHKERRQ(ierr);
4676     ierr = ISView(pcis->is_I_local,viewer);CHKERRQ(ierr);
4677     ierr = PetscObjectSetName((PetscObject)pcis->is_B_local,"B");CHKERRQ(ierr);
4678     ierr = ISView(pcis->is_B_local,viewer);CHKERRQ(ierr);
4679     ierr = PetscObjectSetName((PetscObject)pcbddc->is_R_local,"R");CHKERRQ(ierr);
4680     ierr = ISView(pcbddc->is_R_local,viewer);CHKERRQ(ierr);
4681     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
4682   }
4683 #endif
4684     ierr = MatAXPY(TM1,m_one,coarse_sub_mat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
4685     ierr = MatNorm(TM1,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4686     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
4687     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d          matrix error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4688 
4689     /* check constraints */
4690     ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->local_primal_size-pcbddc->benign_n,0,1,&is_dummy);CHKERRQ(ierr);
4691     ierr = MatCreateSubMatrix(pcbddc->ConstraintMatrix,is_dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&C_B);CHKERRQ(ierr);
4692     if (!pcbddc->benign_n) { /* TODO: add benign case */
4693       ierr = MatMatMult(C_B,coarse_phi_B,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4694     } else {
4695       PetscScalar *data;
4696       Mat         tmat;
4697       ierr = MatDenseGetArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4698       ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcis->n_B,pcbddc->local_primal_size-pcbddc->benign_n,data,&tmat);CHKERRQ(ierr);
4699       ierr = MatDenseRestoreArray(pcbddc->coarse_phi_B,&data);CHKERRQ(ierr);
4700       ierr = MatMatMult(C_B,tmat,MAT_INITIAL_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4701       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
4702     }
4703     ierr = MatCreateVecs(CPHI,&mones,NULL);CHKERRQ(ierr);
4704     ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4705     ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4706     ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4707     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d phi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4708     if (!pcbddc->symmetric_primal) {
4709       ierr = MatMatMult(C_B,coarse_psi_B,MAT_REUSE_MATRIX,1.0,&CPHI);CHKERRQ(ierr);
4710       ierr = VecSet(mones,-1.0);CHKERRQ(ierr);
4711       ierr = MatDiagonalSet(CPHI,mones,ADD_VALUES);CHKERRQ(ierr);
4712       ierr = MatNorm(CPHI,NORM_FROBENIUS,&real_value);CHKERRQ(ierr);
4713       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d psi constraints error % 1.14e\n",PetscGlobalRank,real_value);CHKERRQ(ierr);
4714     }
4715     ierr = MatDestroy(&C_B);CHKERRQ(ierr);
4716     ierr = MatDestroy(&CPHI);CHKERRQ(ierr);
4717     ierr = ISDestroy(&is_dummy);CHKERRQ(ierr);
4718     ierr = VecDestroy(&mones);CHKERRQ(ierr);
4719     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
4720     ierr = MatDestroy(&A_II);CHKERRQ(ierr);
4721     ierr = MatDestroy(&A_BB);CHKERRQ(ierr);
4722     ierr = MatDestroy(&A_IB);CHKERRQ(ierr);
4723     ierr = MatDestroy(&A_BI);CHKERRQ(ierr);
4724     ierr = MatDestroy(&TM1);CHKERRQ(ierr);
4725     ierr = MatDestroy(&TM2);CHKERRQ(ierr);
4726     ierr = MatDestroy(&TM3);CHKERRQ(ierr);
4727     ierr = MatDestroy(&TM4);CHKERRQ(ierr);
4728     ierr = MatDestroy(&coarse_phi_D);CHKERRQ(ierr);
4729     ierr = MatDestroy(&coarse_phi_B);CHKERRQ(ierr);
4730     if (!pcbddc->symmetric_primal) {
4731       ierr = MatDestroy(&coarse_psi_D);CHKERRQ(ierr);
4732       ierr = MatDestroy(&coarse_psi_B);CHKERRQ(ierr);
4733     }
4734     ierr = MatDestroy(&coarse_sub_mat);CHKERRQ(ierr);
4735   }
4736   /* get back data */
4737   *coarse_submat_vals_n = coarse_submat_vals;
4738   PetscFunctionReturn(0);
4739 }
4740 
4741 PetscErrorCode MatCreateSubMatrixUnsorted(Mat A, IS isrow, IS iscol, Mat* B)
4742 {
4743   Mat            *work_mat;
4744   IS             isrow_s,iscol_s;
4745   PetscBool      rsorted,csorted;
4746   PetscInt       rsize,*idxs_perm_r=NULL,csize,*idxs_perm_c=NULL;
4747   PetscErrorCode ierr;
4748 
4749   PetscFunctionBegin;
4750   ierr = ISSorted(isrow,&rsorted);CHKERRQ(ierr);
4751   ierr = ISSorted(iscol,&csorted);CHKERRQ(ierr);
4752   ierr = ISGetLocalSize(isrow,&rsize);CHKERRQ(ierr);
4753   ierr = ISGetLocalSize(iscol,&csize);CHKERRQ(ierr);
4754 
4755   if (!rsorted) {
4756     const PetscInt *idxs;
4757     PetscInt *idxs_sorted,i;
4758 
4759     ierr = PetscMalloc1(rsize,&idxs_perm_r);CHKERRQ(ierr);
4760     ierr = PetscMalloc1(rsize,&idxs_sorted);CHKERRQ(ierr);
4761     for (i=0;i<rsize;i++) {
4762       idxs_perm_r[i] = i;
4763     }
4764     ierr = ISGetIndices(isrow,&idxs);CHKERRQ(ierr);
4765     ierr = PetscSortIntWithPermutation(rsize,idxs,idxs_perm_r);CHKERRQ(ierr);
4766     for (i=0;i<rsize;i++) {
4767       idxs_sorted[i] = idxs[idxs_perm_r[i]];
4768     }
4769     ierr = ISRestoreIndices(isrow,&idxs);CHKERRQ(ierr);
4770     ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_sorted,PETSC_OWN_POINTER,&isrow_s);CHKERRQ(ierr);
4771   } else {
4772     ierr = PetscObjectReference((PetscObject)isrow);CHKERRQ(ierr);
4773     isrow_s = isrow;
4774   }
4775 
4776   if (!csorted) {
4777     if (isrow == iscol) {
4778       ierr = PetscObjectReference((PetscObject)isrow_s);CHKERRQ(ierr);
4779       iscol_s = isrow_s;
4780     } else {
4781       const PetscInt *idxs;
4782       PetscInt       *idxs_sorted,i;
4783 
4784       ierr = PetscMalloc1(csize,&idxs_perm_c);CHKERRQ(ierr);
4785       ierr = PetscMalloc1(csize,&idxs_sorted);CHKERRQ(ierr);
4786       for (i=0;i<csize;i++) {
4787         idxs_perm_c[i] = i;
4788       }
4789       ierr = ISGetIndices(iscol,&idxs);CHKERRQ(ierr);
4790       ierr = PetscSortIntWithPermutation(csize,idxs,idxs_perm_c);CHKERRQ(ierr);
4791       for (i=0;i<csize;i++) {
4792         idxs_sorted[i] = idxs[idxs_perm_c[i]];
4793       }
4794       ierr = ISRestoreIndices(iscol,&idxs);CHKERRQ(ierr);
4795       ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_sorted,PETSC_OWN_POINTER,&iscol_s);CHKERRQ(ierr);
4796     }
4797   } else {
4798     ierr = PetscObjectReference((PetscObject)iscol);CHKERRQ(ierr);
4799     iscol_s = iscol;
4800   }
4801 
4802   ierr = MatCreateSubMatrices(A,1,&isrow_s,&iscol_s,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4803 
4804   if (!rsorted || !csorted) {
4805     Mat      new_mat;
4806     IS       is_perm_r,is_perm_c;
4807 
4808     if (!rsorted) {
4809       PetscInt *idxs_r,i;
4810       ierr = PetscMalloc1(rsize,&idxs_r);CHKERRQ(ierr);
4811       for (i=0;i<rsize;i++) {
4812         idxs_r[idxs_perm_r[i]] = i;
4813       }
4814       ierr = PetscFree(idxs_perm_r);CHKERRQ(ierr);
4815       ierr = ISCreateGeneral(PETSC_COMM_SELF,rsize,idxs_r,PETSC_OWN_POINTER,&is_perm_r);CHKERRQ(ierr);
4816     } else {
4817       ierr = ISCreateStride(PETSC_COMM_SELF,rsize,0,1,&is_perm_r);CHKERRQ(ierr);
4818     }
4819     ierr = ISSetPermutation(is_perm_r);CHKERRQ(ierr);
4820 
4821     if (!csorted) {
4822       if (isrow_s == iscol_s) {
4823         ierr = PetscObjectReference((PetscObject)is_perm_r);CHKERRQ(ierr);
4824         is_perm_c = is_perm_r;
4825       } else {
4826         PetscInt *idxs_c,i;
4827         if (!idxs_perm_c) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Permutation array not present");
4828         ierr = PetscMalloc1(csize,&idxs_c);CHKERRQ(ierr);
4829         for (i=0;i<csize;i++) {
4830           idxs_c[idxs_perm_c[i]] = i;
4831         }
4832         ierr = PetscFree(idxs_perm_c);CHKERRQ(ierr);
4833         ierr = ISCreateGeneral(PETSC_COMM_SELF,csize,idxs_c,PETSC_OWN_POINTER,&is_perm_c);CHKERRQ(ierr);
4834       }
4835     } else {
4836       ierr = ISCreateStride(PETSC_COMM_SELF,csize,0,1,&is_perm_c);CHKERRQ(ierr);
4837     }
4838     ierr = ISSetPermutation(is_perm_c);CHKERRQ(ierr);
4839 
4840     ierr = MatPermute(work_mat[0],is_perm_r,is_perm_c,&new_mat);CHKERRQ(ierr);
4841     ierr = MatDestroy(&work_mat[0]);CHKERRQ(ierr);
4842     work_mat[0] = new_mat;
4843     ierr = ISDestroy(&is_perm_r);CHKERRQ(ierr);
4844     ierr = ISDestroy(&is_perm_c);CHKERRQ(ierr);
4845   }
4846 
4847   ierr = PetscObjectReference((PetscObject)work_mat[0]);CHKERRQ(ierr);
4848   *B = work_mat[0];
4849   ierr = MatDestroyMatrices(1,&work_mat);CHKERRQ(ierr);
4850   ierr = ISDestroy(&isrow_s);CHKERRQ(ierr);
4851   ierr = ISDestroy(&iscol_s);CHKERRQ(ierr);
4852   PetscFunctionReturn(0);
4853 }
4854 
4855 PetscErrorCode PCBDDCComputeLocalMatrix(PC pc, Mat ChangeOfBasisMatrix)
4856 {
4857   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
4858   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
4859   Mat            new_mat,lA;
4860   IS             is_local,is_global;
4861   PetscInt       local_size;
4862   PetscBool      isseqaij;
4863   PetscErrorCode ierr;
4864 
4865   PetscFunctionBegin;
4866   ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4867   ierr = MatGetSize(matis->A,&local_size,NULL);CHKERRQ(ierr);
4868   ierr = ISCreateStride(PetscObjectComm((PetscObject)matis->A),local_size,0,1,&is_local);CHKERRQ(ierr);
4869   ierr = ISLocalToGlobalMappingApplyIS(pc->pmat->rmap->mapping,is_local,&is_global);CHKERRQ(ierr);
4870   ierr = ISDestroy(&is_local);CHKERRQ(ierr);
4871   ierr = MatCreateSubMatrixUnsorted(ChangeOfBasisMatrix,is_global,is_global,&new_mat);CHKERRQ(ierr);
4872   ierr = ISDestroy(&is_global);CHKERRQ(ierr);
4873 
4874   /* check */
4875   if (pcbddc->dbg_flag) {
4876     Vec       x,x_change;
4877     PetscReal error;
4878 
4879     ierr = MatCreateVecs(ChangeOfBasisMatrix,&x,&x_change);CHKERRQ(ierr);
4880     ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
4881     ierr = MatMult(ChangeOfBasisMatrix,x,x_change);CHKERRQ(ierr);
4882     ierr = VecScatterBegin(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4883     ierr = VecScatterEnd(matis->cctx,x,matis->x,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
4884     ierr = MatMult(new_mat,matis->x,matis->y);CHKERRQ(ierr);
4885     if (!pcbddc->change_interior) {
4886       const PetscScalar *x,*y,*v;
4887       PetscReal         lerror = 0.;
4888       PetscInt          i;
4889 
4890       ierr = VecGetArrayRead(matis->x,&x);CHKERRQ(ierr);
4891       ierr = VecGetArrayRead(matis->y,&y);CHKERRQ(ierr);
4892       ierr = VecGetArrayRead(matis->counter,&v);CHKERRQ(ierr);
4893       for (i=0;i<local_size;i++)
4894         if (PetscRealPart(v[i]) < 1.5 && PetscAbsScalar(x[i]-y[i]) > lerror)
4895           lerror = PetscAbsScalar(x[i]-y[i]);
4896       ierr = VecRestoreArrayRead(matis->x,&x);CHKERRQ(ierr);
4897       ierr = VecRestoreArrayRead(matis->y,&y);CHKERRQ(ierr);
4898       ierr = VecRestoreArrayRead(matis->counter,&v);CHKERRQ(ierr);
4899       ierr = MPIU_Allreduce(&lerror,&error,1,MPIU_REAL,MPI_MAX,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
4900       if (error > PETSC_SMALL) {
4901         if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4902           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on I: %1.6e\n",error);
4903         } else {
4904           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on I: %1.6e\n",error);
4905         }
4906       }
4907     }
4908     ierr = VecScatterBegin(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4909     ierr = VecScatterEnd(matis->rctx,matis->y,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
4910     ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
4911     ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
4912     if (error > PETSC_SMALL) {
4913       if (!pcbddc->user_ChangeOfBasisMatrix || pcbddc->current_level) {
4914         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
4915       } else {
4916         SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_USER,"Error global vs local change on N: %1.6e\n",error);
4917       }
4918     }
4919     ierr = VecDestroy(&x);CHKERRQ(ierr);
4920     ierr = VecDestroy(&x_change);CHKERRQ(ierr);
4921   }
4922 
4923   /* lA is present if we are setting up an inner BDDC for a saddle point FETI-DP */
4924   ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject*)&lA);CHKERRQ(ierr);
4925 
4926   /* TODO: HOW TO WORK WITH BAIJ and SBAIJ and SEQDENSE? */
4927   ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
4928   if (isseqaij) {
4929     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4930     ierr = MatPtAP(matis->A,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4931     if (lA) {
4932       Mat work;
4933       ierr = MatPtAP(lA,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4934       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4935       ierr = MatDestroy(&work);CHKERRQ(ierr);
4936     }
4937   } else {
4938     Mat work_mat;
4939 
4940     ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
4941     ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4942     ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&pcbddc->local_mat);CHKERRQ(ierr);
4943     ierr = MatDestroy(&work_mat);CHKERRQ(ierr);
4944     if (lA) {
4945       Mat work;
4946       ierr = MatConvert(lA,MATSEQAIJ,MAT_INITIAL_MATRIX,&work_mat);CHKERRQ(ierr);
4947       ierr = MatPtAP(work_mat,new_mat,MAT_INITIAL_MATRIX,2.0,&work);CHKERRQ(ierr);
4948       ierr = PetscObjectCompose((PetscObject)pc,"__KSPFETIDP_lA" ,(PetscObject)work);CHKERRQ(ierr);
4949       ierr = MatDestroy(&work);CHKERRQ(ierr);
4950     }
4951   }
4952   if (matis->A->symmetric_set) {
4953     ierr = MatSetOption(pcbddc->local_mat,MAT_SYMMETRIC,matis->A->symmetric);CHKERRQ(ierr);
4954 #if !defined(PETSC_USE_COMPLEX)
4955     ierr = MatSetOption(pcbddc->local_mat,MAT_HERMITIAN,matis->A->symmetric);CHKERRQ(ierr);
4956 #endif
4957   }
4958   ierr = MatDestroy(&new_mat);CHKERRQ(ierr);
4959   PetscFunctionReturn(0);
4960 }
4961 
4962 PetscErrorCode PCBDDCSetUpLocalScatters(PC pc)
4963 {
4964   PC_IS*          pcis = (PC_IS*)(pc->data);
4965   PC_BDDC*        pcbddc = (PC_BDDC*)pc->data;
4966   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
4967   PetscInt        *idx_R_local=NULL;
4968   PetscInt        n_vertices,i,j,n_R,n_D,n_B;
4969   PetscInt        vbs,bs;
4970   PetscBT         bitmask=NULL;
4971   PetscErrorCode  ierr;
4972 
4973   PetscFunctionBegin;
4974   /*
4975     No need to setup local scatters if
4976       - primal space is unchanged
4977         AND
4978       - we actually have locally some primal dofs (could not be true in multilevel or for isolated subdomains)
4979         AND
4980       - we are not in debugging mode (this is needed since there are Synchronized prints at the end of the subroutine
4981   */
4982   if (!pcbddc->new_primal_space_local && pcbddc->local_primal_size && !pcbddc->dbg_flag) {
4983     PetscFunctionReturn(0);
4984   }
4985   /* destroy old objects */
4986   ierr = ISDestroy(&pcbddc->is_R_local);CHKERRQ(ierr);
4987   ierr = VecScatterDestroy(&pcbddc->R_to_B);CHKERRQ(ierr);
4988   ierr = VecScatterDestroy(&pcbddc->R_to_D);CHKERRQ(ierr);
4989   /* Set Non-overlapping dimensions */
4990   n_B = pcis->n_B;
4991   n_D = pcis->n - n_B;
4992   n_vertices = pcbddc->n_vertices;
4993 
4994   /* Dohrmann's notation: dofs splitted in R (Remaining: all dofs but the vertices) and V (Vertices) */
4995 
4996   /* create auxiliary bitmask and allocate workspace */
4997   if (!sub_schurs || !sub_schurs->reuse_solver) {
4998     ierr = PetscMalloc1(pcis->n-n_vertices,&idx_R_local);CHKERRQ(ierr);
4999     ierr = PetscBTCreate(pcis->n,&bitmask);CHKERRQ(ierr);
5000     for (i=0;i<n_vertices;i++) {
5001       ierr = PetscBTSet(bitmask,pcbddc->local_primal_ref_node[i]);CHKERRQ(ierr);
5002     }
5003 
5004     for (i=0, n_R=0; i<pcis->n; i++) {
5005       if (!PetscBTLookup(bitmask,i)) {
5006         idx_R_local[n_R++] = i;
5007       }
5008     }
5009   } else { /* A different ordering (already computed) is present if we are reusing the Schur solver */
5010     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5011 
5012     ierr = ISGetIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5013     ierr = ISGetLocalSize(reuse_solver->is_R,&n_R);CHKERRQ(ierr);
5014   }
5015 
5016   /* Block code */
5017   vbs = 1;
5018   ierr = MatGetBlockSize(pcbddc->local_mat,&bs);CHKERRQ(ierr);
5019   if (bs>1 && !(n_vertices%bs)) {
5020     PetscBool is_blocked = PETSC_TRUE;
5021     PetscInt  *vary;
5022     if (!sub_schurs || !sub_schurs->reuse_solver) {
5023       ierr = PetscMalloc1(pcis->n/bs,&vary);CHKERRQ(ierr);
5024       ierr = PetscMemzero(vary,pcis->n/bs*sizeof(PetscInt));CHKERRQ(ierr);
5025       /* Verify that the vertex indices correspond to each element in a block (code taken from sbaij2.c) */
5026       /* 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 */
5027       for (i=0; i<n_vertices; i++) vary[pcbddc->local_primal_ref_node[i]/bs]++;
5028       for (i=0; i<pcis->n/bs; i++) {
5029         if (vary[i]!=0 && vary[i]!=bs) {
5030           is_blocked = PETSC_FALSE;
5031           break;
5032         }
5033       }
5034       ierr = PetscFree(vary);CHKERRQ(ierr);
5035     } else {
5036       /* Verify directly the R set */
5037       for (i=0; i<n_R/bs; i++) {
5038         PetscInt j,node=idx_R_local[bs*i];
5039         for (j=1; j<bs; j++) {
5040           if (node != idx_R_local[bs*i+j]-j) {
5041             is_blocked = PETSC_FALSE;
5042             break;
5043           }
5044         }
5045       }
5046     }
5047     if (is_blocked) { /* build compressed IS for R nodes (complement of vertices) */
5048       vbs = bs;
5049       for (i=0;i<n_R/vbs;i++) {
5050         idx_R_local[i] = idx_R_local[vbs*i]/vbs;
5051       }
5052     }
5053   }
5054   ierr = ISCreateBlock(PETSC_COMM_SELF,vbs,n_R/vbs,idx_R_local,PETSC_COPY_VALUES,&pcbddc->is_R_local);CHKERRQ(ierr);
5055   if (sub_schurs && sub_schurs->reuse_solver) {
5056     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5057 
5058     ierr = ISRestoreIndices(reuse_solver->is_R,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5059     ierr = ISDestroy(&reuse_solver->is_R);CHKERRQ(ierr);
5060     ierr = PetscObjectReference((PetscObject)pcbddc->is_R_local);CHKERRQ(ierr);
5061     reuse_solver->is_R = pcbddc->is_R_local;
5062   } else {
5063     ierr = PetscFree(idx_R_local);CHKERRQ(ierr);
5064   }
5065 
5066   /* print some info if requested */
5067   if (pcbddc->dbg_flag) {
5068     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5069     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5070     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5071     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d local dimensions\n",PetscGlobalRank);CHKERRQ(ierr);
5072     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"local_size = %d, dirichlet_size = %d, boundary_size = %d\n",pcis->n,n_D,n_B);CHKERRQ(ierr);
5073     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);
5074     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5075   }
5076 
5077   /* VecScatters pcbddc->R_to_B and (optionally) pcbddc->R_to_D */
5078   if (!sub_schurs || !sub_schurs->reuse_solver) {
5079     IS       is_aux1,is_aux2;
5080     PetscInt *aux_array1,*aux_array2,*is_indices,*idx_R_local;
5081 
5082     ierr = ISGetIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5083     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array1);CHKERRQ(ierr);
5084     ierr = PetscMalloc1(pcis->n_B-n_vertices,&aux_array2);CHKERRQ(ierr);
5085     ierr = ISGetIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5086     for (i=0; i<n_D; i++) {
5087       ierr = PetscBTSet(bitmask,is_indices[i]);CHKERRQ(ierr);
5088     }
5089     ierr = ISRestoreIndices(pcis->is_I_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5090     for (i=0, j=0; i<n_R; i++) {
5091       if (!PetscBTLookup(bitmask,idx_R_local[i])) {
5092         aux_array1[j++] = i;
5093       }
5094     }
5095     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5096     ierr = ISGetIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5097     for (i=0, j=0; i<n_B; i++) {
5098       if (!PetscBTLookup(bitmask,is_indices[i])) {
5099         aux_array2[j++] = i;
5100       }
5101     }
5102     ierr = ISRestoreIndices(pcis->is_B_local,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5103     ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array2,PETSC_OWN_POINTER,&is_aux2);CHKERRQ(ierr);
5104     ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_B,is_aux2,&pcbddc->R_to_B);CHKERRQ(ierr);
5105     ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5106     ierr = ISDestroy(&is_aux2);CHKERRQ(ierr);
5107 
5108     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5109       ierr = PetscMalloc1(n_D,&aux_array1);CHKERRQ(ierr);
5110       for (i=0, j=0; i<n_R; i++) {
5111         if (PetscBTLookup(bitmask,idx_R_local[i])) {
5112           aux_array1[j++] = i;
5113         }
5114       }
5115       ierr = ISCreateGeneral(PETSC_COMM_SELF,j,aux_array1,PETSC_OWN_POINTER,&is_aux1);CHKERRQ(ierr);
5116       ierr = VecScatterCreate(pcbddc->vec1_R,is_aux1,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5117       ierr = ISDestroy(&is_aux1);CHKERRQ(ierr);
5118     }
5119     ierr = PetscBTDestroy(&bitmask);CHKERRQ(ierr);
5120     ierr = ISRestoreIndices(pcbddc->is_R_local,(const PetscInt**)&idx_R_local);CHKERRQ(ierr);
5121   } else {
5122     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5123     IS                 tis;
5124     PetscInt           schur_size;
5125 
5126     ierr = ISGetLocalSize(reuse_solver->is_B,&schur_size);CHKERRQ(ierr);
5127     ierr = ISCreateStride(PETSC_COMM_SELF,schur_size,n_D,1,&tis);CHKERRQ(ierr);
5128     ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_B,reuse_solver->is_B,&pcbddc->R_to_B);CHKERRQ(ierr);
5129     ierr = ISDestroy(&tis);CHKERRQ(ierr);
5130     if (pcbddc->switch_static || pcbddc->dbg_flag) {
5131       ierr = ISCreateStride(PETSC_COMM_SELF,n_D,0,1,&tis);CHKERRQ(ierr);
5132       ierr = VecScatterCreate(pcbddc->vec1_R,tis,pcis->vec1_D,(IS)0,&pcbddc->R_to_D);CHKERRQ(ierr);
5133       ierr = ISDestroy(&tis);CHKERRQ(ierr);
5134     }
5135   }
5136   PetscFunctionReturn(0);
5137 }
5138 
5139 
5140 PetscErrorCode PCBDDCSetUpLocalSolvers(PC pc, PetscBool dirichlet, PetscBool neumann)
5141 {
5142   PC_BDDC        *pcbddc = (PC_BDDC*)pc->data;
5143   PC_IS          *pcis = (PC_IS*)pc->data;
5144   PC             pc_temp;
5145   Mat            A_RR;
5146   MatReuse       reuse;
5147   PetscScalar    m_one = -1.0;
5148   PetscReal      value;
5149   PetscInt       n_D,n_R;
5150   PetscBool      check_corr,issbaij;
5151   PetscErrorCode ierr;
5152   /* prefixes stuff */
5153   char           dir_prefix[256],neu_prefix[256],str_level[16];
5154   size_t         len;
5155 
5156   PetscFunctionBegin;
5157 
5158   /* compute prefixes */
5159   ierr = PetscStrcpy(dir_prefix,"");CHKERRQ(ierr);
5160   ierr = PetscStrcpy(neu_prefix,"");CHKERRQ(ierr);
5161   if (!pcbddc->current_level) {
5162     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,sizeof(dir_prefix));CHKERRQ(ierr);
5163     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,sizeof(neu_prefix));CHKERRQ(ierr);
5164     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5165     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5166   } else {
5167     ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
5168     ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
5169     len -= 15; /* remove "pc_bddc_coarse_" */
5170     if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
5171     if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
5172     /* Nonstandard use of PetscStrncpy() to only copy a portion of the input string */
5173     ierr = PetscStrncpy(dir_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5174     ierr = PetscStrncpy(neu_prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
5175     ierr = PetscStrlcat(dir_prefix,"pc_bddc_dirichlet_",sizeof(dir_prefix));CHKERRQ(ierr);
5176     ierr = PetscStrlcat(neu_prefix,"pc_bddc_neumann_",sizeof(neu_prefix));CHKERRQ(ierr);
5177     ierr = PetscStrlcat(dir_prefix,str_level,sizeof(dir_prefix));CHKERRQ(ierr);
5178     ierr = PetscStrlcat(neu_prefix,str_level,sizeof(neu_prefix));CHKERRQ(ierr);
5179   }
5180 
5181   /* DIRICHLET PROBLEM */
5182   if (dirichlet) {
5183     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5184     if (pcbddc->benign_n && !pcbddc->benign_change_explicit) {
5185       if (!sub_schurs || !sub_schurs->reuse_solver) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Not yet implemented\n");
5186       if (pcbddc->dbg_flag) {
5187         Mat    A_IIn;
5188 
5189         ierr = PCBDDCBenignProject(pc,pcis->is_I_local,pcis->is_I_local,&A_IIn);CHKERRQ(ierr);
5190         ierr = MatDestroy(&pcis->A_II);CHKERRQ(ierr);
5191         pcis->A_II = A_IIn;
5192       }
5193     }
5194     if (pcbddc->local_mat->symmetric_set) {
5195       ierr = MatSetOption(pcis->A_II,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5196     }
5197     /* Matrix for Dirichlet problem is pcis->A_II */
5198     n_D = pcis->n - pcis->n_B;
5199     if (!pcbddc->ksp_D) { /* create object if not yet build */
5200       void (*f)(void) = 0;
5201 
5202       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_D);CHKERRQ(ierr);
5203       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_D,(PetscObject)pc,1);CHKERRQ(ierr);
5204       /* default */
5205       ierr = KSPSetType(pcbddc->ksp_D,KSPPREONLY);CHKERRQ(ierr);
5206       ierr = KSPSetOptionsPrefix(pcbddc->ksp_D,dir_prefix);CHKERRQ(ierr);
5207       ierr = PetscObjectTypeCompare((PetscObject)pcis->A_II,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5208       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5209       if (issbaij) {
5210         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5211       } else {
5212         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5213       }
5214       /* Allow user's customization */
5215       ierr = KSPSetFromOptions(pcbddc->ksp_D);CHKERRQ(ierr);
5216       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5217       if (f && pcbddc->mat_graph->cloc) {
5218         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5219         const PetscInt *idxs;
5220         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5221 
5222         ierr = ISGetLocalSize(pcis->is_I_local,&nl);CHKERRQ(ierr);
5223         ierr = ISGetIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5224         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5225         for (i=0;i<nl;i++) {
5226           for (d=0;d<cdim;d++) {
5227             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5228           }
5229         }
5230         ierr = ISRestoreIndices(pcis->is_I_local,&idxs);CHKERRQ(ierr);
5231         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5232         ierr = PetscFree(scoords);CHKERRQ(ierr);
5233       }
5234     }
5235     ierr = KSPSetOperators(pcbddc->ksp_D,pcis->A_II,pcis->A_II);CHKERRQ(ierr);
5236     if (sub_schurs && sub_schurs->reuse_solver) {
5237       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5238 
5239       ierr = KSPSetPC(pcbddc->ksp_D,reuse_solver->interior_solver);CHKERRQ(ierr);
5240     }
5241     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5242     if (!n_D) {
5243       ierr = KSPGetPC(pcbddc->ksp_D,&pc_temp);CHKERRQ(ierr);
5244       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5245     }
5246     /* set ksp_D into pcis data */
5247     ierr = KSPDestroy(&pcis->ksp_D);CHKERRQ(ierr);
5248     ierr = PetscObjectReference((PetscObject)pcbddc->ksp_D);CHKERRQ(ierr);
5249     pcis->ksp_D = pcbddc->ksp_D;
5250   }
5251 
5252   /* NEUMANN PROBLEM */
5253   A_RR = 0;
5254   if (neumann) {
5255     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5256     PetscInt        ibs,mbs;
5257     PetscBool       issbaij, reuse_neumann_solver;
5258     Mat_IS*         matis = (Mat_IS*)pc->pmat->data;
5259 
5260     reuse_neumann_solver = PETSC_FALSE;
5261     if (sub_schurs && sub_schurs->reuse_solver) {
5262       IS iP;
5263 
5264       reuse_neumann_solver = PETSC_TRUE;
5265       ierr = PetscObjectQuery((PetscObject)sub_schurs->A,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
5266       if (iP) reuse_neumann_solver = PETSC_FALSE;
5267     }
5268     /* Matrix for Neumann problem is A_RR -> we need to create/reuse it at this point */
5269     ierr = ISGetSize(pcbddc->is_R_local,&n_R);CHKERRQ(ierr);
5270     if (pcbddc->ksp_R) { /* already created ksp */
5271       PetscInt nn_R;
5272       ierr = KSPGetOperators(pcbddc->ksp_R,NULL,&A_RR);CHKERRQ(ierr);
5273       ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5274       ierr = MatGetSize(A_RR,&nn_R,NULL);CHKERRQ(ierr);
5275       if (nn_R != n_R) { /* old ksp is not reusable, so reset it */
5276         ierr = KSPReset(pcbddc->ksp_R);CHKERRQ(ierr);
5277         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5278         reuse = MAT_INITIAL_MATRIX;
5279       } else { /* same sizes, but nonzero pattern depend on primal vertices so it can be changed */
5280         if (pcbddc->new_primal_space_local) { /* we are not sure the matrix will have the same nonzero pattern */
5281           ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5282           reuse = MAT_INITIAL_MATRIX;
5283         } else { /* safe to reuse the matrix */
5284           reuse = MAT_REUSE_MATRIX;
5285         }
5286       }
5287       /* last check */
5288       if (pc->flag == DIFFERENT_NONZERO_PATTERN) {
5289         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5290         reuse = MAT_INITIAL_MATRIX;
5291       }
5292     } else { /* first time, so we need to create the matrix */
5293       reuse = MAT_INITIAL_MATRIX;
5294     }
5295     /* convert pcbddc->local_mat if needed later in PCBDDCSetUpCorrection */
5296     ierr = MatGetBlockSize(pcbddc->local_mat,&mbs);CHKERRQ(ierr);
5297     ierr = ISGetBlockSize(pcbddc->is_R_local,&ibs);CHKERRQ(ierr);
5298     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5299     if (ibs != mbs) { /* need to convert to SEQAIJ to extract any submatrix with is_R_local */
5300       if (matis->A == pcbddc->local_mat) {
5301         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5302         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5303       } else {
5304         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5305       }
5306     } else if (issbaij) { /* need to convert to BAIJ to get offdiagonal blocks */
5307       if (matis->A == pcbddc->local_mat) {
5308         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
5309         ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5310       } else {
5311         ierr = MatConvert(pcbddc->local_mat,MATSEQBAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
5312       }
5313     }
5314     /* extract A_RR */
5315     if (reuse_neumann_solver) {
5316       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5317 
5318       if (pcbddc->dbg_flag) { /* we need A_RR to test the solver later */
5319         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5320         if (reuse_solver->benign_n) { /* we are not using the explicit change of basis on the pressures */
5321           ierr = PCBDDCBenignProject(pc,pcbddc->is_R_local,pcbddc->is_R_local,&A_RR);CHKERRQ(ierr);
5322         } else {
5323           ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,MAT_INITIAL_MATRIX,&A_RR);CHKERRQ(ierr);
5324         }
5325       } else {
5326         ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5327         ierr = PCGetOperators(reuse_solver->correction_solver,&A_RR,NULL);CHKERRQ(ierr);
5328         ierr = PetscObjectReference((PetscObject)A_RR);CHKERRQ(ierr);
5329       }
5330     } else { /* we have to build the neumann solver, so we need to extract the relevant matrix */
5331       ierr = MatCreateSubMatrix(pcbddc->local_mat,pcbddc->is_R_local,pcbddc->is_R_local,reuse,&A_RR);CHKERRQ(ierr);
5332     }
5333     if (pcbddc->local_mat->symmetric_set) {
5334       ierr = MatSetOption(A_RR,MAT_SYMMETRIC,pcbddc->local_mat->symmetric_set);CHKERRQ(ierr);
5335     }
5336     if (!pcbddc->ksp_R) { /* create object if not present */
5337       void (*f)(void) = 0;
5338 
5339       ierr = KSPCreate(PETSC_COMM_SELF,&pcbddc->ksp_R);CHKERRQ(ierr);
5340       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->ksp_R,(PetscObject)pc,1);CHKERRQ(ierr);
5341       /* default */
5342       ierr = KSPSetType(pcbddc->ksp_R,KSPPREONLY);CHKERRQ(ierr);
5343       ierr = KSPSetOptionsPrefix(pcbddc->ksp_R,neu_prefix);CHKERRQ(ierr);
5344       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5345       ierr = PetscObjectTypeCompare((PetscObject)A_RR,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
5346       if (issbaij) {
5347         ierr = PCSetType(pc_temp,PCCHOLESKY);CHKERRQ(ierr);
5348       } else {
5349         ierr = PCSetType(pc_temp,PCLU);CHKERRQ(ierr);
5350       }
5351       /* Allow user's customization */
5352       ierr = KSPSetFromOptions(pcbddc->ksp_R);CHKERRQ(ierr);
5353       ierr = PetscObjectQueryFunction((PetscObject)pc_temp,"PCSetCoordinates_C",&f);CHKERRQ(ierr);
5354       if (f && pcbddc->mat_graph->cloc) {
5355         PetscReal      *coords = pcbddc->mat_graph->coords,*scoords;
5356         const PetscInt *idxs;
5357         PetscInt       cdim = pcbddc->mat_graph->cdim,nl,i,d;
5358 
5359         ierr = ISGetLocalSize(pcbddc->is_R_local,&nl);CHKERRQ(ierr);
5360         ierr = ISGetIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5361         ierr = PetscMalloc1(nl*cdim,&scoords);CHKERRQ(ierr);
5362         for (i=0;i<nl;i++) {
5363           for (d=0;d<cdim;d++) {
5364             scoords[i*cdim+d] = coords[idxs[i]*cdim+d];
5365           }
5366         }
5367         ierr = ISRestoreIndices(pcbddc->is_R_local,&idxs);CHKERRQ(ierr);
5368         ierr = PCSetCoordinates(pc_temp,cdim,nl,scoords);CHKERRQ(ierr);
5369         ierr = PetscFree(scoords);CHKERRQ(ierr);
5370       }
5371     }
5372     /* umfpack interface has a bug when matrix dimension is zero. TODO solve from umfpack interface */
5373     if (!n_R) {
5374       ierr = KSPGetPC(pcbddc->ksp_R,&pc_temp);CHKERRQ(ierr);
5375       ierr = PCSetType(pc_temp,PCNONE);CHKERRQ(ierr);
5376     }
5377     ierr = KSPSetOperators(pcbddc->ksp_R,A_RR,A_RR);CHKERRQ(ierr);
5378     /* Reuse solver if it is present */
5379     if (reuse_neumann_solver) {
5380       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5381 
5382       ierr = KSPSetPC(pcbddc->ksp_R,reuse_solver->correction_solver);CHKERRQ(ierr);
5383     }
5384   }
5385 
5386   if (pcbddc->dbg_flag) {
5387     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5388     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5389     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
5390   }
5391 
5392   /* adapt Dirichlet and Neumann solvers if a nullspace correction has been requested */
5393   check_corr = PETSC_FALSE;
5394   if (pcbddc->NullSpace_corr[0]) {
5395     ierr = PCBDDCSetUseExactDirichlet(pc,PETSC_FALSE);CHKERRQ(ierr);
5396   }
5397   if (dirichlet && pcbddc->NullSpace_corr[0] && !pcbddc->switch_static) {
5398     check_corr = PETSC_TRUE;
5399     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_TRUE,pcbddc->NullSpace_corr[1]);CHKERRQ(ierr);
5400   }
5401   if (neumann && pcbddc->NullSpace_corr[2]) {
5402     check_corr = PETSC_TRUE;
5403     ierr = PCBDDCNullSpaceAssembleCorrection(pc,PETSC_FALSE,pcbddc->NullSpace_corr[3]);CHKERRQ(ierr);
5404   }
5405   /* check Dirichlet and Neumann solvers */
5406   if (pcbddc->dbg_flag) {
5407     if (dirichlet) { /* Dirichlet */
5408       ierr = VecSetRandom(pcis->vec1_D,NULL);CHKERRQ(ierr);
5409       ierr = MatMult(pcis->A_II,pcis->vec1_D,pcis->vec2_D);CHKERRQ(ierr);
5410       ierr = KSPSolve(pcbddc->ksp_D,pcis->vec2_D,pcis->vec2_D);CHKERRQ(ierr);
5411       ierr = VecAXPY(pcis->vec1_D,m_one,pcis->vec2_D);CHKERRQ(ierr);
5412       ierr = VecNorm(pcis->vec1_D,NORM_INFINITY,&value);CHKERRQ(ierr);
5413       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);
5414       if (check_corr) {
5415         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_TRUE);CHKERRQ(ierr);
5416       }
5417       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5418     }
5419     if (neumann) { /* Neumann */
5420       ierr = VecSetRandom(pcbddc->vec1_R,NULL);CHKERRQ(ierr);
5421       ierr = MatMult(A_RR,pcbddc->vec1_R,pcbddc->vec2_R);CHKERRQ(ierr);
5422       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec2_R,pcbddc->vec2_R);CHKERRQ(ierr);
5423       ierr = VecAXPY(pcbddc->vec1_R,m_one,pcbddc->vec2_R);CHKERRQ(ierr);
5424       ierr = VecNorm(pcbddc->vec1_R,NORM_INFINITY,&value);CHKERRQ(ierr);
5425       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);
5426       if (check_corr) {
5427         ierr = PCBDDCNullSpaceCheckCorrection(pc,PETSC_FALSE);CHKERRQ(ierr);
5428       }
5429       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5430     }
5431   }
5432   /* free Neumann problem's matrix */
5433   ierr = MatDestroy(&A_RR);CHKERRQ(ierr);
5434   PetscFunctionReturn(0);
5435 }
5436 
5437 static PetscErrorCode  PCBDDCSolveSubstructureCorrection(PC pc, Vec inout_B, Vec inout_D, PetscBool applytranspose)
5438 {
5439   PetscErrorCode  ierr;
5440   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5441   PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
5442   PetscBool       reuse_solver = sub_schurs ? ( sub_schurs->reuse_solver ? PETSC_TRUE : PETSC_FALSE ) : PETSC_FALSE;
5443 
5444   PetscFunctionBegin;
5445   if (!reuse_solver) {
5446     ierr = VecSet(pcbddc->vec1_R,0.);CHKERRQ(ierr);
5447   }
5448   if (!pcbddc->switch_static) {
5449     if (applytranspose && pcbddc->local_auxmat1) {
5450       ierr = MatMultTranspose(pcbddc->local_auxmat2,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5451       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5452     }
5453     if (!reuse_solver) {
5454       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5455       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5456     } else {
5457       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5458 
5459       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5460       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,inout_B,reuse_solver->rhs_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5461     }
5462   } else {
5463     ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5464     ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5465     ierr = VecScatterBegin(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5466     ierr = VecScatterEnd(pcbddc->R_to_D,inout_D,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5467     if (applytranspose && pcbddc->local_auxmat1) {
5468       ierr = MatMultTranspose(pcbddc->local_auxmat2,pcbddc->vec1_R,pcbddc->vec1_C);CHKERRQ(ierr);
5469       ierr = MatMultTransposeAdd(pcbddc->local_auxmat1,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5470       ierr = VecScatterBegin(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5471       ierr = VecScatterEnd(pcbddc->R_to_B,inout_B,pcbddc->vec1_R,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5472     }
5473   }
5474   if (!reuse_solver || pcbddc->switch_static) {
5475     if (applytranspose) {
5476       ierr = KSPSolveTranspose(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5477     } else {
5478       ierr = KSPSolve(pcbddc->ksp_R,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5479     }
5480   } else {
5481     PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5482 
5483     if (applytranspose) {
5484       ierr = MatFactorSolveSchurComplementTranspose(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5485     } else {
5486       ierr = MatFactorSolveSchurComplement(reuse_solver->F,reuse_solver->rhs_B,reuse_solver->sol_B);CHKERRQ(ierr);
5487     }
5488   }
5489   ierr = VecSet(inout_B,0.);CHKERRQ(ierr);
5490   if (!pcbddc->switch_static) {
5491     if (!reuse_solver) {
5492       ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5493       ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5494     } else {
5495       PCBDDCReuseSolvers reuse_solver = sub_schurs->reuse_solver;
5496 
5497       ierr = VecScatterBegin(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5498       ierr = VecScatterEnd(reuse_solver->correction_scatter_B,reuse_solver->sol_B,inout_B,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5499     }
5500     if (!applytranspose && pcbddc->local_auxmat1) {
5501       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5502       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,inout_B,inout_B);CHKERRQ(ierr);
5503     }
5504   } else {
5505     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5506     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5507     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5508     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5509     if (!applytranspose && pcbddc->local_auxmat1) {
5510       ierr = MatMult(pcbddc->local_auxmat1,inout_B,pcbddc->vec1_C);CHKERRQ(ierr);
5511       ierr = MatMultAdd(pcbddc->local_auxmat2,pcbddc->vec1_C,pcbddc->vec1_R,pcbddc->vec1_R);CHKERRQ(ierr);
5512     }
5513     ierr = VecScatterBegin(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5514     ierr = VecScatterEnd(pcbddc->R_to_B,pcbddc->vec1_R,inout_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5515     ierr = VecScatterBegin(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5516     ierr = VecScatterEnd(pcbddc->R_to_D,pcbddc->vec1_R,inout_D,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5517   }
5518   PetscFunctionReturn(0);
5519 }
5520 
5521 /* parameter apply transpose determines if the interface preconditioner should be applied transposed or not */
5522 PetscErrorCode  PCBDDCApplyInterfacePreconditioner(PC pc, PetscBool applytranspose)
5523 {
5524   PetscErrorCode ierr;
5525   PC_BDDC*        pcbddc = (PC_BDDC*)(pc->data);
5526   PC_IS*            pcis = (PC_IS*)  (pc->data);
5527   const PetscScalar zero = 0.0;
5528 
5529   PetscFunctionBegin;
5530   /* Application of PSI^T or PHI^T (depending on applytranspose, see comment above) */
5531   if (!pcbddc->benign_apply_coarse_only) {
5532     if (applytranspose) {
5533       ierr = MatMultTranspose(pcbddc->coarse_phi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5534       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_phi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5535     } else {
5536       ierr = MatMultTranspose(pcbddc->coarse_psi_B,pcis->vec1_B,pcbddc->vec1_P);CHKERRQ(ierr);
5537       if (pcbddc->switch_static) { ierr = MatMultTransposeAdd(pcbddc->coarse_psi_D,pcis->vec1_D,pcbddc->vec1_P,pcbddc->vec1_P);CHKERRQ(ierr); }
5538     }
5539   } else {
5540     ierr = VecSet(pcbddc->vec1_P,zero);CHKERRQ(ierr);
5541   }
5542 
5543   /* add p0 to the last value of vec1_P holding the coarse dof relative to p0 */
5544   if (pcbddc->benign_n) {
5545     PetscScalar *array;
5546     PetscInt    j;
5547 
5548     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5549     for (j=0;j<pcbddc->benign_n;j++) array[pcbddc->local_primal_size-pcbddc->benign_n+j] += pcbddc->benign_p0[j];
5550     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5551   }
5552 
5553   /* start communications from local primal nodes to rhs of coarse solver */
5554   ierr = VecSet(pcbddc->coarse_vec,zero);CHKERRQ(ierr);
5555   ierr = PCBDDCScatterCoarseDataBegin(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5556   ierr = PCBDDCScatterCoarseDataEnd(pc,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5557 
5558   /* Coarse solution -> rhs and sol updated inside PCBDDCScattarCoarseDataBegin/End */
5559   if (pcbddc->coarse_ksp) {
5560     Mat          coarse_mat;
5561     Vec          rhs,sol;
5562     MatNullSpace nullsp;
5563     PetscBool    isbddc = PETSC_FALSE;
5564 
5565     if (pcbddc->benign_have_null) {
5566       PC        coarse_pc;
5567 
5568       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5569       ierr = PetscObjectTypeCompare((PetscObject)coarse_pc,PCBDDC,&isbddc);CHKERRQ(ierr);
5570       /* we need to propagate to coarser levels the need for a possible benign correction */
5571       if (isbddc && pcbddc->benign_apply_coarse_only && !pcbddc->benign_skip_correction) {
5572         PC_BDDC* coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5573         coarsepcbddc->benign_skip_correction = PETSC_FALSE;
5574         coarsepcbddc->benign_apply_coarse_only = PETSC_TRUE;
5575       }
5576     }
5577     ierr = KSPGetRhs(pcbddc->coarse_ksp,&rhs);CHKERRQ(ierr);
5578     ierr = KSPGetSolution(pcbddc->coarse_ksp,&sol);CHKERRQ(ierr);
5579     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
5580     ierr = MatGetNullSpace(coarse_mat,&nullsp);CHKERRQ(ierr);
5581     if (nullsp) {
5582       ierr = MatNullSpaceRemove(nullsp,rhs);CHKERRQ(ierr);
5583     }
5584     if (applytranspose) {
5585       if (pcbddc->benign_apply_coarse_only) SETERRQ(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),PETSC_ERR_SUP,"Not yet implemented");
5586       ierr = KSPSolveTranspose(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5587     } else {
5588       if (pcbddc->benign_apply_coarse_only && isbddc) { /* need just to apply the coarse preconditioner during presolve */
5589         PC        coarse_pc;
5590 
5591         ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5592         ierr = PCPreSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5593         ierr = PCBDDCBenignRemoveInterior(coarse_pc,rhs,sol);CHKERRQ(ierr);
5594         ierr = PCPostSolve(coarse_pc,pcbddc->coarse_ksp);CHKERRQ(ierr);
5595       } else {
5596         ierr = KSPSolve(pcbddc->coarse_ksp,rhs,sol);CHKERRQ(ierr);
5597       }
5598     }
5599     /* we don't need the benign correction at coarser levels anymore */
5600     if (pcbddc->benign_have_null && isbddc) {
5601       PC        coarse_pc;
5602       PC_BDDC*  coarsepcbddc;
5603 
5604       ierr = KSPGetPC(pcbddc->coarse_ksp,&coarse_pc);CHKERRQ(ierr);
5605       coarsepcbddc = (PC_BDDC*)(coarse_pc->data);
5606       coarsepcbddc->benign_skip_correction = PETSC_TRUE;
5607       coarsepcbddc->benign_apply_coarse_only = PETSC_FALSE;
5608     }
5609     if (nullsp) {
5610       ierr = MatNullSpaceRemove(nullsp,sol);CHKERRQ(ierr);
5611     }
5612   }
5613 
5614   /* Local solution on R nodes */
5615   if (pcis->n && !pcbddc->benign_apply_coarse_only) {
5616     ierr = PCBDDCSolveSubstructureCorrection(pc,pcis->vec1_B,pcis->vec1_D,applytranspose);CHKERRQ(ierr);
5617   }
5618   /* communications from coarse sol to local primal nodes */
5619   ierr = PCBDDCScatterCoarseDataBegin(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5620   ierr = PCBDDCScatterCoarseDataEnd(pc,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
5621 
5622   /* Sum contributions from the two levels */
5623   if (!pcbddc->benign_apply_coarse_only) {
5624     if (applytranspose) {
5625       ierr = MatMultAdd(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5626       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_psi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5627     } else {
5628       ierr = MatMultAdd(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
5629       if (pcbddc->switch_static) { ierr = MatMultAdd(pcbddc->coarse_phi_D,pcbddc->vec1_P,pcis->vec1_D,pcis->vec1_D);CHKERRQ(ierr); }
5630     }
5631     /* store p0 */
5632     if (pcbddc->benign_n) {
5633       PetscScalar *array;
5634       PetscInt    j;
5635 
5636       ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5637       for (j=0;j<pcbddc->benign_n;j++) pcbddc->benign_p0[j] = array[pcbddc->local_primal_size-pcbddc->benign_n+j];
5638       ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
5639     }
5640   } else { /* expand the coarse solution */
5641     if (applytranspose) {
5642       ierr = MatMult(pcbddc->coarse_psi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5643     } else {
5644       ierr = MatMult(pcbddc->coarse_phi_B,pcbddc->vec1_P,pcis->vec1_B);CHKERRQ(ierr);
5645     }
5646   }
5647   PetscFunctionReturn(0);
5648 }
5649 
5650 PetscErrorCode PCBDDCScatterCoarseDataBegin(PC pc,InsertMode imode, ScatterMode smode)
5651 {
5652   PetscErrorCode ierr;
5653   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5654   PetscScalar    *array;
5655   Vec            from,to;
5656 
5657   PetscFunctionBegin;
5658   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5659     from = pcbddc->coarse_vec;
5660     to = pcbddc->vec1_P;
5661     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5662       Vec tvec;
5663 
5664       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5665       ierr = VecResetArray(tvec);CHKERRQ(ierr);
5666       ierr = KSPGetSolution(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5667       ierr = VecGetArray(tvec,&array);CHKERRQ(ierr);
5668       ierr = VecPlaceArray(from,array);CHKERRQ(ierr);
5669       ierr = VecRestoreArray(tvec,&array);CHKERRQ(ierr);
5670     }
5671   } else { /* from local to global -> put data in coarse right hand side */
5672     from = pcbddc->vec1_P;
5673     to = pcbddc->coarse_vec;
5674   }
5675   ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5676   PetscFunctionReturn(0);
5677 }
5678 
5679 PetscErrorCode PCBDDCScatterCoarseDataEnd(PC pc, InsertMode imode, ScatterMode smode)
5680 {
5681   PetscErrorCode ierr;
5682   PC_BDDC*       pcbddc = (PC_BDDC*)(pc->data);
5683   PetscScalar    *array;
5684   Vec            from,to;
5685 
5686   PetscFunctionBegin;
5687   if (smode == SCATTER_REVERSE) { /* from global to local -> get data from coarse solution */
5688     from = pcbddc->coarse_vec;
5689     to = pcbddc->vec1_P;
5690   } else { /* from local to global -> put data in coarse right hand side */
5691     from = pcbddc->vec1_P;
5692     to = pcbddc->coarse_vec;
5693   }
5694   ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,from,to,imode,smode);CHKERRQ(ierr);
5695   if (smode == SCATTER_FORWARD) {
5696     if (pcbddc->coarse_ksp) { /* get array from coarse processes */
5697       Vec tvec;
5698 
5699       ierr = KSPGetRhs(pcbddc->coarse_ksp,&tvec);CHKERRQ(ierr);
5700       ierr = VecGetArray(to,&array);CHKERRQ(ierr);
5701       ierr = VecPlaceArray(tvec,array);CHKERRQ(ierr);
5702       ierr = VecRestoreArray(to,&array);CHKERRQ(ierr);
5703     }
5704   } else {
5705     if (pcbddc->coarse_ksp) { /* restore array of pcbddc->coarse_vec */
5706      ierr = VecResetArray(from);CHKERRQ(ierr);
5707     }
5708   }
5709   PetscFunctionReturn(0);
5710 }
5711 
5712 /* uncomment for testing purposes */
5713 /* #define PETSC_MISSING_LAPACK_GESVD 1 */
5714 PetscErrorCode PCBDDCConstraintsSetUp(PC pc)
5715 {
5716   PetscErrorCode    ierr;
5717   PC_IS*            pcis = (PC_IS*)(pc->data);
5718   PC_BDDC*          pcbddc = (PC_BDDC*)pc->data;
5719   Mat_IS*           matis = (Mat_IS*)pc->pmat->data;
5720   /* one and zero */
5721   PetscScalar       one=1.0,zero=0.0;
5722   /* space to store constraints and their local indices */
5723   PetscScalar       *constraints_data;
5724   PetscInt          *constraints_idxs,*constraints_idxs_B;
5725   PetscInt          *constraints_idxs_ptr,*constraints_data_ptr;
5726   PetscInt          *constraints_n;
5727   /* iterators */
5728   PetscInt          i,j,k,total_counts,total_counts_cc,cum;
5729   /* BLAS integers */
5730   PetscBLASInt      lwork,lierr;
5731   PetscBLASInt      Blas_N,Blas_M,Blas_K,Blas_one=1;
5732   PetscBLASInt      Blas_LDA,Blas_LDB,Blas_LDC;
5733   /* reuse */
5734   PetscInt          olocal_primal_size,olocal_primal_size_cc;
5735   PetscInt          *olocal_primal_ref_node,*olocal_primal_ref_mult;
5736   /* change of basis */
5737   PetscBool         qr_needed;
5738   PetscBT           change_basis,qr_needed_idx;
5739   /* auxiliary stuff */
5740   PetscInt          *nnz,*is_indices;
5741   PetscInt          ncc;
5742   /* some quantities */
5743   PetscInt          n_vertices,total_primal_vertices,valid_constraints;
5744   PetscInt          size_of_constraint,max_size_of_constraint=0,max_constraints,temp_constraints;
5745   PetscReal         tol; /* tolerance for retaining eigenmodes */
5746 
5747   PetscFunctionBegin;
5748   tol  = PetscSqrtReal(PETSC_SMALL);
5749   /* Destroy Mat objects computed previously */
5750   ierr = MatDestroy(&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
5751   ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
5752   ierr = MatDestroy(&pcbddc->switch_static_change);CHKERRQ(ierr);
5753   /* save info on constraints from previous setup (if any) */
5754   olocal_primal_size = pcbddc->local_primal_size;
5755   olocal_primal_size_cc = pcbddc->local_primal_size_cc;
5756   ierr = PetscMalloc2(olocal_primal_size_cc,&olocal_primal_ref_node,olocal_primal_size_cc,&olocal_primal_ref_mult);CHKERRQ(ierr);
5757   ierr = PetscMemcpy(olocal_primal_ref_node,pcbddc->local_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5758   ierr = PetscMemcpy(olocal_primal_ref_mult,pcbddc->local_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt));CHKERRQ(ierr);
5759   ierr = PetscFree2(pcbddc->local_primal_ref_node,pcbddc->local_primal_ref_mult);CHKERRQ(ierr);
5760   ierr = PetscFree(pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
5761 
5762   if (!pcbddc->adaptive_selection) {
5763     IS           ISForVertices,*ISForFaces,*ISForEdges;
5764     MatNullSpace nearnullsp;
5765     const Vec    *nearnullvecs;
5766     Vec          *localnearnullsp;
5767     PetscScalar  *array;
5768     PetscInt     n_ISForFaces,n_ISForEdges,nnsp_size;
5769     PetscBool    nnsp_has_cnst;
5770     /* LAPACK working arrays for SVD or POD */
5771     PetscBool    skip_lapack,boolforchange;
5772     PetscScalar  *work;
5773     PetscReal    *singular_vals;
5774 #if defined(PETSC_USE_COMPLEX)
5775     PetscReal    *rwork;
5776 #endif
5777 #if defined(PETSC_MISSING_LAPACK_GESVD)
5778     PetscScalar  *temp_basis,*correlation_mat;
5779 #else
5780     PetscBLASInt dummy_int=1;
5781     PetscScalar  dummy_scalar=1.;
5782 #endif
5783 
5784     /* Get index sets for faces, edges and vertices from graph */
5785     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,&n_ISForFaces,&ISForFaces,&n_ISForEdges,&ISForEdges,&ISForVertices);CHKERRQ(ierr);
5786     /* print some info */
5787     if (pcbddc->dbg_flag && (!pcbddc->sub_schurs || pcbddc->sub_schurs_rebuild)) {
5788       PetscInt nv;
5789 
5790       ierr = PCBDDCGraphASCIIView(pcbddc->mat_graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
5791       ierr = ISGetSize(ISForVertices,&nv);CHKERRQ(ierr);
5792       ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5793       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
5794       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
5795       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,n_ISForEdges,pcbddc->use_edges);CHKERRQ(ierr);
5796       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,n_ISForFaces,pcbddc->use_faces);CHKERRQ(ierr);
5797       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
5798       ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
5799     }
5800 
5801     /* free unneeded index sets */
5802     if (!pcbddc->use_vertices) {
5803       ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
5804     }
5805     if (!pcbddc->use_edges) {
5806       for (i=0;i<n_ISForEdges;i++) {
5807         ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
5808       }
5809       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
5810       n_ISForEdges = 0;
5811     }
5812     if (!pcbddc->use_faces) {
5813       for (i=0;i<n_ISForFaces;i++) {
5814         ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
5815       }
5816       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
5817       n_ISForFaces = 0;
5818     }
5819 
5820     /* check if near null space is attached to global mat */
5821     ierr = MatGetNearNullSpace(pc->pmat,&nearnullsp);CHKERRQ(ierr);
5822     if (nearnullsp) {
5823       ierr = MatNullSpaceGetVecs(nearnullsp,&nnsp_has_cnst,&nnsp_size,&nearnullvecs);CHKERRQ(ierr);
5824       /* remove any stored info */
5825       ierr = MatNullSpaceDestroy(&pcbddc->onearnullspace);CHKERRQ(ierr);
5826       ierr = PetscFree(pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5827       /* store information for BDDC solver reuse */
5828       ierr = PetscObjectReference((PetscObject)nearnullsp);CHKERRQ(ierr);
5829       pcbddc->onearnullspace = nearnullsp;
5830       ierr = PetscMalloc1(nnsp_size,&pcbddc->onearnullvecs_state);CHKERRQ(ierr);
5831       for (i=0;i<nnsp_size;i++) {
5832         ierr = PetscObjectStateGet((PetscObject)nearnullvecs[i],&pcbddc->onearnullvecs_state[i]);CHKERRQ(ierr);
5833       }
5834     } else { /* if near null space is not provided BDDC uses constants by default */
5835       nnsp_size = 0;
5836       nnsp_has_cnst = PETSC_TRUE;
5837     }
5838     /* get max number of constraints on a single cc */
5839     max_constraints = nnsp_size;
5840     if (nnsp_has_cnst) max_constraints++;
5841 
5842     /*
5843          Evaluate maximum storage size needed by the procedure
5844          - Indices for connected component i stored at "constraints_idxs + constraints_idxs_ptr[i]"
5845          - Values for constraints on connected component i stored at "constraints_data + constraints_data_ptr[i]"
5846          There can be multiple constraints per connected component
5847                                                                                                                                                            */
5848     n_vertices = 0;
5849     if (ISForVertices) {
5850       ierr = ISGetSize(ISForVertices,&n_vertices);CHKERRQ(ierr);
5851     }
5852     ncc = n_vertices+n_ISForFaces+n_ISForEdges;
5853     ierr = PetscMalloc3(ncc+1,&constraints_idxs_ptr,ncc+1,&constraints_data_ptr,ncc,&constraints_n);CHKERRQ(ierr);
5854 
5855     total_counts = n_ISForFaces+n_ISForEdges;
5856     total_counts *= max_constraints;
5857     total_counts += n_vertices;
5858     ierr = PetscBTCreate(total_counts,&change_basis);CHKERRQ(ierr);
5859 
5860     total_counts = 0;
5861     max_size_of_constraint = 0;
5862     for (i=0;i<n_ISForEdges+n_ISForFaces;i++) {
5863       IS used_is;
5864       if (i<n_ISForEdges) {
5865         used_is = ISForEdges[i];
5866       } else {
5867         used_is = ISForFaces[i-n_ISForEdges];
5868       }
5869       ierr = ISGetSize(used_is,&j);CHKERRQ(ierr);
5870       total_counts += j;
5871       max_size_of_constraint = PetscMax(j,max_size_of_constraint);
5872     }
5873     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);
5874 
5875     /* get local part of global near null space vectors */
5876     ierr = PetscMalloc1(nnsp_size,&localnearnullsp);CHKERRQ(ierr);
5877     for (k=0;k<nnsp_size;k++) {
5878       ierr = VecDuplicate(pcis->vec1_N,&localnearnullsp[k]);CHKERRQ(ierr);
5879       ierr = VecScatterBegin(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5880       ierr = VecScatterEnd(matis->rctx,nearnullvecs[k],localnearnullsp[k],INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
5881     }
5882 
5883     /* whether or not to skip lapack calls */
5884     skip_lapack = PETSC_TRUE;
5885     if (n_ISForFaces+n_ISForEdges && max_constraints > 1 && !pcbddc->use_nnsp_true) skip_lapack = PETSC_FALSE;
5886 
5887     /* First we issue queries to allocate optimal workspace for LAPACKgesvd (or LAPACKsyev if SVD is missing) */
5888     if (!skip_lapack) {
5889       PetscScalar temp_work;
5890 
5891 #if defined(PETSC_MISSING_LAPACK_GESVD)
5892       /* Proper Orthogonal Decomposition (POD) using the snapshot method */
5893       ierr = PetscMalloc1(max_constraints*max_constraints,&correlation_mat);CHKERRQ(ierr);
5894       ierr = PetscMalloc1(max_constraints,&singular_vals);CHKERRQ(ierr);
5895       ierr = PetscMalloc1(max_size_of_constraint*max_constraints,&temp_basis);CHKERRQ(ierr);
5896 #if defined(PETSC_USE_COMPLEX)
5897       ierr = PetscMalloc1(3*max_constraints,&rwork);CHKERRQ(ierr);
5898 #endif
5899       /* now we evaluate the optimal workspace using query with lwork=-1 */
5900       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
5901       ierr = PetscBLASIntCast(max_constraints,&Blas_LDA);CHKERRQ(ierr);
5902       lwork = -1;
5903       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5904 #if !defined(PETSC_USE_COMPLEX)
5905       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,&lierr));
5906 #else
5907       PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,&temp_work,&lwork,rwork,&lierr));
5908 #endif
5909       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5910       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to SYEV Lapack routine %d",(int)lierr);
5911 #else /* on missing GESVD */
5912       /* SVD */
5913       PetscInt max_n,min_n;
5914       max_n = max_size_of_constraint;
5915       min_n = max_constraints;
5916       if (max_size_of_constraint < max_constraints) {
5917         min_n = max_size_of_constraint;
5918         max_n = max_constraints;
5919       }
5920       ierr = PetscMalloc1(min_n,&singular_vals);CHKERRQ(ierr);
5921 #if defined(PETSC_USE_COMPLEX)
5922       ierr = PetscMalloc1(5*min_n,&rwork);CHKERRQ(ierr);
5923 #endif
5924       /* now we evaluate the optimal workspace using query with lwork=-1 */
5925       lwork = -1;
5926       ierr = PetscBLASIntCast(max_n,&Blas_M);CHKERRQ(ierr);
5927       ierr = PetscBLASIntCast(min_n,&Blas_N);CHKERRQ(ierr);
5928       ierr = PetscBLASIntCast(max_n,&Blas_LDA);CHKERRQ(ierr);
5929       ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
5930 #if !defined(PETSC_USE_COMPLEX)
5931       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));
5932 #else
5933       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));
5934 #endif
5935       ierr = PetscFPTrapPop();CHKERRQ(ierr);
5936       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GESVD Lapack routine %d",(int)lierr);
5937 #endif /* on missing GESVD */
5938       /* Allocate optimal workspace */
5939       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(temp_work),&lwork);CHKERRQ(ierr);
5940       ierr = PetscMalloc1(lwork,&work);CHKERRQ(ierr);
5941     }
5942     /* Now we can loop on constraining sets */
5943     total_counts = 0;
5944     constraints_idxs_ptr[0] = 0;
5945     constraints_data_ptr[0] = 0;
5946     /* vertices */
5947     if (n_vertices) {
5948       ierr = ISGetIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5949       ierr = PetscMemcpy(constraints_idxs,is_indices,n_vertices*sizeof(PetscInt));CHKERRQ(ierr);
5950       for (i=0;i<n_vertices;i++) {
5951         constraints_n[total_counts] = 1;
5952         constraints_data[total_counts] = 1.0;
5953         constraints_idxs_ptr[total_counts+1] = constraints_idxs_ptr[total_counts]+1;
5954         constraints_data_ptr[total_counts+1] = constraints_data_ptr[total_counts]+1;
5955         total_counts++;
5956       }
5957       ierr = ISRestoreIndices(ISForVertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5958       n_vertices = total_counts;
5959     }
5960 
5961     /* edges and faces */
5962     total_counts_cc = total_counts;
5963     for (ncc=0;ncc<n_ISForEdges+n_ISForFaces;ncc++) {
5964       IS        used_is;
5965       PetscBool idxs_copied = PETSC_FALSE;
5966 
5967       if (ncc<n_ISForEdges) {
5968         used_is = ISForEdges[ncc];
5969         boolforchange = pcbddc->use_change_of_basis; /* change or not the basis on the edge */
5970       } else {
5971         used_is = ISForFaces[ncc-n_ISForEdges];
5972         boolforchange = (PetscBool)(pcbddc->use_change_of_basis && pcbddc->use_change_on_faces); /* change or not the basis on the face */
5973       }
5974       temp_constraints = 0;          /* zero the number of constraints I have on this conn comp */
5975 
5976       ierr = ISGetSize(used_is,&size_of_constraint);CHKERRQ(ierr);
5977       ierr = ISGetIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
5978       /* change of basis should not be performed on local periodic nodes */
5979       if (pcbddc->mat_graph->mirrors && pcbddc->mat_graph->mirrors[is_indices[0]]) boolforchange = PETSC_FALSE;
5980       if (nnsp_has_cnst) {
5981         PetscScalar quad_value;
5982 
5983         ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
5984         idxs_copied = PETSC_TRUE;
5985 
5986         if (!pcbddc->use_nnsp_true) {
5987           quad_value = (PetscScalar)(1.0/PetscSqrtReal((PetscReal)size_of_constraint));
5988         } else {
5989           quad_value = 1.0;
5990         }
5991         for (j=0;j<size_of_constraint;j++) {
5992           constraints_data[constraints_data_ptr[total_counts_cc]+j] = quad_value;
5993         }
5994         temp_constraints++;
5995         total_counts++;
5996       }
5997       for (k=0;k<nnsp_size;k++) {
5998         PetscReal real_value;
5999         PetscScalar *ptr_to_data;
6000 
6001         ierr = VecGetArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6002         ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]+temp_constraints*size_of_constraint];
6003         for (j=0;j<size_of_constraint;j++) {
6004           ptr_to_data[j] = array[is_indices[j]];
6005         }
6006         ierr = VecRestoreArrayRead(localnearnullsp[k],(const PetscScalar**)&array);CHKERRQ(ierr);
6007         /* check if array is null on the connected component */
6008         ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6009         PetscStackCallBLAS("BLASasum",real_value = BLASasum_(&Blas_N,ptr_to_data,&Blas_one));
6010         if (real_value > tol*size_of_constraint) { /* keep indices and values */
6011           temp_constraints++;
6012           total_counts++;
6013           if (!idxs_copied) {
6014             ierr = PetscMemcpy(constraints_idxs + constraints_idxs_ptr[total_counts_cc],is_indices,size_of_constraint*sizeof(PetscInt));CHKERRQ(ierr);
6015             idxs_copied = PETSC_TRUE;
6016           }
6017         }
6018       }
6019       ierr = ISRestoreIndices(used_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
6020       valid_constraints = temp_constraints;
6021       if (!pcbddc->use_nnsp_true && temp_constraints) {
6022         if (temp_constraints == 1) { /* just normalize the constraint */
6023           PetscScalar norm,*ptr_to_data;
6024 
6025           ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6026           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6027           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,ptr_to_data,&Blas_one,ptr_to_data,&Blas_one));
6028           norm = 1.0/PetscSqrtReal(PetscRealPart(norm));
6029           PetscStackCallBLAS("BLASscal",BLASscal_(&Blas_N,&norm,ptr_to_data,&Blas_one));
6030         } else { /* perform SVD */
6031           PetscScalar *ptr_to_data = &constraints_data[constraints_data_ptr[total_counts_cc]];
6032 
6033 #if defined(PETSC_MISSING_LAPACK_GESVD)
6034           /* SVD: Y = U*S*V^H                -> U (eigenvectors of Y*Y^H) = Y*V*(S)^\dag
6035              POD: Y^H*Y = V*D*V^H, D = S^H*S -> U = Y*V*D^(-1/2)
6036              -> When PETSC_USE_COMPLEX and PETSC_MISSING_LAPACK_GESVD are defined
6037                 the constraints basis will differ (by a complex factor with absolute value equal to 1)
6038                 from that computed using LAPACKgesvd
6039              -> This is due to a different computation of eigenvectors in LAPACKheev
6040              -> The quality of the POD-computed basis will be the same */
6041           ierr = PetscMemzero(correlation_mat,temp_constraints*temp_constraints*sizeof(PetscScalar));CHKERRQ(ierr);
6042           /* Store upper triangular part of correlation matrix */
6043           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6044           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6045           for (j=0;j<temp_constraints;j++) {
6046             for (k=0;k<j+1;k++) {
6047               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));
6048             }
6049           }
6050           /* compute eigenvalues and eigenvectors of correlation matrix */
6051           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6052           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDA);CHKERRQ(ierr);
6053 #if !defined(PETSC_USE_COMPLEX)
6054           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,&lierr));
6055 #else
6056           PetscStackCallBLAS("LAPACKsyev",LAPACKsyev_("V","U",&Blas_N,correlation_mat,&Blas_LDA,singular_vals,work,&lwork,rwork,&lierr));
6057 #endif
6058           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6059           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in SYEV Lapack routine %d",(int)lierr);
6060           /* retain eigenvalues greater than tol: note that LAPACKsyev gives eigs in ascending order */
6061           j = 0;
6062           while (j < temp_constraints && singular_vals[j] < tol) j++;
6063           total_counts = total_counts-j;
6064           valid_constraints = temp_constraints-j;
6065           /* scale and copy POD basis into used quadrature memory */
6066           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6067           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6068           ierr = PetscBLASIntCast(temp_constraints,&Blas_K);CHKERRQ(ierr);
6069           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6070           ierr = PetscBLASIntCast(temp_constraints,&Blas_LDB);CHKERRQ(ierr);
6071           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6072           if (j<temp_constraints) {
6073             PetscInt ii;
6074             for (k=j;k<temp_constraints;k++) singular_vals[k] = 1.0/PetscSqrtReal(singular_vals[k]);
6075             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6076             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));
6077             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6078             for (k=0;k<temp_constraints-j;k++) {
6079               for (ii=0;ii<size_of_constraint;ii++) {
6080                 ptr_to_data[k*size_of_constraint+ii] = singular_vals[temp_constraints-1-k]*temp_basis[(temp_constraints-1-k)*size_of_constraint+ii];
6081               }
6082             }
6083           }
6084 #else  /* on missing GESVD */
6085           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6086           ierr = PetscBLASIntCast(temp_constraints,&Blas_N);CHKERRQ(ierr);
6087           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6088           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6089 #if !defined(PETSC_USE_COMPLEX)
6090           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));
6091 #else
6092           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));
6093 #endif
6094           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GESVD Lapack routine %d",(int)lierr);
6095           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6096           /* retain eigenvalues greater than tol: note that LAPACKgesvd gives eigs in descending order */
6097           k = temp_constraints;
6098           if (k > size_of_constraint) k = size_of_constraint;
6099           j = 0;
6100           while (j < k && singular_vals[k-j-1] < tol) j++;
6101           valid_constraints = k-j;
6102           total_counts = total_counts-temp_constraints+valid_constraints;
6103 #endif /* on missing GESVD */
6104         }
6105       }
6106       /* update pointers information */
6107       if (valid_constraints) {
6108         constraints_n[total_counts_cc] = valid_constraints;
6109         constraints_idxs_ptr[total_counts_cc+1] = constraints_idxs_ptr[total_counts_cc]+size_of_constraint;
6110         constraints_data_ptr[total_counts_cc+1] = constraints_data_ptr[total_counts_cc]+size_of_constraint*valid_constraints;
6111         /* set change_of_basis flag */
6112         if (boolforchange) {
6113           PetscBTSet(change_basis,total_counts_cc);
6114         }
6115         total_counts_cc++;
6116       }
6117     }
6118     /* free workspace */
6119     if (!skip_lapack) {
6120       ierr = PetscFree(work);CHKERRQ(ierr);
6121 #if defined(PETSC_USE_COMPLEX)
6122       ierr = PetscFree(rwork);CHKERRQ(ierr);
6123 #endif
6124       ierr = PetscFree(singular_vals);CHKERRQ(ierr);
6125 #if defined(PETSC_MISSING_LAPACK_GESVD)
6126       ierr = PetscFree(correlation_mat);CHKERRQ(ierr);
6127       ierr = PetscFree(temp_basis);CHKERRQ(ierr);
6128 #endif
6129     }
6130     for (k=0;k<nnsp_size;k++) {
6131       ierr = VecDestroy(&localnearnullsp[k]);CHKERRQ(ierr);
6132     }
6133     ierr = PetscFree(localnearnullsp);CHKERRQ(ierr);
6134     /* free index sets of faces, edges and vertices */
6135     for (i=0;i<n_ISForFaces;i++) {
6136       ierr = ISDestroy(&ISForFaces[i]);CHKERRQ(ierr);
6137     }
6138     if (n_ISForFaces) {
6139       ierr = PetscFree(ISForFaces);CHKERRQ(ierr);
6140     }
6141     for (i=0;i<n_ISForEdges;i++) {
6142       ierr = ISDestroy(&ISForEdges[i]);CHKERRQ(ierr);
6143     }
6144     if (n_ISForEdges) {
6145       ierr = PetscFree(ISForEdges);CHKERRQ(ierr);
6146     }
6147     ierr = ISDestroy(&ISForVertices);CHKERRQ(ierr);
6148   } else {
6149     PCBDDCSubSchurs sub_schurs = pcbddc->sub_schurs;
6150 
6151     total_counts = 0;
6152     n_vertices = 0;
6153     if (sub_schurs->is_vertices && pcbddc->use_vertices) {
6154       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
6155     }
6156     max_constraints = 0;
6157     total_counts_cc = 0;
6158     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6159       total_counts += pcbddc->adaptive_constraints_n[i];
6160       if (pcbddc->adaptive_constraints_n[i]) total_counts_cc++;
6161       max_constraints = PetscMax(max_constraints,pcbddc->adaptive_constraints_n[i]);
6162     }
6163     constraints_idxs_ptr = pcbddc->adaptive_constraints_idxs_ptr;
6164     constraints_data_ptr = pcbddc->adaptive_constraints_data_ptr;
6165     constraints_idxs = pcbddc->adaptive_constraints_idxs;
6166     constraints_data = pcbddc->adaptive_constraints_data;
6167     /* constraints_n differs from pcbddc->adaptive_constraints_n */
6168     ierr = PetscMalloc1(total_counts_cc,&constraints_n);CHKERRQ(ierr);
6169     total_counts_cc = 0;
6170     for (i=0;i<sub_schurs->n_subs+n_vertices;i++) {
6171       if (pcbddc->adaptive_constraints_n[i]) {
6172         constraints_n[total_counts_cc++] = pcbddc->adaptive_constraints_n[i];
6173       }
6174     }
6175 #if 0
6176     printf("Found %d totals (%d)\n",total_counts_cc,total_counts);
6177     for (i=0;i<total_counts_cc;i++) {
6178       printf("const %d, start %d",i,constraints_idxs_ptr[i]);
6179       printf(" end %d:\n",constraints_idxs_ptr[i+1]);
6180       for (j=constraints_idxs_ptr[i];j<constraints_idxs_ptr[i+1];j++) {
6181         printf(" %d",constraints_idxs[j]);
6182       }
6183       printf("\n");
6184       printf("number of cc: %d\n",constraints_n[i]);
6185     }
6186     for (i=0;i<n_vertices;i++) {
6187       PetscPrintf(PETSC_COMM_SELF,"[%d] vertex %d, n %d\n",PetscGlobalRank,i,pcbddc->adaptive_constraints_n[i]);
6188     }
6189     for (i=0;i<sub_schurs->n_subs;i++) {
6190       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]);
6191     }
6192 #endif
6193 
6194     max_size_of_constraint = 0;
6195     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]);
6196     ierr = PetscMalloc1(constraints_idxs_ptr[total_counts_cc],&constraints_idxs_B);CHKERRQ(ierr);
6197     /* Change of basis */
6198     ierr = PetscBTCreate(total_counts_cc,&change_basis);CHKERRQ(ierr);
6199     if (pcbddc->use_change_of_basis) {
6200       for (i=0;i<sub_schurs->n_subs;i++) {
6201         if (PetscBTLookup(sub_schurs->is_edge,i) || pcbddc->use_change_on_faces) {
6202           ierr = PetscBTSet(change_basis,i+n_vertices);CHKERRQ(ierr);
6203         }
6204       }
6205     }
6206   }
6207   pcbddc->local_primal_size = total_counts;
6208   ierr = PetscMalloc1(pcbddc->local_primal_size+pcbddc->benign_n,&pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6209 
6210   /* map constraints_idxs in boundary numbering */
6211   ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,constraints_idxs_ptr[total_counts_cc],constraints_idxs,&i,constraints_idxs_B);CHKERRQ(ierr);
6212   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);
6213 
6214   /* Create constraint matrix */
6215   ierr = MatCreate(PETSC_COMM_SELF,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6216   ierr = MatSetType(pcbddc->ConstraintMatrix,MATAIJ);CHKERRQ(ierr);
6217   ierr = MatSetSizes(pcbddc->ConstraintMatrix,pcbddc->local_primal_size,pcis->n,pcbddc->local_primal_size,pcis->n);CHKERRQ(ierr);
6218 
6219   /* find primal_dofs: subdomain corners plus dofs selected as primal after change of basis */
6220   /* determine if a QR strategy is needed for change of basis */
6221   qr_needed = PETSC_FALSE;
6222   ierr = PetscBTCreate(total_counts_cc,&qr_needed_idx);CHKERRQ(ierr);
6223   total_primal_vertices=0;
6224   pcbddc->local_primal_size_cc = 0;
6225   for (i=0;i<total_counts_cc;i++) {
6226     size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6227     if (size_of_constraint == 1 && pcbddc->mat_graph->custom_minimal_size) {
6228       pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]];
6229       pcbddc->local_primal_size_cc += 1;
6230     } else if (PetscBTLookup(change_basis,i)) {
6231       for (k=0;k<constraints_n[i];k++) {
6232         pcbddc->primal_indices_local_idxs[total_primal_vertices++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6233       }
6234       pcbddc->local_primal_size_cc += constraints_n[i];
6235       if (constraints_n[i] > 1 || pcbddc->use_qr_single) {
6236         PetscBTSet(qr_needed_idx,i);
6237         qr_needed = PETSC_TRUE;
6238       }
6239     } else {
6240       pcbddc->local_primal_size_cc += 1;
6241     }
6242   }
6243   /* note that the local variable n_vertices used below stores the number of pointwise constraints */
6244   pcbddc->n_vertices = total_primal_vertices;
6245   /* permute indices in order to have a sorted set of vertices */
6246   ierr = PetscSortInt(total_primal_vertices,pcbddc->primal_indices_local_idxs);CHKERRQ(ierr);
6247   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);
6248   ierr = PetscMemcpy(pcbddc->local_primal_ref_node,pcbddc->primal_indices_local_idxs,total_primal_vertices*sizeof(PetscInt));CHKERRQ(ierr);
6249   for (i=0;i<total_primal_vertices;i++) pcbddc->local_primal_ref_mult[i] = 1;
6250 
6251   /* nonzero structure of constraint matrix */
6252   /* and get reference dof for local constraints */
6253   ierr = PetscMalloc1(pcbddc->local_primal_size,&nnz);CHKERRQ(ierr);
6254   for (i=0;i<total_primal_vertices;i++) nnz[i] = 1;
6255 
6256   j = total_primal_vertices;
6257   total_counts = total_primal_vertices;
6258   cum = total_primal_vertices;
6259   for (i=n_vertices;i<total_counts_cc;i++) {
6260     if (!PetscBTLookup(change_basis,i)) {
6261       pcbddc->local_primal_ref_node[cum] = constraints_idxs[constraints_idxs_ptr[i]];
6262       pcbddc->local_primal_ref_mult[cum] = constraints_n[i];
6263       cum++;
6264       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6265       for (k=0;k<constraints_n[i];k++) {
6266         pcbddc->primal_indices_local_idxs[total_counts++] = constraints_idxs[constraints_idxs_ptr[i]+k];
6267         nnz[j+k] = size_of_constraint;
6268       }
6269       j += constraints_n[i];
6270     }
6271   }
6272   ierr = MatSeqAIJSetPreallocation(pcbddc->ConstraintMatrix,0,nnz);CHKERRQ(ierr);
6273   ierr = PetscFree(nnz);CHKERRQ(ierr);
6274 
6275   /* set values in constraint matrix */
6276   for (i=0;i<total_primal_vertices;i++) {
6277     ierr = MatSetValue(pcbddc->ConstraintMatrix,i,pcbddc->local_primal_ref_node[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
6278   }
6279   total_counts = total_primal_vertices;
6280   for (i=n_vertices;i<total_counts_cc;i++) {
6281     if (!PetscBTLookup(change_basis,i)) {
6282       PetscInt *cols;
6283 
6284       size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6285       cols = constraints_idxs+constraints_idxs_ptr[i];
6286       for (k=0;k<constraints_n[i];k++) {
6287         PetscInt    row = total_counts+k;
6288         PetscScalar *vals;
6289 
6290         vals = constraints_data+constraints_data_ptr[i]+k*size_of_constraint;
6291         ierr = MatSetValues(pcbddc->ConstraintMatrix,1,&row,size_of_constraint,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
6292       }
6293       total_counts += constraints_n[i];
6294     }
6295   }
6296   /* assembling */
6297   ierr = MatAssemblyBegin(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6298   ierr = MatAssemblyEnd(pcbddc->ConstraintMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6299   ierr = MatChop(pcbddc->ConstraintMatrix,PETSC_SMALL);CHKERRQ(ierr);
6300   ierr = MatSeqAIJCompress(pcbddc->ConstraintMatrix,&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6301   ierr = MatViewFromOptions(pcbddc->ConstraintMatrix,NULL,"-pc_bddc_constraint_mat_view");CHKERRQ(ierr);
6302 
6303   /*
6304   ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_SELF,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
6305   ierr = MatView(pcbddc->ConstraintMatrix,(PetscViewer)0);CHKERRQ(ierr);
6306   ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_SELF);CHKERRQ(ierr);
6307   */
6308   /* Create matrix for change of basis. We don't need it in case pcbddc->use_change_of_basis is FALSE */
6309   if (pcbddc->use_change_of_basis) {
6310     /* dual and primal dofs on a single cc */
6311     PetscInt     dual_dofs,primal_dofs;
6312     /* working stuff for GEQRF */
6313     PetscScalar  *qr_basis,*qr_tau = NULL,*qr_work,lqr_work_t;
6314     PetscBLASInt lqr_work;
6315     /* working stuff for UNGQR */
6316     PetscScalar  *gqr_work,lgqr_work_t;
6317     PetscBLASInt lgqr_work;
6318     /* working stuff for TRTRS */
6319     PetscScalar  *trs_rhs;
6320     PetscBLASInt Blas_NRHS;
6321     /* pointers for values insertion into change of basis matrix */
6322     PetscInt     *start_rows,*start_cols;
6323     PetscScalar  *start_vals;
6324     /* working stuff for values insertion */
6325     PetscBT      is_primal;
6326     PetscInt     *aux_primal_numbering_B;
6327     /* matrix sizes */
6328     PetscInt     global_size,local_size;
6329     /* temporary change of basis */
6330     Mat          localChangeOfBasisMatrix;
6331     /* extra space for debugging */
6332     PetscScalar  *dbg_work;
6333 
6334     /* local temporary change of basis acts on local interfaces -> dimension is n_B x n_B */
6335     ierr = MatCreate(PETSC_COMM_SELF,&localChangeOfBasisMatrix);CHKERRQ(ierr);
6336     ierr = MatSetType(localChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6337     ierr = MatSetSizes(localChangeOfBasisMatrix,pcis->n,pcis->n,pcis->n,pcis->n);CHKERRQ(ierr);
6338     /* nonzeros for local mat */
6339     ierr = PetscMalloc1(pcis->n,&nnz);CHKERRQ(ierr);
6340     if (!pcbddc->benign_change || pcbddc->fake_change) {
6341       for (i=0;i<pcis->n;i++) nnz[i]=1;
6342     } else {
6343       const PetscInt *ii;
6344       PetscInt       n;
6345       PetscBool      flg_row;
6346       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6347       for (i=0;i<n;i++) nnz[i] = ii[i+1]-ii[i];
6348       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,NULL,&flg_row);CHKERRQ(ierr);
6349     }
6350     for (i=n_vertices;i<total_counts_cc;i++) {
6351       if (PetscBTLookup(change_basis,i)) {
6352         size_of_constraint = constraints_idxs_ptr[i+1]-constraints_idxs_ptr[i];
6353         if (PetscBTLookup(qr_needed_idx,i)) {
6354           for (j=0;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = size_of_constraint;
6355         } else {
6356           nnz[constraints_idxs[constraints_idxs_ptr[i]]] = size_of_constraint;
6357           for (j=1;j<size_of_constraint;j++) nnz[constraints_idxs[constraints_idxs_ptr[i]+j]] = 2;
6358         }
6359       }
6360     }
6361     ierr = MatSeqAIJSetPreallocation(localChangeOfBasisMatrix,0,nnz);CHKERRQ(ierr);
6362     ierr = PetscFree(nnz);CHKERRQ(ierr);
6363     /* Set interior change in the matrix */
6364     if (!pcbddc->benign_change || pcbddc->fake_change) {
6365       for (i=0;i<pcis->n;i++) {
6366         ierr = MatSetValue(localChangeOfBasisMatrix,i,i,1.0,INSERT_VALUES);CHKERRQ(ierr);
6367       }
6368     } else {
6369       const PetscInt *ii,*jj;
6370       PetscScalar    *aa;
6371       PetscInt       n;
6372       PetscBool      flg_row;
6373       ierr = MatGetRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6374       ierr = MatSeqAIJGetArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6375       for (i=0;i<n;i++) {
6376         ierr = MatSetValues(localChangeOfBasisMatrix,1,&i,ii[i+1]-ii[i],jj+ii[i],aa+ii[i],INSERT_VALUES);CHKERRQ(ierr);
6377       }
6378       ierr = MatSeqAIJRestoreArray(pcbddc->benign_change,&aa);CHKERRQ(ierr);
6379       ierr = MatRestoreRowIJ(pcbddc->benign_change,0,PETSC_FALSE,PETSC_FALSE,&n,&ii,&jj,&flg_row);CHKERRQ(ierr);
6380     }
6381 
6382     if (pcbddc->dbg_flag) {
6383       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
6384       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Checking change of basis computation for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
6385     }
6386 
6387 
6388     /* Now we loop on the constraints which need a change of basis */
6389     /*
6390        Change of basis matrix is evaluated similarly to the FIRST APPROACH in
6391        Klawonn and Widlund, Dual-primal FETI-DP methods for linear elasticity, (see Sect 6.2.1)
6392 
6393        Basic blocks of change of basis matrix T computed by
6394 
6395           - Using the following block transformation if there is only a primal dof on the cc (and -pc_bddc_use_qr_single is not specified)
6396 
6397             | 1        0   ...        0         s_1/S |
6398             | 0        1   ...        0         s_2/S |
6399             |              ...                        |
6400             | 0        ...            1     s_{n-1}/S |
6401             | -s_1/s_n ...    -s_{n-1}/s_n      s_n/S |
6402 
6403             with S = \sum_{i=1}^n s_i^2
6404             NOTE: in the above example, the primal dof is the last one of the edge in LOCAL ordering
6405                   in the current implementation, the primal dof is the first one of the edge in GLOBAL ordering
6406 
6407           - QR decomposition of constraints otherwise
6408     */
6409     if (qr_needed) {
6410       /* space to store Q */
6411       ierr = PetscMalloc1(max_size_of_constraint*max_size_of_constraint,&qr_basis);CHKERRQ(ierr);
6412       /* array to store scaling factors for reflectors */
6413       ierr = PetscMalloc1(max_constraints,&qr_tau);CHKERRQ(ierr);
6414       /* first we issue queries for optimal work */
6415       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6416       ierr = PetscBLASIntCast(max_constraints,&Blas_N);CHKERRQ(ierr);
6417       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6418       lqr_work = -1;
6419       PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,&lqr_work_t,&lqr_work,&lierr));
6420       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to GEQRF Lapack routine %d",(int)lierr);
6421       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lqr_work_t),&lqr_work);CHKERRQ(ierr);
6422       ierr = PetscMalloc1((PetscInt)PetscRealPart(lqr_work_t),&qr_work);CHKERRQ(ierr);
6423       lgqr_work = -1;
6424       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_M);CHKERRQ(ierr);
6425       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_N);CHKERRQ(ierr);
6426       ierr = PetscBLASIntCast(max_constraints,&Blas_K);CHKERRQ(ierr);
6427       ierr = PetscBLASIntCast(max_size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6428       if (Blas_K>Blas_M) Blas_K=Blas_M; /* adjust just for computing optimal work */
6429       PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,&lgqr_work_t,&lgqr_work,&lierr));
6430       if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in query to ORGQR/UNGQR Lapack routine %d",(int)lierr);
6431       ierr = PetscBLASIntCast((PetscInt)PetscRealPart(lgqr_work_t),&lgqr_work);CHKERRQ(ierr);
6432       ierr = PetscMalloc1((PetscInt)PetscRealPart(lgqr_work_t),&gqr_work);CHKERRQ(ierr);
6433       /* array to store rhs and solution of triangular solver */
6434       ierr = PetscMalloc1(max_constraints*max_constraints,&trs_rhs);CHKERRQ(ierr);
6435       /* allocating workspace for check */
6436       if (pcbddc->dbg_flag) {
6437         ierr = PetscMalloc1(max_size_of_constraint*(max_constraints+max_size_of_constraint),&dbg_work);CHKERRQ(ierr);
6438       }
6439     }
6440     /* array to store whether a node is primal or not */
6441     ierr = PetscBTCreate(pcis->n_B,&is_primal);CHKERRQ(ierr);
6442     ierr = PetscMalloc1(total_primal_vertices,&aux_primal_numbering_B);CHKERRQ(ierr);
6443     ierr = ISGlobalToLocalMappingApply(pcis->BtoNmap,IS_GTOLM_DROP,total_primal_vertices,pcbddc->local_primal_ref_node,&i,aux_primal_numbering_B);CHKERRQ(ierr);
6444     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);
6445     for (i=0;i<total_primal_vertices;i++) {
6446       ierr = PetscBTSet(is_primal,aux_primal_numbering_B[i]);CHKERRQ(ierr);
6447     }
6448     ierr = PetscFree(aux_primal_numbering_B);CHKERRQ(ierr);
6449 
6450     /* loop on constraints and see whether or not they need a change of basis and compute it */
6451     for (total_counts=n_vertices;total_counts<total_counts_cc;total_counts++) {
6452       size_of_constraint = constraints_idxs_ptr[total_counts+1]-constraints_idxs_ptr[total_counts];
6453       if (PetscBTLookup(change_basis,total_counts)) {
6454         /* get constraint info */
6455         primal_dofs = constraints_n[total_counts];
6456         dual_dofs = size_of_constraint-primal_dofs;
6457 
6458         if (pcbddc->dbg_flag) {
6459           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);
6460         }
6461 
6462         if (PetscBTLookup(qr_needed_idx,total_counts)) { /* QR */
6463 
6464           /* copy quadrature constraints for change of basis check */
6465           if (pcbddc->dbg_flag) {
6466             ierr = PetscMemcpy(dbg_work,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6467           }
6468           /* copy temporary constraints into larger work vector (in order to store all columns of Q) */
6469           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6470 
6471           /* compute QR decomposition of constraints */
6472           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6473           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6474           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6475           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6476           PetscStackCallBLAS("LAPACKgeqrf",LAPACKgeqrf_(&Blas_M,&Blas_N,qr_basis,&Blas_LDA,qr_tau,qr_work,&lqr_work,&lierr));
6477           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in GEQRF Lapack routine %d",(int)lierr);
6478           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6479 
6480           /* explictly compute R^-T */
6481           ierr = PetscMemzero(trs_rhs,primal_dofs*primal_dofs*sizeof(*trs_rhs));CHKERRQ(ierr);
6482           for (j=0;j<primal_dofs;j++) trs_rhs[j*(primal_dofs+1)] = 1.0;
6483           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6484           ierr = PetscBLASIntCast(primal_dofs,&Blas_NRHS);CHKERRQ(ierr);
6485           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6486           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6487           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6488           PetscStackCallBLAS("LAPACKtrtrs",LAPACKtrtrs_("U","T","N",&Blas_N,&Blas_NRHS,qr_basis,&Blas_LDA,trs_rhs,&Blas_LDB,&lierr));
6489           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in TRTRS Lapack routine %d",(int)lierr);
6490           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6491 
6492           /* explicitly compute all columns of Q (Q = [Q1 | Q2] ) overwriting QR factorization in qr_basis */
6493           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6494           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6495           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6496           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6497           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6498           PetscStackCallBLAS("LAPACKorgqr",LAPACKorgqr_(&Blas_M,&Blas_N,&Blas_K,qr_basis,&Blas_LDA,qr_tau,gqr_work,&lgqr_work,&lierr));
6499           if (lierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in ORGQR/UNGQR Lapack routine %d",(int)lierr);
6500           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6501 
6502           /* first primal_dofs columns of Q need to be re-scaled in order to be unitary w.r.t constraints
6503              i.e. C_{pxn}*Q_{nxn} should be equal to [I_pxp | 0_pxd] (see check below)
6504              where n=size_of_constraint, p=primal_dofs, d=dual_dofs (n=p+d), I and 0 identity and null matrix resp. */
6505           ierr = PetscBLASIntCast(size_of_constraint,&Blas_M);CHKERRQ(ierr);
6506           ierr = PetscBLASIntCast(primal_dofs,&Blas_N);CHKERRQ(ierr);
6507           ierr = PetscBLASIntCast(primal_dofs,&Blas_K);CHKERRQ(ierr);
6508           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6509           ierr = PetscBLASIntCast(primal_dofs,&Blas_LDB);CHKERRQ(ierr);
6510           ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDC);CHKERRQ(ierr);
6511           ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6512           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));
6513           ierr = PetscFPTrapPop();CHKERRQ(ierr);
6514           ierr = PetscMemcpy(qr_basis,&constraints_data[constraints_data_ptr[total_counts]],size_of_constraint*primal_dofs*sizeof(PetscScalar));CHKERRQ(ierr);
6515 
6516           /* insert values in change of basis matrix respecting global ordering of new primal dofs */
6517           start_rows = &constraints_idxs[constraints_idxs_ptr[total_counts]];
6518           /* insert cols for primal dofs */
6519           for (j=0;j<primal_dofs;j++) {
6520             start_vals = &qr_basis[j*size_of_constraint];
6521             start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6522             ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6523           }
6524           /* insert cols for dual dofs */
6525           for (j=0,k=0;j<dual_dofs;k++) {
6526             if (!PetscBTLookup(is_primal,constraints_idxs_B[constraints_idxs_ptr[total_counts]+k])) {
6527               start_vals = &qr_basis[(primal_dofs+j)*size_of_constraint];
6528               start_cols = &constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6529               ierr = MatSetValues(localChangeOfBasisMatrix,size_of_constraint,start_rows,1,start_cols,start_vals,INSERT_VALUES);CHKERRQ(ierr);
6530               j++;
6531             }
6532           }
6533 
6534           /* check change of basis */
6535           if (pcbddc->dbg_flag) {
6536             PetscInt   ii,jj;
6537             PetscBool valid_qr=PETSC_TRUE;
6538             ierr = PetscBLASIntCast(primal_dofs,&Blas_M);CHKERRQ(ierr);
6539             ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6540             ierr = PetscBLASIntCast(size_of_constraint,&Blas_K);CHKERRQ(ierr);
6541             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDA);CHKERRQ(ierr);
6542             ierr = PetscBLASIntCast(size_of_constraint,&Blas_LDB);CHKERRQ(ierr);
6543             ierr = PetscBLASIntCast(primal_dofs,&Blas_LDC);CHKERRQ(ierr);
6544             ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr);
6545             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));
6546             ierr = PetscFPTrapPop();CHKERRQ(ierr);
6547             for (jj=0;jj<size_of_constraint;jj++) {
6548               for (ii=0;ii<primal_dofs;ii++) {
6549                 if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) valid_qr = PETSC_FALSE;
6550                 if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) valid_qr = PETSC_FALSE;
6551               }
6552             }
6553             if (!valid_qr) {
6554               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> wrong change of basis!\n");CHKERRQ(ierr);
6555               for (jj=0;jj<size_of_constraint;jj++) {
6556                 for (ii=0;ii<primal_dofs;ii++) {
6557                   if (ii != jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]) > 1.e-12) {
6558                     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]));
6559                   }
6560                   if (ii == jj && PetscAbsScalar(dbg_work[size_of_constraint*primal_dofs+jj*primal_dofs+ii]-(PetscReal)1) > 1.e-12) {
6561                     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]));
6562                   }
6563                 }
6564               }
6565             } else {
6566               ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> right change of basis!\n");CHKERRQ(ierr);
6567             }
6568           }
6569         } else { /* simple transformation block */
6570           PetscInt    row,col;
6571           PetscScalar val,norm;
6572 
6573           ierr = PetscBLASIntCast(size_of_constraint,&Blas_N);CHKERRQ(ierr);
6574           PetscStackCallBLAS("BLASdot",norm = BLASdot_(&Blas_N,constraints_data+constraints_data_ptr[total_counts],&Blas_one,constraints_data+constraints_data_ptr[total_counts],&Blas_one));
6575           for (j=0;j<size_of_constraint;j++) {
6576             PetscInt row_B = constraints_idxs_B[constraints_idxs_ptr[total_counts]+j];
6577             row = constraints_idxs[constraints_idxs_ptr[total_counts]+j];
6578             if (!PetscBTLookup(is_primal,row_B)) {
6579               col = constraints_idxs[constraints_idxs_ptr[total_counts]];
6580               ierr = MatSetValue(localChangeOfBasisMatrix,row,row,1.0,INSERT_VALUES);CHKERRQ(ierr);
6581               ierr = MatSetValue(localChangeOfBasisMatrix,row,col,constraints_data[constraints_data_ptr[total_counts]+j]/norm,INSERT_VALUES);CHKERRQ(ierr);
6582             } else {
6583               for (k=0;k<size_of_constraint;k++) {
6584                 col = constraints_idxs[constraints_idxs_ptr[total_counts]+k];
6585                 if (row != col) {
6586                   val = -constraints_data[constraints_data_ptr[total_counts]+k]/constraints_data[constraints_data_ptr[total_counts]];
6587                 } else {
6588                   val = constraints_data[constraints_data_ptr[total_counts]]/norm;
6589                 }
6590                 ierr = MatSetValue(localChangeOfBasisMatrix,row,col,val,INSERT_VALUES);CHKERRQ(ierr);
6591               }
6592             }
6593           }
6594           if (pcbddc->dbg_flag) {
6595             ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"\t-> using standard change of basis\n");CHKERRQ(ierr);
6596           }
6597         }
6598       } else {
6599         if (pcbddc->dbg_flag) {
6600           ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Constraint %d does not need a change of basis (size %d)\n",total_counts,size_of_constraint);CHKERRQ(ierr);
6601         }
6602       }
6603     }
6604 
6605     /* free workspace */
6606     if (qr_needed) {
6607       if (pcbddc->dbg_flag) {
6608         ierr = PetscFree(dbg_work);CHKERRQ(ierr);
6609       }
6610       ierr = PetscFree(trs_rhs);CHKERRQ(ierr);
6611       ierr = PetscFree(qr_tau);CHKERRQ(ierr);
6612       ierr = PetscFree(qr_work);CHKERRQ(ierr);
6613       ierr = PetscFree(gqr_work);CHKERRQ(ierr);
6614       ierr = PetscFree(qr_basis);CHKERRQ(ierr);
6615     }
6616     ierr = PetscBTDestroy(&is_primal);CHKERRQ(ierr);
6617     ierr = MatAssemblyBegin(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6618     ierr = MatAssemblyEnd(localChangeOfBasisMatrix,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6619 
6620     /* assembling of global change of variable */
6621     if (!pcbddc->fake_change) {
6622       Mat      tmat;
6623       PetscInt bs;
6624 
6625       ierr = VecGetSize(pcis->vec1_global,&global_size);CHKERRQ(ierr);
6626       ierr = VecGetLocalSize(pcis->vec1_global,&local_size);CHKERRQ(ierr);
6627       ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6628       ierr = MatISSetLocalMat(tmat,localChangeOfBasisMatrix);CHKERRQ(ierr);
6629       ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6630       ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6631       ierr = MatCreate(PetscObjectComm((PetscObject)pc),&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6632       ierr = MatSetType(pcbddc->ChangeOfBasisMatrix,MATAIJ);CHKERRQ(ierr);
6633       ierr = MatGetBlockSize(pc->pmat,&bs);CHKERRQ(ierr);
6634       ierr = MatSetBlockSize(pcbddc->ChangeOfBasisMatrix,bs);CHKERRQ(ierr);
6635       ierr = MatSetSizes(pcbddc->ChangeOfBasisMatrix,local_size,local_size,global_size,global_size);CHKERRQ(ierr);
6636       ierr = MatISSetMPIXAIJPreallocation_Private(tmat,pcbddc->ChangeOfBasisMatrix,PETSC_TRUE);CHKERRQ(ierr);
6637       ierr = MatConvert(tmat,MATAIJ,MAT_REUSE_MATRIX,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6638       ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6639       ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6640       ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6641       ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6642       ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6643       ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6644       ierr = MatDiagonalScale(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,NULL);CHKERRQ(ierr);
6645 
6646       /* check */
6647       if (pcbddc->dbg_flag) {
6648         PetscReal error;
6649         Vec       x,x_change;
6650 
6651         ierr = VecDuplicate(pcis->vec1_global,&x);CHKERRQ(ierr);
6652         ierr = VecDuplicate(pcis->vec1_global,&x_change);CHKERRQ(ierr);
6653         ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
6654         ierr = VecCopy(x,pcis->vec1_global);CHKERRQ(ierr);
6655         ierr = VecScatterBegin(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6656         ierr = VecScatterEnd(matis->rctx,x,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6657         ierr = MatMult(localChangeOfBasisMatrix,pcis->vec1_N,pcis->vec2_N);CHKERRQ(ierr);
6658         ierr = VecScatterBegin(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6659         ierr = VecScatterEnd(matis->rctx,pcis->vec2_N,x,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6660         ierr = MatMult(pcbddc->ChangeOfBasisMatrix,pcis->vec1_global,x_change);CHKERRQ(ierr);
6661         ierr = VecAXPY(x,-1.0,x_change);CHKERRQ(ierr);
6662         ierr = VecNorm(x,NORM_INFINITY,&error);CHKERRQ(ierr);
6663         if (error > PETSC_SMALL) {
6664           SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"Error global vs local change on N: %1.6e\n",error);
6665         }
6666         ierr = VecDestroy(&x);CHKERRQ(ierr);
6667         ierr = VecDestroy(&x_change);CHKERRQ(ierr);
6668       }
6669       /* adapt sub_schurs computed (if any) */
6670       if (pcbddc->use_deluxe_scaling) {
6671         PCBDDCSubSchurs sub_schurs=pcbddc->sub_schurs;
6672 
6673         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");
6674         if (sub_schurs && sub_schurs->S_Ej_all) {
6675           Mat                    S_new,tmat;
6676           IS                     is_all_N,is_V_Sall = NULL;
6677 
6678           ierr = ISLocalToGlobalMappingApplyIS(pcis->BtoNmap,sub_schurs->is_Ej_all,&is_all_N);CHKERRQ(ierr);
6679           ierr = MatCreateSubMatrix(localChangeOfBasisMatrix,is_all_N,is_all_N,MAT_INITIAL_MATRIX,&tmat);CHKERRQ(ierr);
6680           if (pcbddc->deluxe_zerorows) {
6681             ISLocalToGlobalMapping NtoSall;
6682             IS                     is_V;
6683             ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddc->n_vertices,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&is_V);CHKERRQ(ierr);
6684             ierr = ISLocalToGlobalMappingCreateIS(is_all_N,&NtoSall);CHKERRQ(ierr);
6685             ierr = ISGlobalToLocalMappingApplyIS(NtoSall,IS_GTOLM_DROP,is_V,&is_V_Sall);CHKERRQ(ierr);
6686             ierr = ISLocalToGlobalMappingDestroy(&NtoSall);CHKERRQ(ierr);
6687             ierr = ISDestroy(&is_V);CHKERRQ(ierr);
6688           }
6689           ierr = ISDestroy(&is_all_N);CHKERRQ(ierr);
6690           ierr = MatPtAP(sub_schurs->S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6691           ierr = MatDestroy(&sub_schurs->S_Ej_all);CHKERRQ(ierr);
6692           ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6693           if (pcbddc->deluxe_zerorows) {
6694             const PetscScalar *array;
6695             const PetscInt    *idxs_V,*idxs_all;
6696             PetscInt          i,n_V;
6697 
6698             ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6699             ierr = ISGetLocalSize(is_V_Sall,&n_V);CHKERRQ(ierr);
6700             ierr = ISGetIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6701             ierr = ISGetIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6702             ierr = VecGetArrayRead(pcis->D,&array);CHKERRQ(ierr);
6703             for (i=0;i<n_V;i++) {
6704               PetscScalar val;
6705               PetscInt    idx;
6706 
6707               idx = idxs_V[i];
6708               val = array[idxs_all[idxs_V[i]]];
6709               ierr = MatSetValue(S_new,idx,idx,val,INSERT_VALUES);CHKERRQ(ierr);
6710             }
6711             ierr = MatAssemblyBegin(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6712             ierr = MatAssemblyEnd(S_new,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6713             ierr = VecRestoreArrayRead(pcis->D,&array);CHKERRQ(ierr);
6714             ierr = ISRestoreIndices(sub_schurs->is_Ej_all,&idxs_all);CHKERRQ(ierr);
6715             ierr = ISRestoreIndices(is_V_Sall,&idxs_V);CHKERRQ(ierr);
6716           }
6717           sub_schurs->S_Ej_all = S_new;
6718           ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6719           if (sub_schurs->sum_S_Ej_all) {
6720             ierr = MatPtAP(sub_schurs->sum_S_Ej_all,tmat,MAT_INITIAL_MATRIX,1.0,&S_new);CHKERRQ(ierr);
6721             ierr = MatDestroy(&sub_schurs->sum_S_Ej_all);CHKERRQ(ierr);
6722             ierr = PetscObjectReference((PetscObject)S_new);CHKERRQ(ierr);
6723             if (pcbddc->deluxe_zerorows) {
6724               ierr = MatZeroRowsColumnsIS(S_new,is_V_Sall,1.,NULL,NULL);CHKERRQ(ierr);
6725             }
6726             sub_schurs->sum_S_Ej_all = S_new;
6727             ierr = MatDestroy(&S_new);CHKERRQ(ierr);
6728           }
6729           ierr = ISDestroy(&is_V_Sall);CHKERRQ(ierr);
6730           ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6731         }
6732         /* destroy any change of basis context in sub_schurs */
6733         if (sub_schurs && sub_schurs->change) {
6734           PetscInt i;
6735 
6736           for (i=0;i<sub_schurs->n_subs;i++) {
6737             ierr = KSPDestroy(&sub_schurs->change[i]);CHKERRQ(ierr);
6738           }
6739           ierr = PetscFree(sub_schurs->change);CHKERRQ(ierr);
6740         }
6741       }
6742       if (pcbddc->switch_static) { /* need to save the local change */
6743         pcbddc->switch_static_change = localChangeOfBasisMatrix;
6744       } else {
6745         ierr = MatDestroy(&localChangeOfBasisMatrix);CHKERRQ(ierr);
6746       }
6747       /* determine if any process has changed the pressures locally */
6748       pcbddc->change_interior = pcbddc->benign_have_null;
6749     } else { /* fake change (get back change of basis into ConstraintMatrix and info on qr) */
6750       ierr = MatDestroy(&pcbddc->ConstraintMatrix);CHKERRQ(ierr);
6751       pcbddc->ConstraintMatrix = localChangeOfBasisMatrix;
6752       pcbddc->use_qr_single = qr_needed;
6753     }
6754   } else if (pcbddc->user_ChangeOfBasisMatrix || pcbddc->benign_saddle_point) {
6755     if (!pcbddc->benign_have_null && pcbddc->user_ChangeOfBasisMatrix) {
6756       ierr = PetscObjectReference((PetscObject)pcbddc->user_ChangeOfBasisMatrix);CHKERRQ(ierr);
6757       pcbddc->ChangeOfBasisMatrix = pcbddc->user_ChangeOfBasisMatrix;
6758     } else {
6759       Mat benign_global = NULL;
6760       if (pcbddc->benign_have_null) {
6761         Mat tmat;
6762 
6763         pcbddc->change_interior = PETSC_TRUE;
6764         ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
6765         ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
6766         ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6767         ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
6768         ierr = VecReciprocal(pcis->vec1_global);CHKERRQ(ierr);
6769         ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6770         ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
6771         ierr = MatDuplicate(pc->pmat,MAT_DO_NOT_COPY_VALUES,&tmat);CHKERRQ(ierr);
6772         if (pcbddc->benign_change) {
6773           Mat M;
6774 
6775           ierr = MatDuplicate(pcbddc->benign_change,MAT_COPY_VALUES,&M);CHKERRQ(ierr);
6776           ierr = MatDiagonalScale(M,pcis->vec1_N,NULL);CHKERRQ(ierr);
6777           ierr = MatISSetLocalMat(tmat,M);CHKERRQ(ierr);
6778           ierr = MatDestroy(&M);CHKERRQ(ierr);
6779         } else {
6780           Mat         eye;
6781           PetscScalar *array;
6782 
6783           ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6784           ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,pcis->n,pcis->n,1,NULL,&eye);CHKERRQ(ierr);
6785           for (i=0;i<pcis->n;i++) {
6786             ierr = MatSetValue(eye,i,i,array[i],INSERT_VALUES);CHKERRQ(ierr);
6787           }
6788           ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
6789           ierr = MatAssemblyBegin(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6790           ierr = MatAssemblyEnd(eye,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6791           ierr = MatISSetLocalMat(tmat,eye);CHKERRQ(ierr);
6792           ierr = MatDestroy(&eye);CHKERRQ(ierr);
6793         }
6794         ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6795         ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
6796         ierr = MatConvert(tmat,MATAIJ,MAT_INITIAL_MATRIX,&benign_global);CHKERRQ(ierr);
6797         ierr = MatDestroy(&tmat);CHKERRQ(ierr);
6798       }
6799       if (pcbddc->user_ChangeOfBasisMatrix) {
6800         ierr = MatMatMult(pcbddc->user_ChangeOfBasisMatrix,benign_global,MAT_INITIAL_MATRIX,PETSC_DEFAULT,&pcbddc->ChangeOfBasisMatrix);CHKERRQ(ierr);
6801         ierr = MatDestroy(&benign_global);CHKERRQ(ierr);
6802       } else if (pcbddc->benign_have_null) {
6803         pcbddc->ChangeOfBasisMatrix = benign_global;
6804       }
6805     }
6806     if (pcbddc->switch_static && pcbddc->ChangeOfBasisMatrix) { /* need to save the local change */
6807       IS             is_global;
6808       const PetscInt *gidxs;
6809 
6810       ierr = ISLocalToGlobalMappingGetIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6811       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcis->n,gidxs,PETSC_COPY_VALUES,&is_global);CHKERRQ(ierr);
6812       ierr = ISLocalToGlobalMappingRestoreIndices(pc->pmat->rmap->mapping,&gidxs);CHKERRQ(ierr);
6813       ierr = MatCreateSubMatrixUnsorted(pcbddc->ChangeOfBasisMatrix,is_global,is_global,&pcbddc->switch_static_change);CHKERRQ(ierr);
6814       ierr = ISDestroy(&is_global);CHKERRQ(ierr);
6815     }
6816   }
6817   if (!pcbddc->fake_change && pcbddc->ChangeOfBasisMatrix && !pcbddc->work_change) {
6818     ierr = VecDuplicate(pcis->vec1_global,&pcbddc->work_change);CHKERRQ(ierr);
6819   }
6820 
6821   if (!pcbddc->fake_change) {
6822     /* add pressure dofs to set of primal nodes for numbering purposes */
6823     for (i=0;i<pcbddc->benign_n;i++) {
6824       pcbddc->local_primal_ref_node[pcbddc->local_primal_size_cc] = pcbddc->benign_p0_lidx[i];
6825       pcbddc->primal_indices_local_idxs[pcbddc->local_primal_size] = pcbddc->benign_p0_lidx[i];
6826       pcbddc->local_primal_ref_mult[pcbddc->local_primal_size_cc] = 1;
6827       pcbddc->local_primal_size_cc++;
6828       pcbddc->local_primal_size++;
6829     }
6830 
6831     /* check if a new primal space has been introduced (also take into account benign trick) */
6832     pcbddc->new_primal_space_local = PETSC_TRUE;
6833     if (olocal_primal_size == pcbddc->local_primal_size) {
6834       ierr = PetscMemcmp(pcbddc->local_primal_ref_node,olocal_primal_ref_node,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6835       pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6836       if (!pcbddc->new_primal_space_local) {
6837         ierr = PetscMemcmp(pcbddc->local_primal_ref_mult,olocal_primal_ref_mult,olocal_primal_size_cc*sizeof(PetscInt),&pcbddc->new_primal_space_local);CHKERRQ(ierr);
6838         pcbddc->new_primal_space_local = (PetscBool)(!pcbddc->new_primal_space_local);
6839       }
6840     }
6841     /* new_primal_space will be used for numbering of coarse dofs, so it should be the same across all subdomains */
6842     ierr = MPIU_Allreduce(&pcbddc->new_primal_space_local,&pcbddc->new_primal_space,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
6843   }
6844   ierr = PetscFree2(olocal_primal_ref_node,olocal_primal_ref_mult);CHKERRQ(ierr);
6845 
6846   /* flush dbg viewer */
6847   if (pcbddc->dbg_flag) {
6848     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6849   }
6850 
6851   /* free workspace */
6852   ierr = PetscBTDestroy(&qr_needed_idx);CHKERRQ(ierr);
6853   ierr = PetscBTDestroy(&change_basis);CHKERRQ(ierr);
6854   if (!pcbddc->adaptive_selection) {
6855     ierr = PetscFree3(constraints_idxs_ptr,constraints_data_ptr,constraints_n);CHKERRQ(ierr);
6856     ierr = PetscFree3(constraints_data,constraints_idxs,constraints_idxs_B);CHKERRQ(ierr);
6857   } else {
6858     ierr = PetscFree5(pcbddc->adaptive_constraints_n,
6859                       pcbddc->adaptive_constraints_idxs_ptr,
6860                       pcbddc->adaptive_constraints_data_ptr,
6861                       pcbddc->adaptive_constraints_idxs,
6862                       pcbddc->adaptive_constraints_data);CHKERRQ(ierr);
6863     ierr = PetscFree(constraints_n);CHKERRQ(ierr);
6864     ierr = PetscFree(constraints_idxs_B);CHKERRQ(ierr);
6865   }
6866   PetscFunctionReturn(0);
6867 }
6868 /* #undef PETSC_MISSING_LAPACK_GESVD */
6869 
6870 PetscErrorCode PCBDDCAnalyzeInterface(PC pc)
6871 {
6872   ISLocalToGlobalMapping map;
6873   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
6874   Mat_IS                 *matis  = (Mat_IS*)pc->pmat->data;
6875   PetscInt               i,N;
6876   PetscBool              rcsr = PETSC_FALSE;
6877   PetscErrorCode         ierr;
6878 
6879   PetscFunctionBegin;
6880   if (pcbddc->recompute_topography) {
6881     pcbddc->graphanalyzed = PETSC_FALSE;
6882     /* Reset previously computed graph */
6883     ierr = PCBDDCGraphReset(pcbddc->mat_graph);CHKERRQ(ierr);
6884     /* Init local Graph struct */
6885     ierr = MatGetSize(pc->pmat,&N,NULL);CHKERRQ(ierr);
6886     ierr = MatGetLocalToGlobalMapping(pc->pmat,&map,NULL);CHKERRQ(ierr);
6887     ierr = PCBDDCGraphInit(pcbddc->mat_graph,map,N,pcbddc->graphmaxcount);CHKERRQ(ierr);
6888 
6889     if (pcbddc->user_primal_vertices_local && !pcbddc->user_primal_vertices) {
6890       ierr = PCBDDCConsistencyCheckIS(pc,MPI_LOR,&pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6891     }
6892     /* Check validity of the csr graph passed in by the user */
6893     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);
6894 
6895     /* Set default CSR adjacency of local dofs if not provided by the user with PCBDDCSetLocalAdjacencyGraph */
6896     if (!pcbddc->mat_graph->xadj && pcbddc->use_local_adj) {
6897       PetscInt  *xadj,*adjncy;
6898       PetscInt  nvtxs;
6899       PetscBool flg_row=PETSC_FALSE;
6900 
6901       ierr = MatGetRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6902       if (flg_row) {
6903         ierr = PCBDDCSetLocalAdjacencyGraph(pc,nvtxs,xadj,adjncy,PETSC_COPY_VALUES);CHKERRQ(ierr);
6904         pcbddc->computed_rowadj = PETSC_TRUE;
6905       }
6906       ierr = MatRestoreRowIJ(matis->A,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&flg_row);CHKERRQ(ierr);
6907       rcsr = PETSC_TRUE;
6908     }
6909     if (pcbddc->dbg_flag) {
6910       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
6911     }
6912 
6913     if (pcbddc->mat_graph->cdim && !pcbddc->mat_graph->cloc) {
6914       PetscReal    *lcoords;
6915       PetscInt     n;
6916       MPI_Datatype dimrealtype;
6917 
6918       if (pcbddc->mat_graph->cnloc != pc->pmat->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pc->pmat->rmap->n);
6919       ierr = MatGetLocalSize(matis->A,&n,NULL);CHKERRQ(ierr);
6920       ierr = MatISSetUpSF(pc->pmat);CHKERRQ(ierr);
6921       ierr = PetscMalloc1(pcbddc->mat_graph->cdim*n,&lcoords);CHKERRQ(ierr);
6922       ierr = MPI_Type_contiguous(pcbddc->mat_graph->cdim,MPIU_REAL,&dimrealtype);CHKERRQ(ierr);
6923       ierr = MPI_Type_commit(&dimrealtype);CHKERRQ(ierr);
6924       ierr = PetscSFBcastBegin(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6925       ierr = PetscSFBcastEnd(matis->sf,dimrealtype,pcbddc->mat_graph->coords,lcoords);CHKERRQ(ierr);
6926       ierr = MPI_Type_free(&dimrealtype);CHKERRQ(ierr);
6927       ierr = PetscFree(pcbddc->mat_graph->coords);CHKERRQ(ierr);
6928 
6929       pcbddc->mat_graph->coords = lcoords;
6930       pcbddc->mat_graph->cloc   = PETSC_TRUE;
6931       pcbddc->mat_graph->cnloc  = n;
6932     }
6933     if (pcbddc->mat_graph->cnloc && pcbddc->mat_graph->cnloc != pcbddc->mat_graph->nvtxs) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_USER,"Invalid number of local subdomain coordinates! Got %D, expected %D",pcbddc->mat_graph->cnloc,pcbddc->mat_graph->nvtxs);
6934     pcbddc->mat_graph->active_coords = (PetscBool)(pcbddc->corner_selection && !pcbddc->corner_selected);
6935 
6936     /* Setup of Graph */
6937     pcbddc->mat_graph->commsizelimit = 0; /* don't use the COMM_SELF variant of the graph */
6938     ierr = PCBDDCGraphSetUp(pcbddc->mat_graph,pcbddc->vertex_size,pcbddc->NeumannBoundariesLocal,pcbddc->DirichletBoundariesLocal,pcbddc->n_ISForDofsLocal,pcbddc->ISForDofsLocal,pcbddc->user_primal_vertices_local);CHKERRQ(ierr);
6939 
6940     /* attach info on disconnected subdomains if present */
6941     if (pcbddc->n_local_subs) {
6942       PetscInt *local_subs;
6943 
6944       ierr = PetscMalloc1(N,&local_subs);CHKERRQ(ierr);
6945       for (i=0;i<pcbddc->n_local_subs;i++) {
6946         const PetscInt *idxs;
6947         PetscInt       nl,j;
6948 
6949         ierr = ISGetLocalSize(pcbddc->local_subs[i],&nl);CHKERRQ(ierr);
6950         ierr = ISGetIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6951         for (j=0;j<nl;j++) local_subs[idxs[j]] = i;
6952         ierr = ISRestoreIndices(pcbddc->local_subs[i],&idxs);CHKERRQ(ierr);
6953       }
6954       pcbddc->mat_graph->n_local_subs = pcbddc->n_local_subs;
6955       pcbddc->mat_graph->local_subs = local_subs;
6956     }
6957   }
6958 
6959   if (!pcbddc->graphanalyzed) {
6960     /* Graph's connected components analysis */
6961     ierr = PCBDDCGraphComputeConnectedComponents(pcbddc->mat_graph);CHKERRQ(ierr);
6962     pcbddc->graphanalyzed = PETSC_TRUE;
6963   }
6964   if (rcsr) pcbddc->mat_graph->nvtxs_csr = 0;
6965   PetscFunctionReturn(0);
6966 }
6967 
6968 PetscErrorCode PCBDDCOrthonormalizeVecs(PetscInt n, Vec vecs[])
6969 {
6970   PetscInt       i,j;
6971   PetscScalar    *alphas;
6972   PetscErrorCode ierr;
6973 
6974   PetscFunctionBegin;
6975   if (!n) PetscFunctionReturn(0);
6976   ierr = PetscMalloc1(n,&alphas);CHKERRQ(ierr);
6977   ierr = VecNormalize(vecs[0],NULL);CHKERRQ(ierr);
6978   for (i=1;i<n;i++) {
6979     ierr = VecMDot(vecs[i],i,vecs,alphas);CHKERRQ(ierr);
6980     for (j=0;j<i;j++) alphas[j] = PetscConj(-alphas[j]);
6981     ierr = VecMAXPY(vecs[i],i,alphas,vecs);CHKERRQ(ierr);
6982     ierr = VecNormalize(vecs[i],NULL);CHKERRQ(ierr);
6983   }
6984   ierr = PetscFree(alphas);CHKERRQ(ierr);
6985   PetscFunctionReturn(0);
6986 }
6987 
6988 PetscErrorCode PCBDDCMatISGetSubassemblingPattern(Mat mat, PetscInt *n_subdomains, PetscInt redprocs, IS* is_sends, PetscBool *have_void)
6989 {
6990   Mat            A;
6991   PetscInt       n_neighs,*neighs,*n_shared,**shared;
6992   PetscMPIInt    size,rank,color;
6993   PetscInt       *xadj,*adjncy;
6994   PetscInt       *adjncy_wgt,*v_wgt,*ranks_send_to_idx;
6995   PetscInt       im_active,active_procs,N,n,i,j,threshold = 2;
6996   PetscInt       void_procs,*procs_candidates = NULL;
6997   PetscInt       xadj_count,*count;
6998   PetscBool      ismatis,use_vwgt=PETSC_FALSE;
6999   PetscSubcomm   psubcomm;
7000   MPI_Comm       subcomm;
7001   PetscErrorCode ierr;
7002 
7003   PetscFunctionBegin;
7004   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7005   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7006   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
7007   PetscValidLogicalCollectiveInt(mat,*n_subdomains,2);
7008   PetscValidLogicalCollectiveInt(mat,redprocs,3);
7009   if (*n_subdomains <=0) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_ARG_WRONG,"Invalid number of subdomains requested %d\n",*n_subdomains);
7010 
7011   if (have_void) *have_void = PETSC_FALSE;
7012   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&size);CHKERRQ(ierr);
7013   ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)mat),&rank);CHKERRQ(ierr);
7014   ierr = MatISGetLocalMat(mat,&A);CHKERRQ(ierr);
7015   ierr = MatGetLocalSize(A,&n,NULL);CHKERRQ(ierr);
7016   im_active = !!n;
7017   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7018   void_procs = size - active_procs;
7019   /* get ranks of of non-active processes in mat communicator */
7020   if (void_procs) {
7021     PetscInt ncand;
7022 
7023     if (have_void) *have_void = PETSC_TRUE;
7024     ierr = PetscMalloc1(size,&procs_candidates);CHKERRQ(ierr);
7025     ierr = MPI_Allgather(&im_active,1,MPIU_INT,procs_candidates,1,MPIU_INT,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
7026     for (i=0,ncand=0;i<size;i++) {
7027       if (!procs_candidates[i]) {
7028         procs_candidates[ncand++] = i;
7029       }
7030     }
7031     /* force n_subdomains to be not greater that the number of non-active processes */
7032     *n_subdomains = PetscMin(void_procs,*n_subdomains);
7033   }
7034 
7035   /* number of subdomains requested greater than active processes or matrix size -> just shift the matrix
7036      number of subdomains requested 1 -> send to master or first candidate in voids  */
7037   ierr = MatGetSize(mat,&N,NULL);CHKERRQ(ierr);
7038   if (active_procs < *n_subdomains || *n_subdomains == 1 || N <= *n_subdomains) {
7039     PetscInt issize,isidx,dest;
7040     if (*n_subdomains == 1) dest = 0;
7041     else dest = rank;
7042     if (im_active) {
7043       issize = 1;
7044       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7045         isidx = procs_candidates[dest];
7046       } else {
7047         isidx = dest;
7048       }
7049     } else {
7050       issize = 0;
7051       isidx = -1;
7052     }
7053     if (*n_subdomains != 1) *n_subdomains = active_procs;
7054     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),issize,&isidx,PETSC_COPY_VALUES,is_sends);CHKERRQ(ierr);
7055     ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7056     PetscFunctionReturn(0);
7057   }
7058   ierr = PetscOptionsGetBool(NULL,NULL,"-matis_partitioning_use_vwgt",&use_vwgt,NULL);CHKERRQ(ierr);
7059   ierr = PetscOptionsGetInt(NULL,NULL,"-matis_partitioning_threshold",&threshold,NULL);CHKERRQ(ierr);
7060   threshold = PetscMax(threshold,2);
7061 
7062   /* Get info on mapping */
7063   ierr = ISLocalToGlobalMappingGetInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7064 
7065   /* build local CSR graph of subdomains' connectivity */
7066   ierr = PetscMalloc1(2,&xadj);CHKERRQ(ierr);
7067   xadj[0] = 0;
7068   xadj[1] = PetscMax(n_neighs-1,0);
7069   ierr = PetscMalloc1(xadj[1],&adjncy);CHKERRQ(ierr);
7070   ierr = PetscMalloc1(xadj[1],&adjncy_wgt);CHKERRQ(ierr);
7071   ierr = PetscCalloc1(n,&count);CHKERRQ(ierr);
7072   for (i=1;i<n_neighs;i++)
7073     for (j=0;j<n_shared[i];j++)
7074       count[shared[i][j]] += 1;
7075 
7076   xadj_count = 0;
7077   for (i=1;i<n_neighs;i++) {
7078     for (j=0;j<n_shared[i];j++) {
7079       if (count[shared[i][j]] < threshold) {
7080         adjncy[xadj_count] = neighs[i];
7081         adjncy_wgt[xadj_count] = n_shared[i];
7082         xadj_count++;
7083         break;
7084       }
7085     }
7086   }
7087   xadj[1] = xadj_count;
7088   ierr = PetscFree(count);CHKERRQ(ierr);
7089   ierr = ISLocalToGlobalMappingRestoreInfo(mat->rmap->mapping,&n_neighs,&neighs,&n_shared,&shared);CHKERRQ(ierr);
7090   ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7091 
7092   ierr = PetscMalloc1(1,&ranks_send_to_idx);CHKERRQ(ierr);
7093 
7094   /* Restrict work on active processes only */
7095   ierr = PetscMPIIntCast(im_active,&color);CHKERRQ(ierr);
7096   if (void_procs) {
7097     ierr = PetscSubcommCreate(PetscObjectComm((PetscObject)mat),&psubcomm);CHKERRQ(ierr);
7098     ierr = PetscSubcommSetNumber(psubcomm,2);CHKERRQ(ierr); /* 2 groups, active process and not active processes */
7099     ierr = PetscSubcommSetTypeGeneral(psubcomm,color,rank);CHKERRQ(ierr);
7100     subcomm = PetscSubcommChild(psubcomm);
7101   } else {
7102     psubcomm = NULL;
7103     subcomm = PetscObjectComm((PetscObject)mat);
7104   }
7105 
7106   v_wgt = NULL;
7107   if (!color) {
7108     ierr = PetscFree(xadj);CHKERRQ(ierr);
7109     ierr = PetscFree(adjncy);CHKERRQ(ierr);
7110     ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7111   } else {
7112     Mat             subdomain_adj;
7113     IS              new_ranks,new_ranks_contig;
7114     MatPartitioning partitioner;
7115     PetscInt        rstart=0,rend=0;
7116     PetscInt        *is_indices,*oldranks;
7117     PetscMPIInt     size;
7118     PetscBool       aggregate;
7119 
7120     ierr = MPI_Comm_size(subcomm,&size);CHKERRQ(ierr);
7121     if (void_procs) {
7122       PetscInt prank = rank;
7123       ierr = PetscMalloc1(size,&oldranks);CHKERRQ(ierr);
7124       ierr = MPI_Allgather(&prank,1,MPIU_INT,oldranks,1,MPIU_INT,subcomm);CHKERRQ(ierr);
7125       for (i=0;i<xadj[1];i++) {
7126         ierr = PetscFindInt(adjncy[i],size,oldranks,&adjncy[i]);CHKERRQ(ierr);
7127       }
7128       ierr = PetscSortIntWithArray(xadj[1],adjncy,adjncy_wgt);CHKERRQ(ierr);
7129     } else {
7130       oldranks = NULL;
7131     }
7132     aggregate = ((redprocs > 0 && redprocs < size) ? PETSC_TRUE : PETSC_FALSE);
7133     if (aggregate) { /* TODO: all this part could be made more efficient */
7134       PetscInt    lrows,row,ncols,*cols;
7135       PetscMPIInt nrank;
7136       PetscScalar *vals;
7137 
7138       ierr = MPI_Comm_rank(subcomm,&nrank);CHKERRQ(ierr);
7139       lrows = 0;
7140       if (nrank<redprocs) {
7141         lrows = size/redprocs;
7142         if (nrank<size%redprocs) lrows++;
7143       }
7144       ierr = MatCreateAIJ(subcomm,lrows,lrows,size,size,50,NULL,50,NULL,&subdomain_adj);CHKERRQ(ierr);
7145       ierr = MatGetOwnershipRange(subdomain_adj,&rstart,&rend);CHKERRQ(ierr);
7146       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7147       ierr = MatSetOption(subdomain_adj,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
7148       row = nrank;
7149       ncols = xadj[1]-xadj[0];
7150       cols = adjncy;
7151       ierr = PetscMalloc1(ncols,&vals);CHKERRQ(ierr);
7152       for (i=0;i<ncols;i++) vals[i] = adjncy_wgt[i];
7153       ierr = MatSetValues(subdomain_adj,1,&row,ncols,cols,vals,INSERT_VALUES);CHKERRQ(ierr);
7154       ierr = MatAssemblyBegin(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7155       ierr = MatAssemblyEnd(subdomain_adj,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7156       ierr = PetscFree(xadj);CHKERRQ(ierr);
7157       ierr = PetscFree(adjncy);CHKERRQ(ierr);
7158       ierr = PetscFree(adjncy_wgt);CHKERRQ(ierr);
7159       ierr = PetscFree(vals);CHKERRQ(ierr);
7160       if (use_vwgt) {
7161         Vec               v;
7162         const PetscScalar *array;
7163         PetscInt          nl;
7164 
7165         ierr = MatCreateVecs(subdomain_adj,&v,NULL);CHKERRQ(ierr);
7166         ierr = VecSetValue(v,row,(PetscScalar)n,INSERT_VALUES);CHKERRQ(ierr);
7167         ierr = VecAssemblyBegin(v);CHKERRQ(ierr);
7168         ierr = VecAssemblyEnd(v);CHKERRQ(ierr);
7169         ierr = VecGetLocalSize(v,&nl);CHKERRQ(ierr);
7170         ierr = VecGetArrayRead(v,&array);CHKERRQ(ierr);
7171         ierr = PetscMalloc1(nl,&v_wgt);CHKERRQ(ierr);
7172         for (i=0;i<nl;i++) v_wgt[i] = (PetscInt)PetscRealPart(array[i]);
7173         ierr = VecRestoreArrayRead(v,&array);CHKERRQ(ierr);
7174         ierr = VecDestroy(&v);CHKERRQ(ierr);
7175       }
7176     } else {
7177       ierr = MatCreateMPIAdj(subcomm,1,(PetscInt)size,xadj,adjncy,adjncy_wgt,&subdomain_adj);CHKERRQ(ierr);
7178       if (use_vwgt) {
7179         ierr = PetscMalloc1(1,&v_wgt);CHKERRQ(ierr);
7180         v_wgt[0] = n;
7181       }
7182     }
7183     /* ierr = MatView(subdomain_adj,0);CHKERRQ(ierr); */
7184 
7185     /* Partition */
7186     ierr = MatPartitioningCreate(subcomm,&partitioner);CHKERRQ(ierr);
7187     ierr = MatPartitioningSetAdjacency(partitioner,subdomain_adj);CHKERRQ(ierr);
7188     if (v_wgt) {
7189       ierr = MatPartitioningSetVertexWeights(partitioner,v_wgt);CHKERRQ(ierr);
7190     }
7191     *n_subdomains = PetscMin((PetscInt)size,*n_subdomains);
7192     ierr = MatPartitioningSetNParts(partitioner,*n_subdomains);CHKERRQ(ierr);
7193     ierr = MatPartitioningSetFromOptions(partitioner);CHKERRQ(ierr);
7194     ierr = MatPartitioningApply(partitioner,&new_ranks);CHKERRQ(ierr);
7195     /* ierr = MatPartitioningView(partitioner,0);CHKERRQ(ierr); */
7196 
7197     /* renumber new_ranks to avoid "holes" in new set of processors */
7198     ierr = ISRenumber(new_ranks,NULL,NULL,&new_ranks_contig);CHKERRQ(ierr);
7199     ierr = ISDestroy(&new_ranks);CHKERRQ(ierr);
7200     ierr = ISGetIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7201     if (!aggregate) {
7202       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7203 #if defined(PETSC_USE_DEBUG)
7204         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7205 #endif
7206         ranks_send_to_idx[0] = procs_candidates[oldranks[is_indices[0]]];
7207       } else if (oldranks) {
7208         ranks_send_to_idx[0] = oldranks[is_indices[0]];
7209       } else {
7210         ranks_send_to_idx[0] = is_indices[0];
7211       }
7212     } else {
7213       PetscInt    idx = 0;
7214       PetscMPIInt tag;
7215       MPI_Request *reqs;
7216 
7217       ierr = PetscObjectGetNewTag((PetscObject)subdomain_adj,&tag);CHKERRQ(ierr);
7218       ierr = PetscMalloc1(rend-rstart,&reqs);CHKERRQ(ierr);
7219       for (i=rstart;i<rend;i++) {
7220         ierr = MPI_Isend(is_indices+i-rstart,1,MPIU_INT,i,tag,subcomm,&reqs[i-rstart]);CHKERRQ(ierr);
7221       }
7222       ierr = MPI_Recv(&idx,1,MPIU_INT,MPI_ANY_SOURCE,tag,subcomm,MPI_STATUS_IGNORE);CHKERRQ(ierr);
7223       ierr = MPI_Waitall(rend-rstart,reqs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7224       ierr = PetscFree(reqs);CHKERRQ(ierr);
7225       if (procs_candidates) { /* shift the pattern on non-active candidates (if any) */
7226 #if defined(PETSC_USE_DEBUG)
7227         if (!oldranks) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"This should not happen");
7228 #endif
7229         ranks_send_to_idx[0] = procs_candidates[oldranks[idx]];
7230       } else if (oldranks) {
7231         ranks_send_to_idx[0] = oldranks[idx];
7232       } else {
7233         ranks_send_to_idx[0] = idx;
7234       }
7235     }
7236     ierr = ISRestoreIndices(new_ranks_contig,(const PetscInt**)&is_indices);CHKERRQ(ierr);
7237     /* clean up */
7238     ierr = PetscFree(oldranks);CHKERRQ(ierr);
7239     ierr = ISDestroy(&new_ranks_contig);CHKERRQ(ierr);
7240     ierr = MatDestroy(&subdomain_adj);CHKERRQ(ierr);
7241     ierr = MatPartitioningDestroy(&partitioner);CHKERRQ(ierr);
7242   }
7243   ierr = PetscSubcommDestroy(&psubcomm);CHKERRQ(ierr);
7244   ierr = PetscFree(procs_candidates);CHKERRQ(ierr);
7245 
7246   /* assemble parallel IS for sends */
7247   i = 1;
7248   if (!color) i=0;
7249   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)mat),i,ranks_send_to_idx,PETSC_OWN_POINTER,is_sends);CHKERRQ(ierr);
7250   PetscFunctionReturn(0);
7251 }
7252 
7253 typedef enum {MATDENSE_PRIVATE=0,MATAIJ_PRIVATE,MATBAIJ_PRIVATE,MATSBAIJ_PRIVATE}MatTypePrivate;
7254 
7255 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[])
7256 {
7257   Mat                    local_mat;
7258   IS                     is_sends_internal;
7259   PetscInt               rows,cols,new_local_rows;
7260   PetscInt               i,bs,buf_size_idxs,buf_size_idxs_is,buf_size_vals,buf_size_vecs;
7261   PetscBool              ismatis,isdense,newisdense,destroy_mat;
7262   ISLocalToGlobalMapping l2gmap;
7263   PetscInt*              l2gmap_indices;
7264   const PetscInt*        is_indices;
7265   MatType                new_local_type;
7266   /* buffers */
7267   PetscInt               *ptr_idxs,*send_buffer_idxs,*recv_buffer_idxs;
7268   PetscInt               *ptr_idxs_is,*send_buffer_idxs_is,*recv_buffer_idxs_is;
7269   PetscInt               *recv_buffer_idxs_local;
7270   PetscScalar            *ptr_vals,*send_buffer_vals,*recv_buffer_vals;
7271   PetscScalar            *ptr_vecs,*send_buffer_vecs,*recv_buffer_vecs;
7272   /* MPI */
7273   MPI_Comm               comm,comm_n;
7274   PetscSubcomm           subcomm;
7275   PetscMPIInt            n_sends,n_recvs,commsize;
7276   PetscMPIInt            *iflags,*ilengths_idxs,*ilengths_vals,*ilengths_idxs_is;
7277   PetscMPIInt            *onodes,*onodes_is,*olengths_idxs,*olengths_idxs_is,*olengths_vals;
7278   PetscMPIInt            len,tag_idxs,tag_idxs_is,tag_vals,tag_vecs,source_dest;
7279   MPI_Request            *send_req_idxs,*send_req_idxs_is,*send_req_vals,*send_req_vecs;
7280   MPI_Request            *recv_req_idxs,*recv_req_idxs_is,*recv_req_vals,*recv_req_vecs;
7281   PetscErrorCode         ierr;
7282 
7283   PetscFunctionBegin;
7284   PetscValidHeaderSpecific(mat,MAT_CLASSID,1);
7285   ierr = PetscObjectTypeCompare((PetscObject)mat,MATIS,&ismatis);CHKERRQ(ierr);
7286   if (!ismatis) SETERRQ1(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot use %s on a matrix object which is not of type MATIS",PETSC_FUNCTION_NAME);
7287   PetscValidLogicalCollectiveInt(mat,n_subdomains,3);
7288   PetscValidLogicalCollectiveBool(mat,restrict_comm,4);
7289   PetscValidLogicalCollectiveBool(mat,restrict_full,5);
7290   PetscValidLogicalCollectiveBool(mat,reuse,6);
7291   PetscValidLogicalCollectiveInt(mat,nis,8);
7292   PetscValidLogicalCollectiveInt(mat,nvecs,10);
7293   if (nvecs) {
7294     if (nvecs > 1) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Just 1 vector supported");
7295     PetscValidHeaderSpecific(nnsp_vec[0],VEC_CLASSID,11);
7296   }
7297   /* further checks */
7298   ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7299   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&isdense);CHKERRQ(ierr);
7300   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Currently cannot subassemble MATIS when local matrix type is not of type SEQDENSE");
7301   ierr = MatGetSize(local_mat,&rows,&cols);CHKERRQ(ierr);
7302   if (rows != cols) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Local MATIS matrices should be square");
7303   if (reuse && *mat_n) {
7304     PetscInt mrows,mcols,mnrows,mncols;
7305     PetscValidHeaderSpecific(*mat_n,MAT_CLASSID,7);
7306     ierr = PetscObjectTypeCompare((PetscObject)*mat_n,MATIS,&ismatis);CHKERRQ(ierr);
7307     if (!ismatis) SETERRQ(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_SUP,"Cannot reuse a matrix which is not of type MATIS");
7308     ierr = MatGetSize(mat,&mrows,&mcols);CHKERRQ(ierr);
7309     ierr = MatGetSize(*mat_n,&mnrows,&mncols);CHKERRQ(ierr);
7310     if (mrows != mnrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of rows %D != %D",mrows,mnrows);
7311     if (mcols != mncols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix! Wrong number of cols %D != %D",mcols,mncols);
7312   }
7313   ierr = MatGetBlockSize(local_mat,&bs);CHKERRQ(ierr);
7314   PetscValidLogicalCollectiveInt(mat,bs,0);
7315 
7316   /* prepare IS for sending if not provided */
7317   if (!is_sends) {
7318     if (!n_subdomains) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"You should specify either an IS or a target number of subdomains");
7319     ierr = PCBDDCMatISGetSubassemblingPattern(mat,&n_subdomains,0,&is_sends_internal,NULL);CHKERRQ(ierr);
7320   } else {
7321     ierr = PetscObjectReference((PetscObject)is_sends);CHKERRQ(ierr);
7322     is_sends_internal = is_sends;
7323   }
7324 
7325   /* get comm */
7326   ierr = PetscObjectGetComm((PetscObject)mat,&comm);CHKERRQ(ierr);
7327 
7328   /* compute number of sends */
7329   ierr = ISGetLocalSize(is_sends_internal,&i);CHKERRQ(ierr);
7330   ierr = PetscMPIIntCast(i,&n_sends);CHKERRQ(ierr);
7331 
7332   /* compute number of receives */
7333   ierr = MPI_Comm_size(comm,&commsize);CHKERRQ(ierr);
7334   ierr = PetscMalloc1(commsize,&iflags);CHKERRQ(ierr);
7335   ierr = PetscMemzero(iflags,commsize*sizeof(*iflags));CHKERRQ(ierr);
7336   ierr = ISGetIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7337   for (i=0;i<n_sends;i++) iflags[is_indices[i]] = 1;
7338   ierr = PetscGatherNumberOfMessages(comm,iflags,NULL,&n_recvs);CHKERRQ(ierr);
7339   ierr = PetscFree(iflags);CHKERRQ(ierr);
7340 
7341   /* restrict comm if requested */
7342   subcomm = 0;
7343   destroy_mat = PETSC_FALSE;
7344   if (restrict_comm) {
7345     PetscMPIInt color,subcommsize;
7346 
7347     color = 0;
7348     if (restrict_full) {
7349       if (!n_recvs) color = 1; /* processes not receiving anything will not partecipate in new comm (full restriction) */
7350     } else {
7351       if (!n_recvs && n_sends) color = 1; /* just those processes that are sending but not receiving anything will not partecipate in new comm */
7352     }
7353     ierr = MPIU_Allreduce(&color,&subcommsize,1,MPI_INT,MPI_SUM,comm);CHKERRQ(ierr);
7354     subcommsize = commsize - subcommsize;
7355     /* check if reuse has been requested */
7356     if (reuse) {
7357       if (*mat_n) {
7358         PetscMPIInt subcommsize2;
7359         ierr = MPI_Comm_size(PetscObjectComm((PetscObject)*mat_n),&subcommsize2);CHKERRQ(ierr);
7360         if (subcommsize != subcommsize2) SETERRQ2(PetscObjectComm((PetscObject)*mat_n),PETSC_ERR_PLIB,"Cannot reuse matrix! wrong subcomm size %d != %d",subcommsize,subcommsize2);
7361         comm_n = PetscObjectComm((PetscObject)*mat_n);
7362       } else {
7363         comm_n = PETSC_COMM_SELF;
7364       }
7365     } else { /* MAT_INITIAL_MATRIX */
7366       PetscMPIInt rank;
7367 
7368       ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
7369       ierr = PetscSubcommCreate(comm,&subcomm);CHKERRQ(ierr);
7370       ierr = PetscSubcommSetNumber(subcomm,2);CHKERRQ(ierr);
7371       ierr = PetscSubcommSetTypeGeneral(subcomm,color,rank);CHKERRQ(ierr);
7372       comm_n = PetscSubcommChild(subcomm);
7373     }
7374     /* flag to destroy *mat_n if not significative */
7375     if (color) destroy_mat = PETSC_TRUE;
7376   } else {
7377     comm_n = comm;
7378   }
7379 
7380   /* prepare send/receive buffers */
7381   ierr = PetscMalloc1(commsize,&ilengths_idxs);CHKERRQ(ierr);
7382   ierr = PetscMemzero(ilengths_idxs,commsize*sizeof(*ilengths_idxs));CHKERRQ(ierr);
7383   ierr = PetscMalloc1(commsize,&ilengths_vals);CHKERRQ(ierr);
7384   ierr = PetscMemzero(ilengths_vals,commsize*sizeof(*ilengths_vals));CHKERRQ(ierr);
7385   if (nis) {
7386     ierr = PetscCalloc1(commsize,&ilengths_idxs_is);CHKERRQ(ierr);
7387   }
7388 
7389   /* Get data from local matrices */
7390   if (!isdense) SETERRQ(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Subassembling of AIJ local matrices not yet implemented");
7391     /* TODO: See below some guidelines on how to prepare the local buffers */
7392     /*
7393        send_buffer_vals should contain the raw values of the local matrix
7394        send_buffer_idxs should contain:
7395        - MatType_PRIVATE type
7396        - PetscInt        size_of_l2gmap
7397        - PetscInt        global_row_indices[size_of_l2gmap]
7398        - PetscInt        all_other_info_which_is_needed_to_compute_preallocation_and_set_values
7399     */
7400   else {
7401     ierr = MatDenseGetArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7402     ierr = ISLocalToGlobalMappingGetSize(mat->rmap->mapping,&i);CHKERRQ(ierr);
7403     ierr = PetscMalloc1(i+2,&send_buffer_idxs);CHKERRQ(ierr);
7404     send_buffer_idxs[0] = (PetscInt)MATDENSE_PRIVATE;
7405     send_buffer_idxs[1] = i;
7406     ierr = ISLocalToGlobalMappingGetIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7407     ierr = PetscMemcpy(&send_buffer_idxs[2],ptr_idxs,i*sizeof(PetscInt));CHKERRQ(ierr);
7408     ierr = ISLocalToGlobalMappingRestoreIndices(mat->rmap->mapping,(const PetscInt**)&ptr_idxs);CHKERRQ(ierr);
7409     ierr = PetscMPIIntCast(i,&len);CHKERRQ(ierr);
7410     for (i=0;i<n_sends;i++) {
7411       ilengths_vals[is_indices[i]] = len*len;
7412       ilengths_idxs[is_indices[i]] = len+2;
7413     }
7414   }
7415   ierr = PetscGatherMessageLengths2(comm,n_sends,n_recvs,ilengths_idxs,ilengths_vals,&onodes,&olengths_idxs,&olengths_vals);CHKERRQ(ierr);
7416   /* additional is (if any) */
7417   if (nis) {
7418     PetscMPIInt psum;
7419     PetscInt j;
7420     for (j=0,psum=0;j<nis;j++) {
7421       PetscInt plen;
7422       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7423       ierr = PetscMPIIntCast(plen,&len);CHKERRQ(ierr);
7424       psum += len+1; /* indices + lenght */
7425     }
7426     ierr = PetscMalloc1(psum,&send_buffer_idxs_is);CHKERRQ(ierr);
7427     for (j=0,psum=0;j<nis;j++) {
7428       PetscInt plen;
7429       const PetscInt *is_array_idxs;
7430       ierr = ISGetLocalSize(isarray[j],&plen);CHKERRQ(ierr);
7431       send_buffer_idxs_is[psum] = plen;
7432       ierr = ISGetIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7433       ierr = PetscMemcpy(&send_buffer_idxs_is[psum+1],is_array_idxs,plen*sizeof(PetscInt));CHKERRQ(ierr);
7434       ierr = ISRestoreIndices(isarray[j],&is_array_idxs);CHKERRQ(ierr);
7435       psum += plen+1; /* indices + lenght */
7436     }
7437     for (i=0;i<n_sends;i++) {
7438       ilengths_idxs_is[is_indices[i]] = psum;
7439     }
7440     ierr = PetscGatherMessageLengths(comm,n_sends,n_recvs,ilengths_idxs_is,&onodes_is,&olengths_idxs_is);CHKERRQ(ierr);
7441   }
7442   ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7443 
7444   buf_size_idxs = 0;
7445   buf_size_vals = 0;
7446   buf_size_idxs_is = 0;
7447   buf_size_vecs = 0;
7448   for (i=0;i<n_recvs;i++) {
7449     buf_size_idxs += (PetscInt)olengths_idxs[i];
7450     buf_size_vals += (PetscInt)olengths_vals[i];
7451     if (nis) buf_size_idxs_is += (PetscInt)olengths_idxs_is[i];
7452     if (nvecs) buf_size_vecs += (PetscInt)olengths_idxs[i];
7453   }
7454   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs);CHKERRQ(ierr);
7455   ierr = PetscMalloc1(buf_size_vals,&recv_buffer_vals);CHKERRQ(ierr);
7456   ierr = PetscMalloc1(buf_size_idxs_is,&recv_buffer_idxs_is);CHKERRQ(ierr);
7457   ierr = PetscMalloc1(buf_size_vecs,&recv_buffer_vecs);CHKERRQ(ierr);
7458 
7459   /* get new tags for clean communications */
7460   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs);CHKERRQ(ierr);
7461   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vals);CHKERRQ(ierr);
7462   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_idxs_is);CHKERRQ(ierr);
7463   ierr = PetscObjectGetNewTag((PetscObject)mat,&tag_vecs);CHKERRQ(ierr);
7464 
7465   /* allocate for requests */
7466   ierr = PetscMalloc1(n_sends,&send_req_idxs);CHKERRQ(ierr);
7467   ierr = PetscMalloc1(n_sends,&send_req_vals);CHKERRQ(ierr);
7468   ierr = PetscMalloc1(n_sends,&send_req_idxs_is);CHKERRQ(ierr);
7469   ierr = PetscMalloc1(n_sends,&send_req_vecs);CHKERRQ(ierr);
7470   ierr = PetscMalloc1(n_recvs,&recv_req_idxs);CHKERRQ(ierr);
7471   ierr = PetscMalloc1(n_recvs,&recv_req_vals);CHKERRQ(ierr);
7472   ierr = PetscMalloc1(n_recvs,&recv_req_idxs_is);CHKERRQ(ierr);
7473   ierr = PetscMalloc1(n_recvs,&recv_req_vecs);CHKERRQ(ierr);
7474 
7475   /* communications */
7476   ptr_idxs = recv_buffer_idxs;
7477   ptr_vals = recv_buffer_vals;
7478   ptr_idxs_is = recv_buffer_idxs_is;
7479   ptr_vecs = recv_buffer_vecs;
7480   for (i=0;i<n_recvs;i++) {
7481     source_dest = onodes[i];
7482     ierr = MPI_Irecv(ptr_idxs,olengths_idxs[i],MPIU_INT,source_dest,tag_idxs,comm,&recv_req_idxs[i]);CHKERRQ(ierr);
7483     ierr = MPI_Irecv(ptr_vals,olengths_vals[i],MPIU_SCALAR,source_dest,tag_vals,comm,&recv_req_vals[i]);CHKERRQ(ierr);
7484     ptr_idxs += olengths_idxs[i];
7485     ptr_vals += olengths_vals[i];
7486     if (nis) {
7487       source_dest = onodes_is[i];
7488       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);
7489       ptr_idxs_is += olengths_idxs_is[i];
7490     }
7491     if (nvecs) {
7492       source_dest = onodes[i];
7493       ierr = MPI_Irecv(ptr_vecs,olengths_idxs[i]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&recv_req_vecs[i]);CHKERRQ(ierr);
7494       ptr_vecs += olengths_idxs[i]-2;
7495     }
7496   }
7497   for (i=0;i<n_sends;i++) {
7498     ierr = PetscMPIIntCast(is_indices[i],&source_dest);CHKERRQ(ierr);
7499     ierr = MPI_Isend(send_buffer_idxs,ilengths_idxs[source_dest],MPIU_INT,source_dest,tag_idxs,comm,&send_req_idxs[i]);CHKERRQ(ierr);
7500     ierr = MPI_Isend(send_buffer_vals,ilengths_vals[source_dest],MPIU_SCALAR,source_dest,tag_vals,comm,&send_req_vals[i]);CHKERRQ(ierr);
7501     if (nis) {
7502       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);
7503     }
7504     if (nvecs) {
7505       ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7506       ierr = MPI_Isend(send_buffer_vecs,ilengths_idxs[source_dest]-2,MPIU_SCALAR,source_dest,tag_vecs,comm,&send_req_vecs[i]);CHKERRQ(ierr);
7507     }
7508   }
7509   ierr = ISRestoreIndices(is_sends_internal,&is_indices);CHKERRQ(ierr);
7510   ierr = ISDestroy(&is_sends_internal);CHKERRQ(ierr);
7511 
7512   /* assemble new l2g map */
7513   ierr = MPI_Waitall(n_recvs,recv_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7514   ptr_idxs = recv_buffer_idxs;
7515   new_local_rows = 0;
7516   for (i=0;i<n_recvs;i++) {
7517     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7518     ptr_idxs += olengths_idxs[i];
7519   }
7520   ierr = PetscMalloc1(new_local_rows,&l2gmap_indices);CHKERRQ(ierr);
7521   ptr_idxs = recv_buffer_idxs;
7522   new_local_rows = 0;
7523   for (i=0;i<n_recvs;i++) {
7524     ierr = PetscMemcpy(&l2gmap_indices[new_local_rows],ptr_idxs+2,(*(ptr_idxs+1))*sizeof(PetscInt));CHKERRQ(ierr);
7525     new_local_rows += *(ptr_idxs+1); /* second element is the local size of the l2gmap */
7526     ptr_idxs += olengths_idxs[i];
7527   }
7528   ierr = PetscSortRemoveDupsInt(&new_local_rows,l2gmap_indices);CHKERRQ(ierr);
7529   ierr = ISLocalToGlobalMappingCreate(comm_n,1,new_local_rows,l2gmap_indices,PETSC_COPY_VALUES,&l2gmap);CHKERRQ(ierr);
7530   ierr = PetscFree(l2gmap_indices);CHKERRQ(ierr);
7531 
7532   /* infer new local matrix type from received local matrices type */
7533   /* currently if all local matrices are of type X, then the resulting matrix will be of type X, except for the dense case */
7534   /* 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) */
7535   if (n_recvs) {
7536     MatTypePrivate new_local_type_private = (MatTypePrivate)send_buffer_idxs[0];
7537     ptr_idxs = recv_buffer_idxs;
7538     for (i=0;i<n_recvs;i++) {
7539       if ((PetscInt)new_local_type_private != *ptr_idxs) {
7540         new_local_type_private = MATAIJ_PRIVATE;
7541         break;
7542       }
7543       ptr_idxs += olengths_idxs[i];
7544     }
7545     switch (new_local_type_private) {
7546       case MATDENSE_PRIVATE:
7547         new_local_type = MATSEQAIJ;
7548         bs = 1;
7549         break;
7550       case MATAIJ_PRIVATE:
7551         new_local_type = MATSEQAIJ;
7552         bs = 1;
7553         break;
7554       case MATBAIJ_PRIVATE:
7555         new_local_type = MATSEQBAIJ;
7556         break;
7557       case MATSBAIJ_PRIVATE:
7558         new_local_type = MATSEQSBAIJ;
7559         break;
7560       default:
7561         SETERRQ2(comm,PETSC_ERR_SUP,"Unsupported private type %d in %s",new_local_type_private,PETSC_FUNCTION_NAME);
7562         break;
7563     }
7564   } else { /* by default, new_local_type is seqaij */
7565     new_local_type = MATSEQAIJ;
7566     bs = 1;
7567   }
7568 
7569   /* create MATIS object if needed */
7570   if (!reuse) {
7571     ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
7572     ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7573   } else {
7574     /* it also destroys the local matrices */
7575     if (*mat_n) {
7576       ierr = MatSetLocalToGlobalMapping(*mat_n,l2gmap,l2gmap);CHKERRQ(ierr);
7577     } else { /* this is a fake object */
7578       ierr = MatCreateIS(comm_n,bs,PETSC_DECIDE,PETSC_DECIDE,rows,cols,l2gmap,NULL,mat_n);CHKERRQ(ierr);
7579     }
7580   }
7581   ierr = MatISGetLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7582   ierr = MatSetType(local_mat,new_local_type);CHKERRQ(ierr);
7583 
7584   ierr = MPI_Waitall(n_recvs,recv_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7585 
7586   /* Global to local map of received indices */
7587   ierr = PetscMalloc1(buf_size_idxs,&recv_buffer_idxs_local);CHKERRQ(ierr); /* needed for values insertion */
7588   ierr = ISGlobalToLocalMappingApply(l2gmap,IS_GTOLM_MASK,buf_size_idxs,recv_buffer_idxs,&i,recv_buffer_idxs_local);CHKERRQ(ierr);
7589   ierr = ISLocalToGlobalMappingDestroy(&l2gmap);CHKERRQ(ierr);
7590 
7591   /* restore attributes -> type of incoming data and its size */
7592   buf_size_idxs = 0;
7593   for (i=0;i<n_recvs;i++) {
7594     recv_buffer_idxs_local[buf_size_idxs] = recv_buffer_idxs[buf_size_idxs];
7595     recv_buffer_idxs_local[buf_size_idxs+1] = recv_buffer_idxs[buf_size_idxs+1];
7596     buf_size_idxs += (PetscInt)olengths_idxs[i];
7597   }
7598   ierr = PetscFree(recv_buffer_idxs);CHKERRQ(ierr);
7599 
7600   /* set preallocation */
7601   ierr = PetscObjectTypeCompare((PetscObject)local_mat,MATSEQDENSE,&newisdense);CHKERRQ(ierr);
7602   if (!newisdense) {
7603     PetscInt *new_local_nnz=0;
7604 
7605     ptr_idxs = recv_buffer_idxs_local;
7606     if (n_recvs) {
7607       ierr = PetscCalloc1(new_local_rows,&new_local_nnz);CHKERRQ(ierr);
7608     }
7609     for (i=0;i<n_recvs;i++) {
7610       PetscInt j;
7611       if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* preallocation provided for dense case only */
7612         for (j=0;j<*(ptr_idxs+1);j++) {
7613           new_local_nnz[*(ptr_idxs+2+j)] += *(ptr_idxs+1);
7614         }
7615       } else {
7616         /* TODO */
7617       }
7618       ptr_idxs += olengths_idxs[i];
7619     }
7620     if (new_local_nnz) {
7621       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMin(new_local_nnz[i],new_local_rows);
7622       ierr = MatSeqAIJSetPreallocation(local_mat,0,new_local_nnz);CHKERRQ(ierr);
7623       for (i=0;i<new_local_rows;i++) new_local_nnz[i] /= bs;
7624       ierr = MatSeqBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7625       for (i=0;i<new_local_rows;i++) new_local_nnz[i] = PetscMax(new_local_nnz[i]-i,0);
7626       ierr = MatSeqSBAIJSetPreallocation(local_mat,bs,0,new_local_nnz);CHKERRQ(ierr);
7627     } else {
7628       ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7629     }
7630     ierr = PetscFree(new_local_nnz);CHKERRQ(ierr);
7631   } else {
7632     ierr = MatSetUp(local_mat);CHKERRQ(ierr);
7633   }
7634 
7635   /* set values */
7636   ptr_vals = recv_buffer_vals;
7637   ptr_idxs = recv_buffer_idxs_local;
7638   for (i=0;i<n_recvs;i++) {
7639     if (*ptr_idxs == (PetscInt)MATDENSE_PRIVATE) { /* values insertion provided for dense case only */
7640       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
7641       ierr = MatSetValues(local_mat,*(ptr_idxs+1),ptr_idxs+2,*(ptr_idxs+1),ptr_idxs+2,ptr_vals,ADD_VALUES);CHKERRQ(ierr);
7642       ierr = MatAssemblyBegin(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7643       ierr = MatAssemblyEnd(local_mat,MAT_FLUSH_ASSEMBLY);CHKERRQ(ierr);
7644       ierr = MatSetOption(local_mat,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
7645     } else {
7646       /* TODO */
7647     }
7648     ptr_idxs += olengths_idxs[i];
7649     ptr_vals += olengths_vals[i];
7650   }
7651   ierr = MatAssemblyBegin(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7652   ierr = MatAssemblyEnd(local_mat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7653   ierr = MatISRestoreLocalMat(*mat_n,&local_mat);CHKERRQ(ierr);
7654   ierr = MatAssemblyBegin(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7655   ierr = MatAssemblyEnd(*mat_n,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7656   ierr = PetscFree(recv_buffer_vals);CHKERRQ(ierr);
7657 
7658 #if 0
7659   if (!restrict_comm) { /* check */
7660     Vec       lvec,rvec;
7661     PetscReal infty_error;
7662 
7663     ierr = MatCreateVecs(mat,&rvec,&lvec);CHKERRQ(ierr);
7664     ierr = VecSetRandom(rvec,NULL);CHKERRQ(ierr);
7665     ierr = MatMult(mat,rvec,lvec);CHKERRQ(ierr);
7666     ierr = VecScale(lvec,-1.0);CHKERRQ(ierr);
7667     ierr = MatMultAdd(*mat_n,rvec,lvec,lvec);CHKERRQ(ierr);
7668     ierr = VecNorm(lvec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
7669     ierr = PetscPrintf(PetscObjectComm((PetscObject)mat),"Infinity error subassembling %1.6e\n",infty_error);
7670     ierr = VecDestroy(&rvec);CHKERRQ(ierr);
7671     ierr = VecDestroy(&lvec);CHKERRQ(ierr);
7672   }
7673 #endif
7674 
7675   /* assemble new additional is (if any) */
7676   if (nis) {
7677     PetscInt **temp_idxs,*count_is,j,psum;
7678 
7679     ierr = MPI_Waitall(n_recvs,recv_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7680     ierr = PetscCalloc1(nis,&count_is);CHKERRQ(ierr);
7681     ptr_idxs = recv_buffer_idxs_is;
7682     psum = 0;
7683     for (i=0;i<n_recvs;i++) {
7684       for (j=0;j<nis;j++) {
7685         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7686         count_is[j] += plen; /* increment counting of buffer for j-th IS */
7687         psum += plen;
7688         ptr_idxs += plen+1; /* shift pointer to received data */
7689       }
7690     }
7691     ierr = PetscMalloc1(nis,&temp_idxs);CHKERRQ(ierr);
7692     ierr = PetscMalloc1(psum,&temp_idxs[0]);CHKERRQ(ierr);
7693     for (i=1;i<nis;i++) {
7694       temp_idxs[i] = temp_idxs[i-1]+count_is[i-1];
7695     }
7696     ierr = PetscMemzero(count_is,nis*sizeof(PetscInt));CHKERRQ(ierr);
7697     ptr_idxs = recv_buffer_idxs_is;
7698     for (i=0;i<n_recvs;i++) {
7699       for (j=0;j<nis;j++) {
7700         PetscInt plen = *(ptr_idxs); /* first element is the local size of IS's indices */
7701         ierr = PetscMemcpy(&temp_idxs[j][count_is[j]],ptr_idxs+1,plen*sizeof(PetscInt));CHKERRQ(ierr);
7702         count_is[j] += plen; /* increment starting point of buffer for j-th IS */
7703         ptr_idxs += plen+1; /* shift pointer to received data */
7704       }
7705     }
7706     for (i=0;i<nis;i++) {
7707       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7708       ierr = PetscSortRemoveDupsInt(&count_is[i],temp_idxs[i]);CHKERRQ(ierr);CHKERRQ(ierr);
7709       ierr = ISCreateGeneral(comm_n,count_is[i],temp_idxs[i],PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7710     }
7711     ierr = PetscFree(count_is);CHKERRQ(ierr);
7712     ierr = PetscFree(temp_idxs[0]);CHKERRQ(ierr);
7713     ierr = PetscFree(temp_idxs);CHKERRQ(ierr);
7714   }
7715   /* free workspace */
7716   ierr = PetscFree(recv_buffer_idxs_is);CHKERRQ(ierr);
7717   ierr = MPI_Waitall(n_sends,send_req_idxs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7718   ierr = PetscFree(send_buffer_idxs);CHKERRQ(ierr);
7719   ierr = MPI_Waitall(n_sends,send_req_vals,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7720   if (isdense) {
7721     ierr = MatISGetLocalMat(mat,&local_mat);CHKERRQ(ierr);
7722     ierr = MatDenseRestoreArray(local_mat,&send_buffer_vals);CHKERRQ(ierr);
7723     ierr = MatISRestoreLocalMat(mat,&local_mat);CHKERRQ(ierr);
7724   } else {
7725     /* ierr = PetscFree(send_buffer_vals);CHKERRQ(ierr); */
7726   }
7727   if (nis) {
7728     ierr = MPI_Waitall(n_sends,send_req_idxs_is,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7729     ierr = PetscFree(send_buffer_idxs_is);CHKERRQ(ierr);
7730   }
7731 
7732   if (nvecs) {
7733     ierr = MPI_Waitall(n_recvs,recv_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7734     ierr = MPI_Waitall(n_sends,send_req_vecs,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
7735     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7736     ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7737     ierr = VecCreate(comm_n,&nnsp_vec[0]);CHKERRQ(ierr);
7738     ierr = VecSetSizes(nnsp_vec[0],new_local_rows,PETSC_DECIDE);CHKERRQ(ierr);
7739     ierr = VecSetType(nnsp_vec[0],VECSTANDARD);CHKERRQ(ierr);
7740     /* set values */
7741     ptr_vals = recv_buffer_vecs;
7742     ptr_idxs = recv_buffer_idxs_local;
7743     ierr = VecGetArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7744     for (i=0;i<n_recvs;i++) {
7745       PetscInt j;
7746       for (j=0;j<*(ptr_idxs+1);j++) {
7747         send_buffer_vecs[*(ptr_idxs+2+j)] += *(ptr_vals + j);
7748       }
7749       ptr_idxs += olengths_idxs[i];
7750       ptr_vals += olengths_idxs[i]-2;
7751     }
7752     ierr = VecRestoreArray(nnsp_vec[0],&send_buffer_vecs);CHKERRQ(ierr);
7753     ierr = VecAssemblyBegin(nnsp_vec[0]);CHKERRQ(ierr);
7754     ierr = VecAssemblyEnd(nnsp_vec[0]);CHKERRQ(ierr);
7755   }
7756 
7757   ierr = PetscFree(recv_buffer_vecs);CHKERRQ(ierr);
7758   ierr = PetscFree(recv_buffer_idxs_local);CHKERRQ(ierr);
7759   ierr = PetscFree(recv_req_idxs);CHKERRQ(ierr);
7760   ierr = PetscFree(recv_req_vals);CHKERRQ(ierr);
7761   ierr = PetscFree(recv_req_vecs);CHKERRQ(ierr);
7762   ierr = PetscFree(recv_req_idxs_is);CHKERRQ(ierr);
7763   ierr = PetscFree(send_req_idxs);CHKERRQ(ierr);
7764   ierr = PetscFree(send_req_vals);CHKERRQ(ierr);
7765   ierr = PetscFree(send_req_vecs);CHKERRQ(ierr);
7766   ierr = PetscFree(send_req_idxs_is);CHKERRQ(ierr);
7767   ierr = PetscFree(ilengths_vals);CHKERRQ(ierr);
7768   ierr = PetscFree(ilengths_idxs);CHKERRQ(ierr);
7769   ierr = PetscFree(olengths_vals);CHKERRQ(ierr);
7770   ierr = PetscFree(olengths_idxs);CHKERRQ(ierr);
7771   ierr = PetscFree(onodes);CHKERRQ(ierr);
7772   if (nis) {
7773     ierr = PetscFree(ilengths_idxs_is);CHKERRQ(ierr);
7774     ierr = PetscFree(olengths_idxs_is);CHKERRQ(ierr);
7775     ierr = PetscFree(onodes_is);CHKERRQ(ierr);
7776   }
7777   ierr = PetscSubcommDestroy(&subcomm);CHKERRQ(ierr);
7778   if (destroy_mat) { /* destroy mat is true only if restrict comm is true and process will not partecipate */
7779     ierr = MatDestroy(mat_n);CHKERRQ(ierr);
7780     for (i=0;i<nis;i++) {
7781       ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
7782     }
7783     if (nvecs) { /* need to match VecDestroy nnsp_vec called in the other code path */
7784       ierr = VecDestroy(&nnsp_vec[0]);CHKERRQ(ierr);
7785     }
7786     *mat_n = NULL;
7787   }
7788   PetscFunctionReturn(0);
7789 }
7790 
7791 /* temporary hack into ksp private data structure */
7792 #include <petsc/private/kspimpl.h>
7793 
7794 PetscErrorCode PCBDDCSetUpCoarseSolver(PC pc,PetscScalar* coarse_submat_vals)
7795 {
7796   PC_BDDC                *pcbddc = (PC_BDDC*)pc->data;
7797   PC_IS                  *pcis = (PC_IS*)pc->data;
7798   Mat                    coarse_mat,coarse_mat_is,coarse_submat_dense;
7799   Mat                    coarsedivudotp = NULL;
7800   Mat                    coarseG,t_coarse_mat_is;
7801   MatNullSpace           CoarseNullSpace = NULL;
7802   ISLocalToGlobalMapping coarse_islg;
7803   IS                     coarse_is,*isarray;
7804   PetscInt               i,im_active=-1,active_procs=-1;
7805   PetscInt               nis,nisdofs,nisneu,nisvert;
7806   PC                     pc_temp;
7807   PCType                 coarse_pc_type;
7808   KSPType                coarse_ksp_type;
7809   PetscBool              multilevel_requested,multilevel_allowed;
7810   PetscBool              coarse_reuse;
7811   PetscInt               ncoarse,nedcfield;
7812   PetscBool              compute_vecs = PETSC_FALSE;
7813   PetscScalar            *array;
7814   MatReuse               coarse_mat_reuse;
7815   PetscBool              restr, full_restr, have_void;
7816   PetscMPIInt            commsize;
7817   PetscErrorCode         ierr;
7818 
7819   PetscFunctionBegin;
7820   /* Assign global numbering to coarse dofs */
7821   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 */
7822     PetscInt ocoarse_size;
7823     compute_vecs = PETSC_TRUE;
7824 
7825     pcbddc->new_primal_space = PETSC_TRUE;
7826     ocoarse_size = pcbddc->coarse_size;
7827     ierr = PetscFree(pcbddc->global_primal_indices);CHKERRQ(ierr);
7828     ierr = PCBDDCComputePrimalNumbering(pc,&pcbddc->coarse_size,&pcbddc->global_primal_indices);CHKERRQ(ierr);
7829     /* see if we can avoid some work */
7830     if (pcbddc->coarse_ksp) { /* coarse ksp has already been created */
7831       /* if the coarse size is different or we are using adaptive selection, better to not reuse the coarse matrix */
7832       if (ocoarse_size != pcbddc->coarse_size || pcbddc->adaptive_selection) {
7833         ierr = KSPReset(pcbddc->coarse_ksp);CHKERRQ(ierr);
7834         coarse_reuse = PETSC_FALSE;
7835       } else { /* we can safely reuse already computed coarse matrix */
7836         coarse_reuse = PETSC_TRUE;
7837       }
7838     } else { /* there's no coarse ksp, so we need to create the coarse matrix too */
7839       coarse_reuse = PETSC_FALSE;
7840     }
7841     /* reset any subassembling information */
7842     if (!coarse_reuse || pcbddc->recompute_topography) {
7843       ierr = ISDestroy(&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7844     }
7845   } else { /* primal space is unchanged, so we can reuse coarse matrix */
7846     coarse_reuse = PETSC_TRUE;
7847   }
7848   /* assemble coarse matrix */
7849   if (coarse_reuse && pcbddc->coarse_ksp) {
7850     ierr = KSPGetOperators(pcbddc->coarse_ksp,&coarse_mat,NULL);CHKERRQ(ierr);
7851     ierr = PetscObjectReference((PetscObject)coarse_mat);CHKERRQ(ierr);
7852     coarse_mat_reuse = MAT_REUSE_MATRIX;
7853   } else {
7854     coarse_mat = NULL;
7855     coarse_mat_reuse = MAT_INITIAL_MATRIX;
7856   }
7857 
7858   /* creates temporary l2gmap and IS for coarse indexes */
7859   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),pcbddc->local_primal_size,pcbddc->global_primal_indices,PETSC_COPY_VALUES,&coarse_is);CHKERRQ(ierr);
7860   ierr = ISLocalToGlobalMappingCreateIS(coarse_is,&coarse_islg);CHKERRQ(ierr);
7861 
7862   /* creates temporary MATIS object for coarse matrix */
7863   ierr = MatCreateSeqDense(PETSC_COMM_SELF,pcbddc->local_primal_size,pcbddc->local_primal_size,NULL,&coarse_submat_dense);CHKERRQ(ierr);
7864   ierr = MatDenseGetArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7865   ierr = PetscMemcpy(array,coarse_submat_vals,sizeof(*coarse_submat_vals)*pcbddc->local_primal_size*pcbddc->local_primal_size);CHKERRQ(ierr);
7866   ierr = MatDenseRestoreArray(coarse_submat_dense,&array);CHKERRQ(ierr);
7867   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);
7868   ierr = MatISSetLocalMat(t_coarse_mat_is,coarse_submat_dense);CHKERRQ(ierr);
7869   ierr = MatAssemblyBegin(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7870   ierr = MatAssemblyEnd(t_coarse_mat_is,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
7871   ierr = MatDestroy(&coarse_submat_dense);CHKERRQ(ierr);
7872 
7873   /* count "active" (i.e. with positive local size) and "void" processes */
7874   im_active = !!(pcis->n);
7875   ierr = MPIU_Allreduce(&im_active,&active_procs,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7876 
7877   /* determine number of processes partecipating to coarse solver and compute subassembling pattern */
7878   /* restr : whether if we want to exclude senders (which are not receivers) from the subassembling pattern */
7879   /* full_restr : just use the receivers from the subassembling pattern */
7880   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)pc),&commsize);CHKERRQ(ierr);
7881   coarse_mat_is = NULL;
7882   multilevel_allowed = PETSC_FALSE;
7883   multilevel_requested = PETSC_FALSE;
7884   pcbddc->coarse_eqs_per_proc = PetscMin(PetscMax(pcbddc->coarse_size,1),pcbddc->coarse_eqs_per_proc);
7885   if (pcbddc->current_level < pcbddc->max_levels) multilevel_requested = PETSC_TRUE;
7886   if (multilevel_requested) {
7887     ncoarse = active_procs/pcbddc->coarsening_ratio;
7888     restr = PETSC_FALSE;
7889     full_restr = PETSC_FALSE;
7890   } else {
7891     ncoarse = pcbddc->coarse_size/pcbddc->coarse_eqs_per_proc;
7892     restr = PETSC_TRUE;
7893     full_restr = PETSC_TRUE;
7894   }
7895   if (!pcbddc->coarse_size || commsize == 1) multilevel_allowed = multilevel_requested = restr = full_restr = PETSC_FALSE;
7896   ncoarse = PetscMax(1,ncoarse);
7897   if (!pcbddc->coarse_subassembling) {
7898     if (pcbddc->coarsening_ratio > 1) {
7899       if (multilevel_requested) {
7900         ierr = PCBDDCMatISGetSubassemblingPattern(pc->pmat,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7901       } else {
7902         ierr = PCBDDCMatISGetSubassemblingPattern(t_coarse_mat_is,&ncoarse,pcbddc->coarse_adj_red,&pcbddc->coarse_subassembling,&have_void);CHKERRQ(ierr);
7903       }
7904     } else {
7905       PetscMPIInt rank;
7906       ierr = MPI_Comm_rank(PetscObjectComm((PetscObject)pc),&rank);CHKERRQ(ierr);
7907       have_void = (active_procs == (PetscInt)commsize) ? PETSC_FALSE : PETSC_TRUE;
7908       ierr = ISCreateStride(PetscObjectComm((PetscObject)pc),1,rank,1,&pcbddc->coarse_subassembling);CHKERRQ(ierr);
7909     }
7910   } else { /* if a subassembling pattern exists, then we can reuse the coarse ksp and compute the number of process involved */
7911     PetscInt    psum;
7912     if (pcbddc->coarse_ksp) psum = 1;
7913     else psum = 0;
7914     ierr = MPIU_Allreduce(&psum,&ncoarse,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
7915     if (ncoarse < commsize) have_void = PETSC_TRUE;
7916   }
7917   /* determine if we can go multilevel */
7918   if (multilevel_requested) {
7919     if (ncoarse > 1) multilevel_allowed = PETSC_TRUE; /* found enough processes */
7920     else restr = full_restr = PETSC_TRUE; /* 1 subdomain, use a direct solver */
7921   }
7922   if (multilevel_allowed && have_void) restr = PETSC_TRUE;
7923 
7924   /* dump subassembling pattern */
7925   if (pcbddc->dbg_flag && multilevel_allowed) {
7926     ierr = ISView(pcbddc->coarse_subassembling,pcbddc->dbg_viewer);CHKERRQ(ierr);
7927   }
7928 
7929   /* compute dofs splitting and neumann boundaries for coarse dofs */
7930   nedcfield = -1;
7931   if (multilevel_allowed && !coarse_reuse && (pcbddc->n_ISForDofsLocal || pcbddc->NeumannBoundariesLocal || pcbddc->nedclocal)) { /* protects from unneded computations */
7932     PetscInt               *tidxs,*tidxs2,nout,tsize,i;
7933     const PetscInt         *idxs;
7934     ISLocalToGlobalMapping tmap;
7935 
7936     /* create map between primal indices (in local representative ordering) and local primal numbering */
7937     ierr = ISLocalToGlobalMappingCreate(PETSC_COMM_SELF,1,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,PETSC_COPY_VALUES,&tmap);CHKERRQ(ierr);
7938     /* allocate space for temporary storage */
7939     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs);CHKERRQ(ierr);
7940     ierr = PetscMalloc1(pcbddc->local_primal_size,&tidxs2);CHKERRQ(ierr);
7941     /* allocate for IS array */
7942     nisdofs = pcbddc->n_ISForDofsLocal;
7943     if (pcbddc->nedclocal) {
7944       if (pcbddc->nedfield > -1) {
7945         nedcfield = pcbddc->nedfield;
7946       } else {
7947         nedcfield = 0;
7948         if (nisdofs) SETERRQ1(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"This should not happen (%d)",nisdofs);
7949         nisdofs = 1;
7950       }
7951     }
7952     nisneu = !!pcbddc->NeumannBoundariesLocal;
7953     nisvert = 0; /* nisvert is not used */
7954     nis = nisdofs + nisneu + nisvert;
7955     ierr = PetscMalloc1(nis,&isarray);CHKERRQ(ierr);
7956     /* dofs splitting */
7957     for (i=0;i<nisdofs;i++) {
7958       /* ierr = ISView(pcbddc->ISForDofsLocal[i],0);CHKERRQ(ierr); */
7959       if (nedcfield != i) {
7960         ierr = ISGetLocalSize(pcbddc->ISForDofsLocal[i],&tsize);CHKERRQ(ierr);
7961         ierr = ISGetIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7962         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7963         ierr = ISRestoreIndices(pcbddc->ISForDofsLocal[i],&idxs);CHKERRQ(ierr);
7964       } else {
7965         ierr = ISGetLocalSize(pcbddc->nedclocal,&tsize);CHKERRQ(ierr);
7966         ierr = ISGetIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7967         ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7968         if (tsize != nout) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Failed when mapping coarse nedelec field! %d != %d\n",tsize,nout);
7969         ierr = ISRestoreIndices(pcbddc->nedclocal,&idxs);CHKERRQ(ierr);
7970       }
7971       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7972       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[i]);CHKERRQ(ierr);
7973       /* ierr = ISView(isarray[i],0);CHKERRQ(ierr); */
7974     }
7975     /* neumann boundaries */
7976     if (pcbddc->NeumannBoundariesLocal) {
7977       /* ierr = ISView(pcbddc->NeumannBoundariesLocal,0);CHKERRQ(ierr); */
7978       ierr = ISGetLocalSize(pcbddc->NeumannBoundariesLocal,&tsize);CHKERRQ(ierr);
7979       ierr = ISGetIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7980       ierr = ISGlobalToLocalMappingApply(tmap,IS_GTOLM_DROP,tsize,idxs,&nout,tidxs);CHKERRQ(ierr);
7981       ierr = ISRestoreIndices(pcbddc->NeumannBoundariesLocal,&idxs);CHKERRQ(ierr);
7982       ierr = ISLocalToGlobalMappingApply(coarse_islg,nout,tidxs,tidxs2);CHKERRQ(ierr);
7983       ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),nout,tidxs2,PETSC_COPY_VALUES,&isarray[nisdofs]);CHKERRQ(ierr);
7984       /* ierr = ISView(isarray[nisdofs],0);CHKERRQ(ierr); */
7985     }
7986     /* free memory */
7987     ierr = PetscFree(tidxs);CHKERRQ(ierr);
7988     ierr = PetscFree(tidxs2);CHKERRQ(ierr);
7989     ierr = ISLocalToGlobalMappingDestroy(&tmap);CHKERRQ(ierr);
7990   } else {
7991     nis = 0;
7992     nisdofs = 0;
7993     nisneu = 0;
7994     nisvert = 0;
7995     isarray = NULL;
7996   }
7997   /* destroy no longer needed map */
7998   ierr = ISLocalToGlobalMappingDestroy(&coarse_islg);CHKERRQ(ierr);
7999 
8000   /* subassemble */
8001   if (multilevel_allowed) {
8002     Vec       vp[1];
8003     PetscInt  nvecs = 0;
8004     PetscBool reuse,reuser;
8005 
8006     if (coarse_mat) reuse = PETSC_TRUE;
8007     else reuse = PETSC_FALSE;
8008     ierr = MPIU_Allreduce(&reuse,&reuser,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8009     vp[0] = NULL;
8010     if (pcbddc->benign_have_null) { /* propagate no-net-flux quadrature to coarser level */
8011       ierr = VecCreate(PetscObjectComm((PetscObject)pc),&vp[0]);CHKERRQ(ierr);
8012       ierr = VecSetSizes(vp[0],pcbddc->local_primal_size,PETSC_DECIDE);CHKERRQ(ierr);
8013       ierr = VecSetType(vp[0],VECSTANDARD);CHKERRQ(ierr);
8014       nvecs = 1;
8015 
8016       if (pcbddc->divudotp) {
8017         Mat      B,loc_divudotp;
8018         Vec      v,p;
8019         IS       dummy;
8020         PetscInt np;
8021 
8022         ierr = MatISGetLocalMat(pcbddc->divudotp,&loc_divudotp);CHKERRQ(ierr);
8023         ierr = MatGetSize(loc_divudotp,&np,NULL);CHKERRQ(ierr);
8024         ierr = ISCreateStride(PETSC_COMM_SELF,np,0,1,&dummy);CHKERRQ(ierr);
8025         ierr = MatCreateSubMatrix(loc_divudotp,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B);CHKERRQ(ierr);
8026         ierr = MatCreateVecs(B,&v,&p);CHKERRQ(ierr);
8027         ierr = VecSet(p,1.);CHKERRQ(ierr);
8028         ierr = MatMultTranspose(B,p,v);CHKERRQ(ierr);
8029         ierr = VecDestroy(&p);CHKERRQ(ierr);
8030         ierr = MatDestroy(&B);CHKERRQ(ierr);
8031         ierr = VecGetArray(vp[0],&array);CHKERRQ(ierr);
8032         ierr = VecPlaceArray(pcbddc->vec1_P,array);CHKERRQ(ierr);
8033         ierr = VecRestoreArray(vp[0],&array);CHKERRQ(ierr);
8034         ierr = MatMultTranspose(pcbddc->coarse_phi_B,v,pcbddc->vec1_P);CHKERRQ(ierr);
8035         ierr = VecResetArray(pcbddc->vec1_P);CHKERRQ(ierr);
8036         ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8037         ierr = VecDestroy(&v);CHKERRQ(ierr);
8038       }
8039     }
8040     if (reuser) {
8041       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_TRUE,&coarse_mat,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8042     } else {
8043       ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,nis,isarray,nvecs,vp);CHKERRQ(ierr);
8044     }
8045     if (vp[0]) { /* vp[0] could have been placed on a different set of processes */
8046       PetscScalar *arraym,*arrayv;
8047       PetscInt    nl;
8048       ierr = VecGetLocalSize(vp[0],&nl);CHKERRQ(ierr);
8049       ierr = MatCreateSeqDense(PETSC_COMM_SELF,1,nl,NULL,&coarsedivudotp);CHKERRQ(ierr);
8050       ierr = MatDenseGetArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8051       ierr = VecGetArray(vp[0],&arrayv);CHKERRQ(ierr);
8052       ierr = PetscMemcpy(arraym,arrayv,nl*sizeof(PetscScalar));CHKERRQ(ierr);
8053       ierr = VecRestoreArray(vp[0],&arrayv);CHKERRQ(ierr);
8054       ierr = MatDenseRestoreArray(coarsedivudotp,&arraym);CHKERRQ(ierr);
8055       ierr = VecDestroy(&vp[0]);CHKERRQ(ierr);
8056     } else {
8057       ierr = MatCreateSeqAIJ(PETSC_COMM_SELF,0,0,1,NULL,&coarsedivudotp);CHKERRQ(ierr);
8058     }
8059   } else {
8060     ierr = PCBDDCMatISSubassemble(t_coarse_mat_is,pcbddc->coarse_subassembling,0,restr,full_restr,PETSC_FALSE,&coarse_mat_is,0,NULL,0,NULL);CHKERRQ(ierr);
8061   }
8062   if (coarse_mat_is || coarse_mat) {
8063     PetscMPIInt size;
8064     ierr = MPI_Comm_size(PetscObjectComm((PetscObject)coarse_mat_is),&size);CHKERRQ(ierr);
8065     if (!multilevel_allowed) {
8066       ierr = MatConvert(coarse_mat_is,MATAIJ,coarse_mat_reuse,&coarse_mat);CHKERRQ(ierr);
8067     } else {
8068       Mat A;
8069 
8070       /* if this matrix is present, it means we are not reusing the coarse matrix */
8071       if (coarse_mat_is) {
8072         if (coarse_mat) SETERRQ(PetscObjectComm((PetscObject)coarse_mat_is),PETSC_ERR_PLIB,"This should not happen");
8073         ierr = PetscObjectReference((PetscObject)coarse_mat_is);CHKERRQ(ierr);
8074         coarse_mat = coarse_mat_is;
8075       }
8076       /* be sure we don't have MatSeqDENSE as local mat */
8077       ierr = MatISGetLocalMat(coarse_mat,&A);CHKERRQ(ierr);
8078       ierr = MatConvert(A,MATSEQAIJ,MAT_INPLACE_MATRIX,&A);CHKERRQ(ierr);
8079     }
8080   }
8081   ierr = MatDestroy(&t_coarse_mat_is);CHKERRQ(ierr);
8082   ierr = MatDestroy(&coarse_mat_is);CHKERRQ(ierr);
8083 
8084   /* create local to global scatters for coarse problem */
8085   if (compute_vecs) {
8086     PetscInt lrows;
8087     ierr = VecDestroy(&pcbddc->coarse_vec);CHKERRQ(ierr);
8088     if (coarse_mat) {
8089       ierr = MatGetLocalSize(coarse_mat,&lrows,NULL);CHKERRQ(ierr);
8090     } else {
8091       lrows = 0;
8092     }
8093     ierr = VecCreate(PetscObjectComm((PetscObject)pc),&pcbddc->coarse_vec);CHKERRQ(ierr);
8094     ierr = VecSetSizes(pcbddc->coarse_vec,lrows,PETSC_DECIDE);CHKERRQ(ierr);
8095     ierr = VecSetType(pcbddc->coarse_vec,VECSTANDARD);CHKERRQ(ierr);
8096     ierr = VecScatterDestroy(&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8097     ierr = VecScatterCreate(pcbddc->vec1_P,NULL,pcbddc->coarse_vec,coarse_is,&pcbddc->coarse_loc_to_glob);CHKERRQ(ierr);
8098   }
8099   ierr = ISDestroy(&coarse_is);CHKERRQ(ierr);
8100 
8101   /* set defaults for coarse KSP and PC */
8102   if (multilevel_allowed) {
8103     coarse_ksp_type = KSPRICHARDSON;
8104     coarse_pc_type = PCBDDC;
8105   } else {
8106     coarse_ksp_type = KSPPREONLY;
8107     coarse_pc_type = PCREDUNDANT;
8108   }
8109 
8110   /* print some info if requested */
8111   if (pcbddc->dbg_flag) {
8112     if (!multilevel_allowed) {
8113       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8114       if (multilevel_requested) {
8115         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);
8116       } else if (pcbddc->max_levels) {
8117         ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Maximum number of requested levels reached (%d)\n",pcbddc->max_levels);CHKERRQ(ierr);
8118       }
8119       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8120     }
8121   }
8122 
8123   /* communicate coarse discrete gradient */
8124   coarseG = NULL;
8125   if (pcbddc->nedcG && multilevel_allowed) {
8126     MPI_Comm ccomm;
8127     if (coarse_mat) {
8128       ccomm = PetscObjectComm((PetscObject)coarse_mat);
8129     } else {
8130       ccomm = MPI_COMM_NULL;
8131     }
8132     ierr = MatMPIAIJRestrict(pcbddc->nedcG,ccomm,&coarseG);CHKERRQ(ierr);
8133   }
8134 
8135   /* create the coarse KSP object only once with defaults */
8136   if (coarse_mat) {
8137     PetscBool   isredundant,isnn,isbddc;
8138     PetscViewer dbg_viewer = NULL;
8139 
8140     if (pcbddc->dbg_flag) {
8141       dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)coarse_mat));
8142       ierr = PetscViewerASCIIAddTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8143     }
8144     if (!pcbddc->coarse_ksp) {
8145       char   prefix[256],str_level[16];
8146       size_t len;
8147 
8148       ierr = KSPCreate(PetscObjectComm((PetscObject)coarse_mat),&pcbddc->coarse_ksp);CHKERRQ(ierr);
8149       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8150       ierr = PetscObjectIncrementTabLevel((PetscObject)pcbddc->coarse_ksp,(PetscObject)pc,1);CHKERRQ(ierr);
8151       ierr = KSPSetTolerances(pcbddc->coarse_ksp,PETSC_DEFAULT,PETSC_DEFAULT,PETSC_DEFAULT,1);CHKERRQ(ierr);
8152       ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8153       ierr = KSPSetType(pcbddc->coarse_ksp,coarse_ksp_type);CHKERRQ(ierr);
8154       ierr = KSPSetNormType(pcbddc->coarse_ksp,KSP_NORM_NONE);CHKERRQ(ierr);
8155       ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8156       /* TODO is this logic correct? should check for coarse_mat type */
8157       ierr = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8158       /* prefix */
8159       ierr = PetscStrcpy(prefix,"");CHKERRQ(ierr);
8160       ierr = PetscStrcpy(str_level,"");CHKERRQ(ierr);
8161       if (!pcbddc->current_level) {
8162         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,sizeof(prefix));CHKERRQ(ierr);
8163         ierr = PetscStrlcat(prefix,"pc_bddc_coarse_",sizeof(prefix));CHKERRQ(ierr);
8164       } else {
8165         ierr = PetscStrlen(((PetscObject)pc)->prefix,&len);CHKERRQ(ierr);
8166         if (pcbddc->current_level>1) len -= 3; /* remove "lX_" with X level number */
8167         if (pcbddc->current_level>10) len -= 1; /* remove another char from level number */
8168         /* Nonstandard use of PetscStrncpy() to copy only a portion of the string */
8169         ierr = PetscStrncpy(prefix,((PetscObject)pc)->prefix,len+1);CHKERRQ(ierr);
8170         ierr = PetscSNPrintf(str_level,sizeof(str_level),"l%d_",(int)(pcbddc->current_level));CHKERRQ(ierr);
8171         ierr = PetscStrlcat(prefix,str_level,sizeof(prefix));CHKERRQ(ierr);
8172       }
8173       ierr = KSPSetOptionsPrefix(pcbddc->coarse_ksp,prefix);CHKERRQ(ierr);
8174       /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8175       ierr = PCBDDCSetLevel(pc_temp,pcbddc->current_level+1);CHKERRQ(ierr);
8176       ierr = PCBDDCSetCoarseningRatio(pc_temp,pcbddc->coarsening_ratio);CHKERRQ(ierr);
8177       ierr = PCBDDCSetLevels(pc_temp,pcbddc->max_levels);CHKERRQ(ierr);
8178       /* allow user customization */
8179       ierr = KSPSetFromOptions(pcbddc->coarse_ksp);CHKERRQ(ierr);
8180     }
8181     /* propagate BDDC info to the next level (these are dummy calls if pc_temp is not of type PCBDDC) */
8182     ierr = KSPGetPC(pcbddc->coarse_ksp,&pc_temp);CHKERRQ(ierr);
8183     if (nisdofs) {
8184       ierr = PCBDDCSetDofsSplitting(pc_temp,nisdofs,isarray);CHKERRQ(ierr);
8185       for (i=0;i<nisdofs;i++) {
8186         ierr = ISDestroy(&isarray[i]);CHKERRQ(ierr);
8187       }
8188     }
8189     if (nisneu) {
8190       ierr = PCBDDCSetNeumannBoundaries(pc_temp,isarray[nisdofs]);CHKERRQ(ierr);
8191       ierr = ISDestroy(&isarray[nisdofs]);CHKERRQ(ierr);
8192     }
8193     if (nisvert) {
8194       ierr = PCBDDCSetPrimalVerticesIS(pc_temp,isarray[nis-1]);CHKERRQ(ierr);
8195       ierr = ISDestroy(&isarray[nis-1]);CHKERRQ(ierr);
8196     }
8197     if (coarseG) {
8198       ierr = PCBDDCSetDiscreteGradient(pc_temp,coarseG,1,nedcfield,PETSC_FALSE,PETSC_TRUE);CHKERRQ(ierr);
8199     }
8200 
8201     /* get some info after set from options */
8202     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8203     /* multilevel can only be requested via -pc_bddc_levels or PCBDDCSetLevels */
8204     if (isbddc && !multilevel_allowed) {
8205       ierr   = PCSetType(pc_temp,coarse_pc_type);CHKERRQ(ierr);
8206       isbddc = PETSC_FALSE;
8207     }
8208     /* multilevel cannot be done with coarse PCs different from BDDC or NN */
8209     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCNN,&isnn);CHKERRQ(ierr);
8210     if (multilevel_requested && multilevel_allowed && !isbddc && !isnn) {
8211       ierr   = PCSetType(pc_temp,PCBDDC);CHKERRQ(ierr);
8212       isbddc = PETSC_TRUE;
8213     }
8214     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCREDUNDANT,&isredundant);CHKERRQ(ierr);
8215     if (isredundant) {
8216       KSP inner_ksp;
8217       PC  inner_pc;
8218 
8219       ierr = PCRedundantGetKSP(pc_temp,&inner_ksp);CHKERRQ(ierr);
8220       ierr = KSPGetPC(inner_ksp,&inner_pc);CHKERRQ(ierr);
8221     }
8222 
8223     /* parameters which miss an API */
8224     ierr = PetscObjectTypeCompare((PetscObject)pc_temp,PCBDDC,&isbddc);CHKERRQ(ierr);
8225     if (isbddc) {
8226       PC_BDDC* pcbddc_coarse = (PC_BDDC*)pc_temp->data;
8227 
8228       pcbddc_coarse->detect_disconnected = PETSC_TRUE;
8229       pcbddc_coarse->coarse_eqs_per_proc = pcbddc->coarse_eqs_per_proc;
8230       pcbddc_coarse->benign_saddle_point = pcbddc->benign_have_null;
8231       if (pcbddc_coarse->benign_saddle_point) {
8232         Mat                    coarsedivudotp_is;
8233         ISLocalToGlobalMapping l2gmap,rl2g,cl2g;
8234         IS                     row,col;
8235         const PetscInt         *gidxs;
8236         PetscInt               n,st,M,N;
8237 
8238         ierr = MatGetSize(coarsedivudotp,&n,NULL);CHKERRQ(ierr);
8239         ierr = MPI_Scan(&n,&st,1,MPIU_INT,MPI_SUM,PetscObjectComm((PetscObject)coarse_mat));CHKERRQ(ierr);
8240         st   = st-n;
8241         ierr = ISCreateStride(PetscObjectComm((PetscObject)coarse_mat),1,st,1,&row);CHKERRQ(ierr);
8242         ierr = MatGetLocalToGlobalMapping(coarse_mat,&l2gmap,NULL);CHKERRQ(ierr);
8243         ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
8244         ierr = ISLocalToGlobalMappingGetIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8245         ierr = ISCreateGeneral(PetscObjectComm((PetscObject)coarse_mat),n,gidxs,PETSC_COPY_VALUES,&col);CHKERRQ(ierr);
8246         ierr = ISLocalToGlobalMappingRestoreIndices(l2gmap,&gidxs);CHKERRQ(ierr);
8247         ierr = ISLocalToGlobalMappingCreateIS(row,&rl2g);CHKERRQ(ierr);
8248         ierr = ISLocalToGlobalMappingCreateIS(col,&cl2g);CHKERRQ(ierr);
8249         ierr = ISGetSize(row,&M);CHKERRQ(ierr);
8250         ierr = MatGetSize(coarse_mat,&N,NULL);CHKERRQ(ierr);
8251         ierr = ISDestroy(&row);CHKERRQ(ierr);
8252         ierr = ISDestroy(&col);CHKERRQ(ierr);
8253         ierr = MatCreate(PetscObjectComm((PetscObject)coarse_mat),&coarsedivudotp_is);CHKERRQ(ierr);
8254         ierr = MatSetType(coarsedivudotp_is,MATIS);CHKERRQ(ierr);
8255         ierr = MatSetSizes(coarsedivudotp_is,PETSC_DECIDE,PETSC_DECIDE,M,N);CHKERRQ(ierr);
8256         ierr = MatSetLocalToGlobalMapping(coarsedivudotp_is,rl2g,cl2g);CHKERRQ(ierr);
8257         ierr = ISLocalToGlobalMappingDestroy(&rl2g);CHKERRQ(ierr);
8258         ierr = ISLocalToGlobalMappingDestroy(&cl2g);CHKERRQ(ierr);
8259         ierr = MatISSetLocalMat(coarsedivudotp_is,coarsedivudotp);CHKERRQ(ierr);
8260         ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8261         ierr = PCBDDCSetDivergenceMat(pc_temp,coarsedivudotp_is,PETSC_FALSE,NULL);CHKERRQ(ierr);
8262         ierr = MatDestroy(&coarsedivudotp_is);CHKERRQ(ierr);
8263         pcbddc_coarse->adaptive_userdefined = PETSC_TRUE;
8264         if (pcbddc->adaptive_threshold[0] == 0.0) pcbddc_coarse->deluxe_zerorows = PETSC_TRUE;
8265       }
8266     }
8267 
8268     /* propagate symmetry info of coarse matrix */
8269     ierr = MatSetOption(coarse_mat,MAT_STRUCTURALLY_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
8270     if (pc->pmat->symmetric_set) {
8271       ierr = MatSetOption(coarse_mat,MAT_SYMMETRIC,pc->pmat->symmetric);CHKERRQ(ierr);
8272     }
8273     if (pc->pmat->hermitian_set) {
8274       ierr = MatSetOption(coarse_mat,MAT_HERMITIAN,pc->pmat->hermitian);CHKERRQ(ierr);
8275     }
8276     if (pc->pmat->spd_set) {
8277       ierr = MatSetOption(coarse_mat,MAT_SPD,pc->pmat->spd);CHKERRQ(ierr);
8278     }
8279     if (pcbddc->benign_saddle_point && !pcbddc->benign_have_null) {
8280       ierr = MatSetOption(coarse_mat,MAT_SPD,PETSC_TRUE);CHKERRQ(ierr);
8281     }
8282     /* set operators */
8283     ierr = MatViewFromOptions(coarse_mat,(PetscObject)pc,"-pc_bddc_coarse_mat_view");CHKERRQ(ierr);
8284     ierr = KSPSetOperators(pcbddc->coarse_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8285     if (pcbddc->dbg_flag) {
8286       ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*pcbddc->current_level);CHKERRQ(ierr);
8287     }
8288   }
8289   ierr = MatDestroy(&coarseG);CHKERRQ(ierr);
8290   ierr = PetscFree(isarray);CHKERRQ(ierr);
8291 #if 0
8292   {
8293     PetscViewer viewer;
8294     char filename[256];
8295     sprintf(filename,"coarse_mat_level%d.m",pcbddc->current_level);
8296     ierr = PetscViewerASCIIOpen(PetscObjectComm((PetscObject)coarse_mat),filename,&viewer);CHKERRQ(ierr);
8297     ierr = PetscViewerPushFormat(viewer,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr);
8298     ierr = MatView(coarse_mat,viewer);CHKERRQ(ierr);
8299     ierr = PetscViewerPopFormat(viewer);CHKERRQ(ierr);
8300     ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr);
8301   }
8302 #endif
8303 
8304   if (pcbddc->coarse_ksp) {
8305     Vec crhs,csol;
8306 
8307     ierr = KSPGetSolution(pcbddc->coarse_ksp,&csol);CHKERRQ(ierr);
8308     ierr = KSPGetRhs(pcbddc->coarse_ksp,&crhs);CHKERRQ(ierr);
8309     if (!csol) {
8310       ierr = MatCreateVecs(coarse_mat,&((pcbddc->coarse_ksp)->vec_sol),NULL);CHKERRQ(ierr);
8311     }
8312     if (!crhs) {
8313       ierr = MatCreateVecs(coarse_mat,NULL,&((pcbddc->coarse_ksp)->vec_rhs));CHKERRQ(ierr);
8314     }
8315   }
8316   ierr = MatDestroy(&coarsedivudotp);CHKERRQ(ierr);
8317 
8318   /* compute null space for coarse solver if the benign trick has been requested */
8319   if (pcbddc->benign_null) {
8320 
8321     ierr = VecSet(pcbddc->vec1_P,0.);CHKERRQ(ierr);
8322     for (i=0;i<pcbddc->benign_n;i++) {
8323       ierr = VecSetValue(pcbddc->vec1_P,pcbddc->local_primal_size-pcbddc->benign_n+i,1.0,INSERT_VALUES);CHKERRQ(ierr);
8324     }
8325     ierr = VecAssemblyBegin(pcbddc->vec1_P);CHKERRQ(ierr);
8326     ierr = VecAssemblyEnd(pcbddc->vec1_P);CHKERRQ(ierr);
8327     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8328     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8329     if (coarse_mat) {
8330       Vec         nullv;
8331       PetscScalar *array,*array2;
8332       PetscInt    nl;
8333 
8334       ierr = MatCreateVecs(coarse_mat,&nullv,NULL);CHKERRQ(ierr);
8335       ierr = VecGetLocalSize(nullv,&nl);CHKERRQ(ierr);
8336       ierr = VecGetArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8337       ierr = VecGetArray(nullv,&array2);CHKERRQ(ierr);
8338       ierr = PetscMemcpy(array2,array,nl*sizeof(*array));CHKERRQ(ierr);
8339       ierr = VecRestoreArray(nullv,&array2);CHKERRQ(ierr);
8340       ierr = VecRestoreArrayRead(pcbddc->coarse_vec,(const PetscScalar**)&array);CHKERRQ(ierr);
8341       ierr = VecNormalize(nullv,NULL);CHKERRQ(ierr);
8342       ierr = MatNullSpaceCreate(PetscObjectComm((PetscObject)coarse_mat),PETSC_FALSE,1,&nullv,&CoarseNullSpace);CHKERRQ(ierr);
8343       ierr = VecDestroy(&nullv);CHKERRQ(ierr);
8344     }
8345   }
8346 
8347   if (pcbddc->coarse_ksp) {
8348     PetscBool ispreonly;
8349 
8350     if (CoarseNullSpace) {
8351       PetscBool isnull;
8352       ierr = MatNullSpaceTest(CoarseNullSpace,coarse_mat,&isnull);CHKERRQ(ierr);
8353       if (isnull) {
8354         ierr = MatSetNullSpace(coarse_mat,CoarseNullSpace);CHKERRQ(ierr);
8355       }
8356       /* TODO: add local nullspaces (if any) */
8357     }
8358     /* setup coarse ksp */
8359     ierr = KSPSetUp(pcbddc->coarse_ksp);CHKERRQ(ierr);
8360     /* Check coarse problem if in debug mode or if solving with an iterative method */
8361     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->coarse_ksp,KSPPREONLY,&ispreonly);CHKERRQ(ierr);
8362     if (pcbddc->dbg_flag || (!ispreonly && pcbddc->use_coarse_estimates) ) {
8363       KSP       check_ksp;
8364       KSPType   check_ksp_type;
8365       PC        check_pc;
8366       Vec       check_vec,coarse_vec;
8367       PetscReal abs_infty_error,infty_error,lambda_min=1.0,lambda_max=1.0;
8368       PetscInt  its;
8369       PetscBool compute_eigs;
8370       PetscReal *eigs_r,*eigs_c;
8371       PetscInt  neigs;
8372       const char *prefix;
8373 
8374       /* Create ksp object suitable for estimation of extreme eigenvalues */
8375       ierr = KSPCreate(PetscObjectComm((PetscObject)pcbddc->coarse_ksp),&check_ksp);CHKERRQ(ierr);
8376       ierr = KSPSetErrorIfNotConverged(pcbddc->coarse_ksp,pc->erroriffailure);CHKERRQ(ierr);
8377       ierr = KSPSetOperators(check_ksp,coarse_mat,coarse_mat);CHKERRQ(ierr);
8378       ierr = KSPSetTolerances(check_ksp,1.e-12,1.e-12,PETSC_DEFAULT,pcbddc->coarse_size);CHKERRQ(ierr);
8379       /* prevent from setup unneeded object */
8380       ierr = KSPGetPC(check_ksp,&check_pc);CHKERRQ(ierr);
8381       ierr = PCSetType(check_pc,PCNONE);CHKERRQ(ierr);
8382       if (ispreonly) {
8383         check_ksp_type = KSPPREONLY;
8384         compute_eigs = PETSC_FALSE;
8385       } else {
8386         check_ksp_type = KSPGMRES;
8387         compute_eigs = PETSC_TRUE;
8388       }
8389       ierr = KSPSetType(check_ksp,check_ksp_type);CHKERRQ(ierr);
8390       ierr = KSPSetComputeSingularValues(check_ksp,compute_eigs);CHKERRQ(ierr);
8391       ierr = KSPSetComputeEigenvalues(check_ksp,compute_eigs);CHKERRQ(ierr);
8392       ierr = KSPGMRESSetRestart(check_ksp,pcbddc->coarse_size+1);CHKERRQ(ierr);
8393       ierr = KSPGetOptionsPrefix(pcbddc->coarse_ksp,&prefix);CHKERRQ(ierr);
8394       ierr = KSPSetOptionsPrefix(check_ksp,prefix);CHKERRQ(ierr);
8395       ierr = KSPAppendOptionsPrefix(check_ksp,"check_");CHKERRQ(ierr);
8396       ierr = KSPSetFromOptions(check_ksp);CHKERRQ(ierr);
8397       ierr = KSPSetUp(check_ksp);CHKERRQ(ierr);
8398       ierr = KSPGetPC(pcbddc->coarse_ksp,&check_pc);CHKERRQ(ierr);
8399       ierr = KSPSetPC(check_ksp,check_pc);CHKERRQ(ierr);
8400       /* create random vec */
8401       ierr = MatCreateVecs(coarse_mat,&coarse_vec,&check_vec);CHKERRQ(ierr);
8402       ierr = VecSetRandom(check_vec,NULL);CHKERRQ(ierr);
8403       ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8404       /* solve coarse problem */
8405       ierr = KSPSolve(check_ksp,coarse_vec,coarse_vec);CHKERRQ(ierr);
8406       /* set eigenvalue estimation if preonly has not been requested */
8407       if (compute_eigs) {
8408         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_r);CHKERRQ(ierr);
8409         ierr = PetscMalloc1(pcbddc->coarse_size+1,&eigs_c);CHKERRQ(ierr);
8410         ierr = KSPComputeEigenvalues(check_ksp,pcbddc->coarse_size+1,eigs_r,eigs_c,&neigs);CHKERRQ(ierr);
8411         if (neigs) {
8412           lambda_max = eigs_r[neigs-1];
8413           lambda_min = eigs_r[0];
8414           if (pcbddc->use_coarse_estimates) {
8415             if (lambda_max>=lambda_min) { /* using PETSC_SMALL since lambda_max == lambda_min is not allowed by KSPChebyshevSetEigenvalues */
8416               ierr = KSPChebyshevSetEigenvalues(pcbddc->coarse_ksp,lambda_max+PETSC_SMALL,lambda_min);CHKERRQ(ierr);
8417               ierr = KSPRichardsonSetScale(pcbddc->coarse_ksp,2.0/(lambda_max+lambda_min));CHKERRQ(ierr);
8418             }
8419           }
8420         }
8421       }
8422 
8423       /* check coarse problem residual error */
8424       if (pcbddc->dbg_flag) {
8425         PetscViewer dbg_viewer = PETSC_VIEWER_STDOUT_(PetscObjectComm((PetscObject)pcbddc->coarse_ksp));
8426         ierr = PetscViewerASCIIAddTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8427         ierr = VecAXPY(check_vec,-1.0,coarse_vec);CHKERRQ(ierr);
8428         ierr = VecNorm(check_vec,NORM_INFINITY,&infty_error);CHKERRQ(ierr);
8429         ierr = MatMult(coarse_mat,check_vec,coarse_vec);CHKERRQ(ierr);
8430         ierr = VecNorm(coarse_vec,NORM_INFINITY,&abs_infty_error);CHKERRQ(ierr);
8431         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem details (use estimates %d)\n",pcbddc->use_coarse_estimates);CHKERRQ(ierr);
8432         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(pcbddc->coarse_ksp),dbg_viewer);CHKERRQ(ierr);
8433         ierr = PetscObjectPrintClassNamePrefixType((PetscObject)(check_pc),dbg_viewer);CHKERRQ(ierr);
8434         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem exact infty_error   : %1.6e\n",infty_error);CHKERRQ(ierr);
8435         ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem residual infty_error: %1.6e\n",abs_infty_error);CHKERRQ(ierr);
8436         if (CoarseNullSpace) {
8437           ierr = PetscViewerASCIIPrintf(dbg_viewer,"Coarse problem is singular\n");CHKERRQ(ierr);
8438         }
8439         if (compute_eigs) {
8440           PetscReal          lambda_max_s,lambda_min_s;
8441           KSPConvergedReason reason;
8442           ierr = KSPGetType(check_ksp,&check_ksp_type);CHKERRQ(ierr);
8443           ierr = KSPGetIterationNumber(check_ksp,&its);CHKERRQ(ierr);
8444           ierr = KSPGetConvergedReason(check_ksp,&reason);CHKERRQ(ierr);
8445           ierr = KSPComputeExtremeSingularValues(check_ksp,&lambda_max_s,&lambda_min_s);CHKERRQ(ierr);
8446           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);
8447           for (i=0;i<neigs;i++) {
8448             ierr = PetscViewerASCIIPrintf(dbg_viewer,"%1.6e %1.6ei\n",eigs_r[i],eigs_c[i]);CHKERRQ(ierr);
8449           }
8450         }
8451         ierr = PetscViewerFlush(dbg_viewer);CHKERRQ(ierr);
8452         ierr = PetscViewerASCIISubtractTab(dbg_viewer,2*(pcbddc->current_level+1));CHKERRQ(ierr);
8453       }
8454       ierr = VecDestroy(&check_vec);CHKERRQ(ierr);
8455       ierr = VecDestroy(&coarse_vec);CHKERRQ(ierr);
8456       ierr = KSPDestroy(&check_ksp);CHKERRQ(ierr);
8457       if (compute_eigs) {
8458         ierr = PetscFree(eigs_r);CHKERRQ(ierr);
8459         ierr = PetscFree(eigs_c);CHKERRQ(ierr);
8460       }
8461     }
8462   }
8463   ierr = MatNullSpaceDestroy(&CoarseNullSpace);CHKERRQ(ierr);
8464   /* print additional info */
8465   if (pcbddc->dbg_flag) {
8466     /* waits until all processes reaches this point */
8467     ierr = PetscBarrier((PetscObject)pc);CHKERRQ(ierr);
8468     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Coarse solver setup completed at level %d\n",pcbddc->current_level);CHKERRQ(ierr);
8469     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8470   }
8471 
8472   /* free memory */
8473   ierr = MatDestroy(&coarse_mat);CHKERRQ(ierr);
8474   PetscFunctionReturn(0);
8475 }
8476 
8477 PetscErrorCode PCBDDCComputePrimalNumbering(PC pc,PetscInt* coarse_size_n,PetscInt** local_primal_indices_n)
8478 {
8479   PC_BDDC*       pcbddc = (PC_BDDC*)pc->data;
8480   PC_IS*         pcis = (PC_IS*)pc->data;
8481   Mat_IS*        matis = (Mat_IS*)pc->pmat->data;
8482   IS             subset,subset_mult,subset_n;
8483   PetscInt       local_size,coarse_size=0;
8484   PetscInt       *local_primal_indices=NULL;
8485   const PetscInt *t_local_primal_indices;
8486   PetscErrorCode ierr;
8487 
8488   PetscFunctionBegin;
8489   /* Compute global number of coarse dofs */
8490   if (pcbddc->local_primal_size && !pcbddc->local_primal_ref_node) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_PLIB,"BDDC ConstraintsSetUp should be called first");
8491   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
8492   ierr = ISLocalToGlobalMappingApplyIS(pcis->mapping,subset_n,&subset);CHKERRQ(ierr);
8493   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8494   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(pc->pmat)),pcbddc->local_primal_size_cc,pcbddc->local_primal_ref_mult,PETSC_COPY_VALUES,&subset_mult);CHKERRQ(ierr);
8495   ierr = ISRenumber(subset,subset_mult,&coarse_size,&subset_n);CHKERRQ(ierr);
8496   ierr = ISDestroy(&subset);CHKERRQ(ierr);
8497   ierr = ISDestroy(&subset_mult);CHKERRQ(ierr);
8498   ierr = ISGetLocalSize(subset_n,&local_size);CHKERRQ(ierr);
8499   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);
8500   ierr = PetscMalloc1(local_size,&local_primal_indices);CHKERRQ(ierr);
8501   ierr = ISGetIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8502   ierr = PetscMemcpy(local_primal_indices,t_local_primal_indices,local_size*sizeof(PetscInt));CHKERRQ(ierr);
8503   ierr = ISRestoreIndices(subset_n,&t_local_primal_indices);CHKERRQ(ierr);
8504   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
8505 
8506   /* check numbering */
8507   if (pcbddc->dbg_flag) {
8508     PetscScalar coarsesum,*array,*array2;
8509     PetscInt    i;
8510     PetscBool   set_error = PETSC_FALSE,set_error_reduced = PETSC_FALSE;
8511 
8512     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8513     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
8514     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Check coarse indices\n");CHKERRQ(ierr);
8515     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8516     /* counter */
8517     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8518     ierr = VecSet(pcis->vec1_N,1.0);CHKERRQ(ierr);
8519     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8520     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8521     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8522     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec2_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8523     ierr = VecSet(pcis->vec1_N,0.0);CHKERRQ(ierr);
8524     for (i=0;i<pcbddc->local_primal_size;i++) {
8525       ierr = VecSetValue(pcis->vec1_N,pcbddc->primal_indices_local_idxs[i],1.0,INSERT_VALUES);CHKERRQ(ierr);
8526     }
8527     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8528     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8529     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8530     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8531     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8532     ierr = VecScatterBegin(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8533     ierr = VecScatterEnd(matis->rctx,pcis->vec1_global,pcis->vec1_N,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8534     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8535     ierr = VecGetArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8536     for (i=0;i<pcis->n;i++) {
8537       if (array[i] != 0.0 && array[i] != array2[i]) {
8538         PetscInt owned = (PetscInt)PetscRealPart(array[i]),gi;
8539         PetscInt neigh = (PetscInt)PetscRealPart(array2[i]);
8540         set_error = PETSC_TRUE;
8541         ierr = ISLocalToGlobalMappingApply(pcis->mapping,1,&i,&gi);CHKERRQ(ierr);
8542         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);
8543       }
8544     }
8545     ierr = VecRestoreArray(pcis->vec2_N,&array2);CHKERRQ(ierr);
8546     ierr = MPIU_Allreduce(&set_error,&set_error_reduced,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8547     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8548     for (i=0;i<pcis->n;i++) {
8549       if (PetscRealPart(array[i]) > 0.0) array[i] = 1.0/PetscRealPart(array[i]);
8550     }
8551     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8552     ierr = VecSet(pcis->vec1_global,0.0);CHKERRQ(ierr);
8553     ierr = VecScatterBegin(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8554     ierr = VecScatterEnd(matis->rctx,pcis->vec1_N,pcis->vec1_global,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8555     ierr = VecSum(pcis->vec1_global,&coarsesum);CHKERRQ(ierr);
8556     ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Size of coarse problem is %d (%lf)\n",coarse_size,PetscRealPart(coarsesum));CHKERRQ(ierr);
8557     if (pcbddc->dbg_flag > 1 || set_error_reduced) {
8558       PetscInt *gidxs;
8559 
8560       ierr = PetscMalloc1(pcbddc->local_primal_size,&gidxs);CHKERRQ(ierr);
8561       ierr = ISLocalToGlobalMappingApply(pcis->mapping,pcbddc->local_primal_size,pcbddc->primal_indices_local_idxs,gidxs);CHKERRQ(ierr);
8562       ierr = PetscViewerASCIIPrintf(pcbddc->dbg_viewer,"Distribution of local primal indices\n");CHKERRQ(ierr);
8563       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8564       ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
8565       for (i=0;i<pcbddc->local_primal_size;i++) {
8566         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);
8567       }
8568       ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8569       ierr = PetscFree(gidxs);CHKERRQ(ierr);
8570     }
8571     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8572     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8573     if (set_error_reduced) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_PLIB,"BDDC Numbering of coarse dofs failed");
8574   }
8575   /* ierr = PetscPrintf(PetscObjectComm((PetscObject)pc),"Size of coarse problem is %d\n",coarse_size);CHKERRQ(ierr); */
8576   /* get back data */
8577   *coarse_size_n = coarse_size;
8578   *local_primal_indices_n = local_primal_indices;
8579   PetscFunctionReturn(0);
8580 }
8581 
8582 PetscErrorCode PCBDDCGlobalToLocal(VecScatter g2l_ctx,Vec gwork, Vec lwork, IS globalis, IS* localis)
8583 {
8584   IS             localis_t;
8585   PetscInt       i,lsize,*idxs,n;
8586   PetscScalar    *vals;
8587   PetscErrorCode ierr;
8588 
8589   PetscFunctionBegin;
8590   /* get indices in local ordering exploiting local to global map */
8591   ierr = ISGetLocalSize(globalis,&lsize);CHKERRQ(ierr);
8592   ierr = PetscMalloc1(lsize,&vals);CHKERRQ(ierr);
8593   for (i=0;i<lsize;i++) vals[i] = 1.0;
8594   ierr = ISGetIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8595   ierr = VecSet(gwork,0.0);CHKERRQ(ierr);
8596   ierr = VecSet(lwork,0.0);CHKERRQ(ierr);
8597   if (idxs) { /* multilevel guard */
8598     ierr = VecSetOption(gwork,VEC_IGNORE_NEGATIVE_INDICES,PETSC_TRUE);CHKERRQ(ierr);
8599     ierr = VecSetValues(gwork,lsize,idxs,vals,INSERT_VALUES);CHKERRQ(ierr);
8600   }
8601   ierr = VecAssemblyBegin(gwork);CHKERRQ(ierr);
8602   ierr = ISRestoreIndices(globalis,(const PetscInt**)&idxs);CHKERRQ(ierr);
8603   ierr = PetscFree(vals);CHKERRQ(ierr);
8604   ierr = VecAssemblyEnd(gwork);CHKERRQ(ierr);
8605   /* now compute set in local ordering */
8606   ierr = VecScatterBegin(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8607   ierr = VecScatterEnd(g2l_ctx,gwork,lwork,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8608   ierr = VecGetArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8609   ierr = VecGetSize(lwork,&n);CHKERRQ(ierr);
8610   for (i=0,lsize=0;i<n;i++) {
8611     if (PetscRealPart(vals[i]) > 0.5) {
8612       lsize++;
8613     }
8614   }
8615   ierr = PetscMalloc1(lsize,&idxs);CHKERRQ(ierr);
8616   for (i=0,lsize=0;i<n;i++) {
8617     if (PetscRealPart(vals[i]) > 0.5) {
8618       idxs[lsize++] = i;
8619     }
8620   }
8621   ierr = VecRestoreArrayRead(lwork,(const PetscScalar**)&vals);CHKERRQ(ierr);
8622   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)gwork),lsize,idxs,PETSC_OWN_POINTER,&localis_t);CHKERRQ(ierr);
8623   *localis = localis_t;
8624   PetscFunctionReturn(0);
8625 }
8626 
8627 PetscErrorCode PCBDDCSetUpSubSchurs(PC pc)
8628 {
8629   PC_IS               *pcis=(PC_IS*)pc->data;
8630   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8631   PCBDDCSubSchurs     sub_schurs=pcbddc->sub_schurs;
8632   Mat                 S_j;
8633   PetscInt            *used_xadj,*used_adjncy;
8634   PetscBool           free_used_adj;
8635   PetscErrorCode      ierr;
8636 
8637   PetscFunctionBegin;
8638   /* decide the adjacency to be used for determining internal problems for local schur on subsets */
8639   free_used_adj = PETSC_FALSE;
8640   if (pcbddc->sub_schurs_layers == -1) {
8641     used_xadj = NULL;
8642     used_adjncy = NULL;
8643   } else {
8644     if (pcbddc->sub_schurs_use_useradj && pcbddc->mat_graph->xadj) {
8645       used_xadj = pcbddc->mat_graph->xadj;
8646       used_adjncy = pcbddc->mat_graph->adjncy;
8647     } else if (pcbddc->computed_rowadj) {
8648       used_xadj = pcbddc->mat_graph->xadj;
8649       used_adjncy = pcbddc->mat_graph->adjncy;
8650     } else {
8651       PetscBool      flg_row=PETSC_FALSE;
8652       const PetscInt *xadj,*adjncy;
8653       PetscInt       nvtxs;
8654 
8655       ierr = MatGetRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8656       if (flg_row) {
8657         ierr = PetscMalloc2(nvtxs+1,&used_xadj,xadj[nvtxs],&used_adjncy);CHKERRQ(ierr);
8658         ierr = PetscMemcpy(used_xadj,xadj,(nvtxs+1)*sizeof(*xadj));CHKERRQ(ierr);
8659         ierr = PetscMemcpy(used_adjncy,adjncy,(xadj[nvtxs])*sizeof(*adjncy));CHKERRQ(ierr);
8660         free_used_adj = PETSC_TRUE;
8661       } else {
8662         pcbddc->sub_schurs_layers = -1;
8663         used_xadj = NULL;
8664         used_adjncy = NULL;
8665       }
8666       ierr = MatRestoreRowIJ(pcbddc->local_mat,0,PETSC_TRUE,PETSC_FALSE,&nvtxs,&xadj,&adjncy,&flg_row);CHKERRQ(ierr);
8667     }
8668   }
8669 
8670   /* setup sub_schurs data */
8671   ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8672   if (!sub_schurs->schur_explicit) {
8673     /* pcbddc->ksp_D up to date only if not using MatFactor with Schur complement support */
8674     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8675     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);
8676   } else {
8677     Mat       change = NULL;
8678     Vec       scaling = NULL;
8679     IS        change_primal = NULL, iP;
8680     PetscInt  benign_n;
8681     PetscBool reuse_solvers = (PetscBool)!pcbddc->use_change_of_basis;
8682     PetscBool isseqaij,need_change = PETSC_FALSE;
8683     PetscBool discrete_harmonic = PETSC_FALSE;
8684 
8685     if (!pcbddc->use_vertices && reuse_solvers) {
8686       PetscInt n_vertices;
8687 
8688       ierr = ISGetLocalSize(sub_schurs->is_vertices,&n_vertices);CHKERRQ(ierr);
8689       reuse_solvers = (PetscBool)!n_vertices;
8690     }
8691     ierr = PetscObjectTypeCompare((PetscObject)pcbddc->local_mat,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
8692     if (!isseqaij) {
8693       Mat_IS* matis = (Mat_IS*)pc->pmat->data;
8694       if (matis->A == pcbddc->local_mat) {
8695         ierr = MatDestroy(&pcbddc->local_mat);CHKERRQ(ierr);
8696         ierr = MatConvert(matis->A,MATSEQAIJ,MAT_INITIAL_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8697       } else {
8698         ierr = MatConvert(pcbddc->local_mat,MATSEQAIJ,MAT_INPLACE_MATRIX,&pcbddc->local_mat);CHKERRQ(ierr);
8699       }
8700     }
8701     if (!pcbddc->benign_change_explicit) {
8702       benign_n = pcbddc->benign_n;
8703     } else {
8704       benign_n = 0;
8705     }
8706     /* sub_schurs->change is a local object; instead, PCBDDCConstraintsSetUp and the quantities used in the test below are logically collective on pc.
8707        We need a global reduction to avoid possible deadlocks.
8708        We assume that sub_schurs->change is created once, and then reused for different solves, unless the topography has been recomputed */
8709     if (pcbddc->adaptive_userdefined || (pcbddc->deluxe_zerorows && !pcbddc->use_change_of_basis)) {
8710       PetscBool have_loc_change = (PetscBool)(!!sub_schurs->change);
8711       ierr = MPIU_Allreduce(&have_loc_change,&need_change,1,MPIU_BOOL,MPI_LOR,PetscObjectComm((PetscObject)pc));CHKERRQ(ierr);
8712       need_change = (PetscBool)(!need_change);
8713     }
8714     /* If the user defines additional constraints, we import them here.
8715        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 */
8716     if (need_change) {
8717       PC_IS   *pcisf;
8718       PC_BDDC *pcbddcf;
8719       PC      pcf;
8720 
8721       if (pcbddc->sub_schurs_rebuild) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot compute change of basis with a different graph");
8722       ierr = PCCreate(PetscObjectComm((PetscObject)pc),&pcf);CHKERRQ(ierr);
8723       ierr = PCSetOperators(pcf,pc->mat,pc->pmat);CHKERRQ(ierr);
8724       ierr = PCSetType(pcf,PCBDDC);CHKERRQ(ierr);
8725 
8726       /* hacks */
8727       pcisf                        = (PC_IS*)pcf->data;
8728       pcisf->is_B_local            = pcis->is_B_local;
8729       pcisf->vec1_N                = pcis->vec1_N;
8730       pcisf->BtoNmap               = pcis->BtoNmap;
8731       pcisf->n                     = pcis->n;
8732       pcisf->n_B                   = pcis->n_B;
8733       pcbddcf                      = (PC_BDDC*)pcf->data;
8734       ierr                         = PetscFree(pcbddcf->mat_graph);CHKERRQ(ierr);
8735       pcbddcf->mat_graph           = pcbddc->mat_graph;
8736       pcbddcf->use_faces           = PETSC_TRUE;
8737       pcbddcf->use_change_of_basis = PETSC_TRUE;
8738       pcbddcf->use_change_on_faces = PETSC_TRUE;
8739       pcbddcf->use_qr_single       = PETSC_TRUE;
8740       pcbddcf->fake_change         = PETSC_TRUE;
8741 
8742       /* setup constraints so that we can get information on primal vertices and change of basis (in local numbering) */
8743       ierr = PCBDDCConstraintsSetUp(pcf);CHKERRQ(ierr);
8744       sub_schurs->change_with_qr = pcbddcf->use_qr_single;
8745       ierr = ISCreateGeneral(PETSC_COMM_SELF,pcbddcf->n_vertices,pcbddcf->local_primal_ref_node,PETSC_COPY_VALUES,&change_primal);CHKERRQ(ierr);
8746       change = pcbddcf->ConstraintMatrix;
8747       pcbddcf->ConstraintMatrix = NULL;
8748 
8749       /* free unneeded memory allocated in PCBDDCConstraintsSetUp */
8750       ierr = PetscFree(pcbddcf->sub_schurs);CHKERRQ(ierr);
8751       ierr = MatNullSpaceDestroy(&pcbddcf->onearnullspace);CHKERRQ(ierr);
8752       ierr = PetscFree2(pcbddcf->local_primal_ref_node,pcbddcf->local_primal_ref_mult);CHKERRQ(ierr);
8753       ierr = PetscFree(pcbddcf->primal_indices_local_idxs);CHKERRQ(ierr);
8754       ierr = PetscFree(pcbddcf->onearnullvecs_state);CHKERRQ(ierr);
8755       ierr = PetscFree(pcf->data);CHKERRQ(ierr);
8756       pcf->ops->destroy = NULL;
8757       pcf->ops->reset   = NULL;
8758       ierr = PCDestroy(&pcf);CHKERRQ(ierr);
8759     }
8760     if (!pcbddc->use_deluxe_scaling) scaling = pcis->D;
8761 
8762     ierr = PetscObjectQuery((PetscObject)pc,"__KSPFETIDP_iP",(PetscObject*)&iP);CHKERRQ(ierr);
8763     if (iP) {
8764       ierr = PetscOptionsBegin(PetscObjectComm((PetscObject)iP),sub_schurs->prefix,"BDDC sub_schurs options","PC");CHKERRQ(ierr);
8765       ierr = PetscOptionsBool("-sub_schurs_discrete_harmonic",NULL,NULL,discrete_harmonic,&discrete_harmonic,NULL);CHKERRQ(ierr);
8766       ierr = PetscOptionsEnd();CHKERRQ(ierr);
8767     }
8768     if (discrete_harmonic) {
8769       Mat A;
8770       ierr = MatDuplicate(pcbddc->local_mat,MAT_COPY_VALUES,&A);CHKERRQ(ierr);
8771       ierr = MatZeroRowsColumnsIS(A,iP,1.0,NULL,NULL);CHKERRQ(ierr);
8772       ierr = PetscObjectCompose((PetscObject)A,"__KSPFETIDP_iP",(PetscObject)iP);CHKERRQ(ierr);
8773       ierr = PCBDDCSubSchursSetUp(sub_schurs,A,S_j,pcbddc->sub_schurs_exact_schur,used_xadj,used_adjncy,pcbddc->sub_schurs_layers,scaling,pcbddc->adaptive_selection,reuse_solvers,pcbddc->benign_saddle_point,benign_n,pcbddc->benign_p0_lidx,pcbddc->benign_zerodiag_subs,change,change_primal);CHKERRQ(ierr);
8774       ierr = MatDestroy(&A);CHKERRQ(ierr);
8775     } else {
8776       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);
8777     }
8778     ierr = MatDestroy(&change);CHKERRQ(ierr);
8779     ierr = ISDestroy(&change_primal);CHKERRQ(ierr);
8780   }
8781   ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8782 
8783   /* free adjacency */
8784   if (free_used_adj) {
8785     ierr = PetscFree2(used_xadj,used_adjncy);CHKERRQ(ierr);
8786   }
8787   PetscFunctionReturn(0);
8788 }
8789 
8790 PetscErrorCode PCBDDCInitSubSchurs(PC pc)
8791 {
8792   PC_IS               *pcis=(PC_IS*)pc->data;
8793   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8794   PCBDDCGraph         graph;
8795   PetscErrorCode      ierr;
8796 
8797   PetscFunctionBegin;
8798   /* attach interface graph for determining subsets */
8799   if (pcbddc->sub_schurs_rebuild) { /* in case rebuild has been requested, it uses a graph generated only by the neighbouring information */
8800     IS       verticesIS,verticescomm;
8801     PetscInt vsize,*idxs;
8802 
8803     ierr = PCBDDCGraphGetCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8804     ierr = ISGetSize(verticesIS,&vsize);CHKERRQ(ierr);
8805     ierr = ISGetIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8806     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)pc),vsize,idxs,PETSC_COPY_VALUES,&verticescomm);CHKERRQ(ierr);
8807     ierr = ISRestoreIndices(verticesIS,(const PetscInt**)&idxs);CHKERRQ(ierr);
8808     ierr = PCBDDCGraphRestoreCandidatesIS(pcbddc->mat_graph,NULL,NULL,NULL,NULL,&verticesIS);CHKERRQ(ierr);
8809     ierr = PCBDDCGraphCreate(&graph);CHKERRQ(ierr);
8810     ierr = PCBDDCGraphInit(graph,pcbddc->mat_graph->l2gmap,pcbddc->mat_graph->nvtxs_global,pcbddc->graphmaxcount);CHKERRQ(ierr);
8811     ierr = PCBDDCGraphSetUp(graph,pcbddc->mat_graph->custom_minimal_size,NULL,pcbddc->DirichletBoundariesLocal,0,NULL,verticescomm);CHKERRQ(ierr);
8812     ierr = ISDestroy(&verticescomm);CHKERRQ(ierr);
8813     ierr = PCBDDCGraphComputeConnectedComponents(graph);CHKERRQ(ierr);
8814   } else {
8815     graph = pcbddc->mat_graph;
8816   }
8817   /* print some info */
8818   if (pcbddc->dbg_flag && !pcbddc->sub_schurs_rebuild) {
8819     IS       vertices;
8820     PetscInt nv,nedges,nfaces;
8821     ierr = PCBDDCGraphASCIIView(graph,pcbddc->dbg_flag,pcbddc->dbg_viewer);CHKERRQ(ierr);
8822     ierr = PCBDDCGraphGetCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8823     ierr = ISGetSize(vertices,&nv);CHKERRQ(ierr);
8824     ierr = PetscViewerASCIIPushSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8825     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"--------------------------------------------------------------\n");CHKERRQ(ierr);
8826     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate vertices (%d)\n",PetscGlobalRank,nv,pcbddc->use_vertices);CHKERRQ(ierr);
8827     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate edges    (%d)\n",PetscGlobalRank,nedges,pcbddc->use_edges);CHKERRQ(ierr);
8828     ierr = PetscViewerASCIISynchronizedPrintf(pcbddc->dbg_viewer,"Subdomain %04d got %02d local candidate faces    (%d)\n",PetscGlobalRank,nfaces,pcbddc->use_faces);CHKERRQ(ierr);
8829     ierr = PetscViewerFlush(pcbddc->dbg_viewer);CHKERRQ(ierr);
8830     ierr = PetscViewerASCIIPopSynchronized(pcbddc->dbg_viewer);CHKERRQ(ierr);
8831     ierr = PCBDDCGraphRestoreCandidatesIS(graph,&nfaces,NULL,&nedges,NULL,&vertices);CHKERRQ(ierr);
8832   }
8833 
8834   /* sub_schurs init */
8835   if (!pcbddc->sub_schurs) {
8836     ierr = PCBDDCSubSchursCreate(&pcbddc->sub_schurs);CHKERRQ(ierr);
8837   }
8838   ierr = PCBDDCSubSchursInit(pcbddc->sub_schurs,((PetscObject)pc)->prefix,pcis->is_I_local,pcis->is_B_local,graph,pcis->BtoNmap,pcbddc->sub_schurs_rebuild);CHKERRQ(ierr);
8839 
8840   /* free graph struct */
8841   if (pcbddc->sub_schurs_rebuild) {
8842     ierr = PCBDDCGraphDestroy(&graph);CHKERRQ(ierr);
8843   }
8844   PetscFunctionReturn(0);
8845 }
8846 
8847 PetscErrorCode PCBDDCCheckOperator(PC pc)
8848 {
8849   PC_IS               *pcis=(PC_IS*)pc->data;
8850   PC_BDDC             *pcbddc=(PC_BDDC*)pc->data;
8851   PetscErrorCode      ierr;
8852 
8853   PetscFunctionBegin;
8854   if (pcbddc->n_vertices == pcbddc->local_primal_size) {
8855     IS             zerodiag = NULL;
8856     Mat            S_j,B0_B=NULL;
8857     Vec            dummy_vec=NULL,vec_check_B,vec_scale_P;
8858     PetscScalar    *p0_check,*array,*array2;
8859     PetscReal      norm;
8860     PetscInt       i;
8861 
8862     /* B0 and B0_B */
8863     if (zerodiag) {
8864       IS       dummy;
8865 
8866       ierr = ISCreateStride(PETSC_COMM_SELF,pcbddc->benign_n,0,1,&dummy);CHKERRQ(ierr);
8867       ierr = MatCreateSubMatrix(pcbddc->benign_B0,dummy,pcis->is_B_local,MAT_INITIAL_MATRIX,&B0_B);CHKERRQ(ierr);
8868       ierr = MatCreateVecs(B0_B,NULL,&dummy_vec);CHKERRQ(ierr);
8869       ierr = ISDestroy(&dummy);CHKERRQ(ierr);
8870     }
8871     /* I need a primal vector to scale primal nodes since BDDC sums contibutions */
8872     ierr = VecDuplicate(pcbddc->vec1_P,&vec_scale_P);CHKERRQ(ierr);
8873     ierr = VecSet(pcbddc->vec1_P,1.0);CHKERRQ(ierr);
8874     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8875     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8876     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8877     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,vec_scale_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8878     ierr = VecReciprocal(vec_scale_P);CHKERRQ(ierr);
8879     /* S_j */
8880     ierr = MatCreateSchurComplement(pcis->A_II,pcis->A_II,pcis->A_IB,pcis->A_BI,pcis->A_BB,&S_j);CHKERRQ(ierr);
8881     ierr = MatSchurComplementSetKSP(S_j,pcbddc->ksp_D);CHKERRQ(ierr);
8882 
8883     /* mimic vector in \widetilde{W}_\Gamma */
8884     ierr = VecSetRandom(pcis->vec1_N,NULL);CHKERRQ(ierr);
8885     /* continuous in primal space */
8886     ierr = VecSetRandom(pcbddc->coarse_vec,NULL);CHKERRQ(ierr);
8887     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8888     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8889     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8890     ierr = PetscCalloc1(pcbddc->benign_n,&p0_check);CHKERRQ(ierr);
8891     for (i=0;i<pcbddc->benign_n;i++) p0_check[i] = array[pcbddc->local_primal_size-pcbddc->benign_n+i];
8892     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8893     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8894     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8895     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8896     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8897     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec2_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8898     ierr = VecDuplicate(pcis->vec2_B,&vec_check_B);CHKERRQ(ierr);
8899     ierr = VecCopy(pcis->vec2_B,vec_check_B);CHKERRQ(ierr);
8900 
8901     /* assemble rhs for coarse problem */
8902     /* widetilde{S}_\Gamma w_\Gamma + \widetilde{B0}^T_B p0 */
8903     /* local with Schur */
8904     ierr = MatMult(S_j,pcis->vec2_B,pcis->vec1_B);CHKERRQ(ierr);
8905     if (zerodiag) {
8906       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8907       for (i=0;i<pcbddc->benign_n;i++) array[i] = p0_check[i];
8908       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8909       ierr = MatMultTransposeAdd(B0_B,dummy_vec,pcis->vec1_B,pcis->vec1_B);CHKERRQ(ierr);
8910     }
8911     /* sum on primal nodes the local contributions */
8912     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8913     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_B,pcis->vec1_N,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8914     ierr = VecGetArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8915     ierr = VecGetArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8916     for (i=0;i<pcbddc->local_primal_size;i++) array2[i] = array[pcbddc->local_primal_ref_node[i]];
8917     ierr = VecRestoreArray(pcbddc->vec1_P,&array2);CHKERRQ(ierr);
8918     ierr = VecRestoreArray(pcis->vec1_N,&array);CHKERRQ(ierr);
8919     ierr = VecSet(pcbddc->coarse_vec,0.);CHKERRQ(ierr);
8920     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8921     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->vec1_P,pcbddc->coarse_vec,ADD_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8922     ierr = VecScatterBegin(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8923     ierr = VecScatterEnd(pcbddc->coarse_loc_to_glob,pcbddc->coarse_vec,pcbddc->vec1_P,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
8924     ierr = VecGetArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8925     /* scale primal nodes (BDDC sums contibutions) */
8926     ierr = VecPointwiseMult(pcbddc->vec1_P,vec_scale_P,pcbddc->vec1_P);CHKERRQ(ierr);
8927     ierr = VecSetValues(pcis->vec1_N,pcbddc->local_primal_size,pcbddc->local_primal_ref_node,array,INSERT_VALUES);CHKERRQ(ierr);
8928     ierr = VecRestoreArray(pcbddc->vec1_P,&array);CHKERRQ(ierr);
8929     ierr = VecAssemblyBegin(pcis->vec1_N);CHKERRQ(ierr);
8930     ierr = VecAssemblyEnd(pcis->vec1_N);CHKERRQ(ierr);
8931     ierr = VecScatterBegin(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8932     ierr = VecScatterEnd(pcis->N_to_B,pcis->vec1_N,pcis->vec1_B,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
8933     /* global: \widetilde{B0}_B w_\Gamma */
8934     if (zerodiag) {
8935       ierr = MatMult(B0_B,pcis->vec2_B,dummy_vec);CHKERRQ(ierr);
8936       ierr = VecGetArray(dummy_vec,&array);CHKERRQ(ierr);
8937       for (i=0;i<pcbddc->benign_n;i++) pcbddc->benign_p0[i] = array[i];
8938       ierr = VecRestoreArray(dummy_vec,&array);CHKERRQ(ierr);
8939     }
8940     /* BDDC */
8941     ierr = VecSet(pcis->vec1_D,0.);CHKERRQ(ierr);
8942     ierr = PCBDDCApplyInterfacePreconditioner(pc,PETSC_FALSE);CHKERRQ(ierr);
8943 
8944     ierr = VecCopy(pcis->vec1_B,pcis->vec2_B);CHKERRQ(ierr);
8945     ierr = VecAXPY(pcis->vec1_B,-1.0,vec_check_B);CHKERRQ(ierr);
8946     ierr = VecNorm(pcis->vec1_B,NORM_INFINITY,&norm);CHKERRQ(ierr);
8947     PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC local error is %1.4e\n",PetscGlobalRank,norm);
8948     for (i=0;i<pcbddc->benign_n;i++) {
8949       PetscPrintf(PETSC_COMM_SELF,"[%d] BDDC p0[%d] error is %1.4e\n",PetscGlobalRank,i,PetscAbsScalar(pcbddc->benign_p0[i]-p0_check[i]));
8950     }
8951     ierr = PetscFree(p0_check);CHKERRQ(ierr);
8952     ierr = VecDestroy(&vec_scale_P);CHKERRQ(ierr);
8953     ierr = VecDestroy(&vec_check_B);CHKERRQ(ierr);
8954     ierr = VecDestroy(&dummy_vec);CHKERRQ(ierr);
8955     ierr = MatDestroy(&S_j);CHKERRQ(ierr);
8956     ierr = MatDestroy(&B0_B);CHKERRQ(ierr);
8957   }
8958   PetscFunctionReturn(0);
8959 }
8960 
8961 #include <../src/mat/impls/aij/mpi/mpiaij.h>
8962 PetscErrorCode MatMPIAIJRestrict(Mat A, MPI_Comm ccomm, Mat *B)
8963 {
8964   Mat            At;
8965   IS             rows;
8966   PetscInt       rst,ren;
8967   PetscErrorCode ierr;
8968   PetscLayout    rmap;
8969 
8970   PetscFunctionBegin;
8971   rst = ren = 0;
8972   if (ccomm != MPI_COMM_NULL) {
8973     ierr = PetscLayoutCreate(ccomm,&rmap);CHKERRQ(ierr);
8974     ierr = PetscLayoutSetSize(rmap,A->rmap->N);CHKERRQ(ierr);
8975     ierr = PetscLayoutSetBlockSize(rmap,1);CHKERRQ(ierr);
8976     ierr = PetscLayoutSetUp(rmap);CHKERRQ(ierr);
8977     ierr = PetscLayoutGetRange(rmap,&rst,&ren);CHKERRQ(ierr);
8978   }
8979   ierr = ISCreateStride(PetscObjectComm((PetscObject)A),ren-rst,rst,1,&rows);CHKERRQ(ierr);
8980   ierr = MatCreateSubMatrix(A,rows,NULL,MAT_INITIAL_MATRIX,&At);CHKERRQ(ierr);
8981   ierr = ISDestroy(&rows);CHKERRQ(ierr);
8982 
8983   if (ccomm != MPI_COMM_NULL) {
8984     Mat_MPIAIJ *a,*b;
8985     IS         from,to;
8986     Vec        gvec;
8987     PetscInt   lsize;
8988 
8989     ierr = MatCreate(ccomm,B);CHKERRQ(ierr);
8990     ierr = MatSetSizes(*B,ren-rst,PETSC_DECIDE,PETSC_DECIDE,At->cmap->N);CHKERRQ(ierr);
8991     ierr = MatSetType(*B,MATAIJ);CHKERRQ(ierr);
8992     ierr = PetscLayoutDestroy(&((*B)->rmap));CHKERRQ(ierr);
8993     ierr = PetscLayoutSetUp((*B)->cmap);CHKERRQ(ierr);
8994     a    = (Mat_MPIAIJ*)At->data;
8995     b    = (Mat_MPIAIJ*)(*B)->data;
8996     ierr = MPI_Comm_size(ccomm,&b->size);CHKERRQ(ierr);
8997     ierr = MPI_Comm_rank(ccomm,&b->rank);CHKERRQ(ierr);
8998     ierr = PetscObjectReference((PetscObject)a->A);CHKERRQ(ierr);
8999     ierr = PetscObjectReference((PetscObject)a->B);CHKERRQ(ierr);
9000     b->A = a->A;
9001     b->B = a->B;
9002 
9003     b->donotstash      = a->donotstash;
9004     b->roworiented     = a->roworiented;
9005     b->rowindices      = 0;
9006     b->rowvalues       = 0;
9007     b->getrowactive    = PETSC_FALSE;
9008 
9009     (*B)->rmap         = rmap;
9010     (*B)->factortype   = A->factortype;
9011     (*B)->assembled    = PETSC_TRUE;
9012     (*B)->insertmode   = NOT_SET_VALUES;
9013     (*B)->preallocated = PETSC_TRUE;
9014 
9015     if (a->colmap) {
9016 #if defined(PETSC_USE_CTABLE)
9017       ierr = PetscTableCreateCopy(a->colmap,&b->colmap);CHKERRQ(ierr);
9018 #else
9019       ierr = PetscMalloc1(At->cmap->N,&b->colmap);CHKERRQ(ierr);
9020       ierr = PetscLogObjectMemory((PetscObject)*B,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9021       ierr = PetscMemcpy(b->colmap,a->colmap,At->cmap->N*sizeof(PetscInt));CHKERRQ(ierr);
9022 #endif
9023     } else b->colmap = 0;
9024     if (a->garray) {
9025       PetscInt len;
9026       len  = a->B->cmap->n;
9027       ierr = PetscMalloc1(len+1,&b->garray);CHKERRQ(ierr);
9028       ierr = PetscLogObjectMemory((PetscObject)(*B),len*sizeof(PetscInt));CHKERRQ(ierr);
9029       if (len) { ierr = PetscMemcpy(b->garray,a->garray,len*sizeof(PetscInt));CHKERRQ(ierr); }
9030     } else b->garray = 0;
9031 
9032     ierr    = PetscObjectReference((PetscObject)a->lvec);CHKERRQ(ierr);
9033     b->lvec = a->lvec;
9034     ierr    = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->lvec);CHKERRQ(ierr);
9035 
9036     /* cannot use VecScatterCopy */
9037     ierr = VecGetLocalSize(b->lvec,&lsize);CHKERRQ(ierr);
9038     ierr = ISCreateGeneral(ccomm,lsize,b->garray,PETSC_USE_POINTER,&from);CHKERRQ(ierr);
9039     ierr = ISCreateStride(PETSC_COMM_SELF,lsize,0,1,&to);CHKERRQ(ierr);
9040     ierr = MatCreateVecs(*B,&gvec,NULL);CHKERRQ(ierr);
9041     ierr = VecScatterCreate(gvec,from,b->lvec,to,&b->Mvctx);CHKERRQ(ierr);
9042     ierr = PetscLogObjectParent((PetscObject)*B,(PetscObject)b->Mvctx);CHKERRQ(ierr);
9043     ierr = ISDestroy(&from);CHKERRQ(ierr);
9044     ierr = ISDestroy(&to);CHKERRQ(ierr);
9045     ierr = VecDestroy(&gvec);CHKERRQ(ierr);
9046   }
9047   ierr = MatDestroy(&At);CHKERRQ(ierr);
9048   PetscFunctionReturn(0);
9049 }
9050