xref: /petsc/src/ksp/pc/impls/bddc/bddcgraph.c (revision 14f95afae526a56f44d755db4a3eba0ba2dd44ad)
1 #include <petsc/private/petscimpl.h>
2 #include <../src/ksp/pc/impls/bddc/bddcprivate.h>
3 #include <../src/ksp/pc/impls/bddc/bddcstructs.h>
4 
5 #undef __FUNCT__
6 #define __FUNCT__ "PCBDDCGraphGetDirichletDofsB"
7 PetscErrorCode PCBDDCGraphGetDirichletDofsB(PCBDDCGraph graph, IS* dirdofs)
8 {
9   PetscErrorCode ierr;
10 
11   PetscFunctionBegin;
12   if (graph->dirdofsB) {
13     ierr = PetscObjectReference((PetscObject)graph->dirdofsB);CHKERRQ(ierr);
14   } else if (graph->has_dirichlet) {
15     PetscInt i,size;
16     PetscInt *dirdofs_idxs;
17 
18     size = 0;
19     for (i=0;i<graph->nvtxs;i++) {
20       if (graph->count[i] && graph->special_dof[i] == PCBDDCGRAPH_DIRICHLET_MARK) size++;
21     }
22 
23     ierr = PetscMalloc1(size,&dirdofs_idxs);CHKERRQ(ierr);
24     size = 0;
25     for (i=0;i<graph->nvtxs;i++) {
26       if (graph->count[i] && graph->special_dof[i] == PCBDDCGRAPH_DIRICHLET_MARK) dirdofs_idxs[size++] = i;
27     }
28     ierr = ISCreateGeneral(PETSC_COMM_SELF,size,dirdofs_idxs,PETSC_OWN_POINTER,&graph->dirdofsB);CHKERRQ(ierr);
29     ierr = PetscObjectReference((PetscObject)graph->dirdofsB);CHKERRQ(ierr);
30   }
31   *dirdofs = graph->dirdofsB;
32   PetscFunctionReturn(0);
33 }
34 
35 #undef __FUNCT__
36 #define __FUNCT__ "PCBDDCGraphGetDirichletDofs"
37 PetscErrorCode PCBDDCGraphGetDirichletDofs(PCBDDCGraph graph, IS* dirdofs)
38 {
39   PetscErrorCode ierr;
40 
41   PetscFunctionBegin;
42   if (graph->dirdofs) {
43     ierr = PetscObjectReference((PetscObject)graph->dirdofs);CHKERRQ(ierr);
44   } else if (graph->has_dirichlet) {
45     PetscInt i,size;
46     PetscInt *dirdofs_idxs;
47 
48     size = 0;
49     for (i=0;i<graph->nvtxs;i++) {
50       if (graph->special_dof[i] == PCBDDCGRAPH_DIRICHLET_MARK) size++;
51     }
52 
53     ierr = PetscMalloc1(size,&dirdofs_idxs);CHKERRQ(ierr);
54     size = 0;
55     for (i=0;i<graph->nvtxs;i++) {
56       if (graph->special_dof[i] == PCBDDCGRAPH_DIRICHLET_MARK) dirdofs_idxs[size++] = i;
57     }
58     ierr = ISCreateGeneral(PetscObjectComm((PetscObject)graph->l2gmap),size,dirdofs_idxs,PETSC_OWN_POINTER,&graph->dirdofs);CHKERRQ(ierr);
59     ierr = PetscObjectReference((PetscObject)graph->dirdofs);CHKERRQ(ierr);
60   }
61   *dirdofs = graph->dirdofs;
62   PetscFunctionReturn(0);
63 }
64 
65 #undef __FUNCT__
66 #define __FUNCT__ "PCBDDCGraphASCIIView"
67 PetscErrorCode PCBDDCGraphASCIIView(PCBDDCGraph graph, PetscInt verbosity_level, PetscViewer viewer)
68 {
69   PetscInt       i,j,tabs;
70   PetscInt*      queue_in_global_numbering;
71   PetscErrorCode ierr;
72 
73   PetscFunctionBegin;
74   ierr = PetscViewerASCIIPushSynchronized(viewer);CHKERRQ(ierr);
75   ierr = PetscViewerASCIIGetTab(viewer,&tabs);CHKERRQ(ierr);
76   ierr = PetscViewerASCIIPrintf(viewer,"--------------------------------------------------\n");CHKERRQ(ierr);
77   ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
78   ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Local BDDC graph for subdomain %04d\n",PetscGlobalRank);CHKERRQ(ierr);
79   ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Number of vertices %d\n",graph->nvtxs);CHKERRQ(ierr);
80   ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Custom minimal size %d\n",graph->custom_minimal_size);CHKERRQ(ierr);
81   if (verbosity_level > 1) {
82     for (i=0;i<graph->nvtxs;i++) {
83       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"%d:\n",i);CHKERRQ(ierr);
84       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   which_dof: %d\n",graph->which_dof[i]);CHKERRQ(ierr);
85       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   special_dof: %d\n",graph->special_dof[i]);CHKERRQ(ierr);
86       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   neighbours: %d\n",graph->count[i]);CHKERRQ(ierr);
87       ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
88       if (graph->count[i]) {
89         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"     set of neighbours:");CHKERRQ(ierr);
90         for (j=0;j<graph->count[i];j++) {
91           ierr = PetscViewerASCIISynchronizedPrintf(viewer," %d",graph->neighbours_set[i][j]);CHKERRQ(ierr);
92         }
93         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
94       }
95       ierr = PetscViewerASCIISetTab(viewer,tabs);CHKERRQ(ierr);
96       ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
97       if (graph->mirrors) {
98         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   mirrors: %d\n",graph->mirrors[i]);CHKERRQ(ierr);
99         if (graph->mirrors[i]) {
100           ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
101           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"     set of mirrors:");CHKERRQ(ierr);
102           for (j=0;j<graph->mirrors[i];j++) {
103             ierr = PetscViewerASCIISynchronizedPrintf(viewer," %d",graph->mirrors_set[i][j]);CHKERRQ(ierr);
104           }
105           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
106           ierr = PetscViewerASCIISetTab(viewer,tabs);CHKERRQ(ierr);
107           ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
108         }
109       }
110       if (verbosity_level > 2) {
111         if (graph->xadj && graph->adjncy) {
112           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   local adj list:");CHKERRQ(ierr);
113           ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
114           for (j=graph->xadj[i];j<graph->xadj[i+1];j++) {
115             ierr = PetscViewerASCIISynchronizedPrintf(viewer," %d",graph->adjncy[j]);CHKERRQ(ierr);
116           }
117           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
118           ierr = PetscViewerASCIISetTab(viewer,tabs);CHKERRQ(ierr);
119           ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
120         } else {
121           ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   no adj info\n");CHKERRQ(ierr);
122         }
123       }
124       if (graph->n_local_subs) {
125         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   local sub id: %d\n",graph->local_subs[i]);CHKERRQ(ierr);
126       }
127       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   interface subset id: %d\n",graph->subset[i]);CHKERRQ(ierr);
128       if (graph->subset[i] && graph->subset_ncc) {
129         ierr = PetscViewerASCIISynchronizedPrintf(viewer,"   ncc for subset: %d\n",graph->subset_ncc[graph->subset[i]-1]);CHKERRQ(ierr);
130       }
131     }
132   }
133   ierr = PetscViewerASCIISynchronizedPrintf(viewer,"Total number of connected components %d\n",graph->ncc);CHKERRQ(ierr);
134   ierr = PetscMalloc1(graph->cptr[graph->ncc],&queue_in_global_numbering);CHKERRQ(ierr);
135   ierr = ISLocalToGlobalMappingApply(graph->l2gmap,graph->cptr[graph->ncc],graph->queue,queue_in_global_numbering);CHKERRQ(ierr);
136   for (i=0;i<graph->ncc;i++) {
137     PetscInt node_num=graph->queue[graph->cptr[i]];
138     PetscBool printcc = PETSC_FALSE;
139     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"  %d (neighs:",i);CHKERRQ(ierr);
140     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
141     for (j=0;j<graph->count[node_num];j++) {
142       ierr = PetscViewerASCIISynchronizedPrintf(viewer," %d",graph->neighbours_set[node_num][j]);CHKERRQ(ierr);
143     }
144     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"):");CHKERRQ(ierr);
145     if (verbosity_level > 1 || graph->twodim) {
146       printcc = PETSC_TRUE;
147     } else if (graph->count[node_num] > 1 || (graph->count[node_num] == 1 && graph->special_dof[node_num] == PCBDDCGRAPH_NEUMANN_MARK)) {
148       printcc = PETSC_TRUE;
149     }
150     if (printcc) {
151       for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
152         ierr = PetscViewerASCIISynchronizedPrintf(viewer," %d (%d)",graph->queue[j],queue_in_global_numbering[j]);CHKERRQ(ierr);
153       }
154     }
155     ierr = PetscViewerASCIISynchronizedPrintf(viewer,"\n");CHKERRQ(ierr);
156     ierr = PetscViewerASCIISetTab(viewer,tabs);CHKERRQ(ierr);
157     ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
158   }
159   ierr = PetscFree(queue_in_global_numbering);CHKERRQ(ierr);
160   ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
161   PetscFunctionReturn(0);
162 }
163 
164 #undef __FUNCT__
165 #define __FUNCT__ "PCBDDCGraphGetCandidatesIS"
166 PetscErrorCode PCBDDCGraphGetCandidatesIS(PCBDDCGraph graph, PetscInt *n_faces, IS *FacesIS[], PetscInt *n_edges, IS *EdgesIS[], IS *VerticesIS)
167 {
168   IS             *ISForFaces,*ISForEdges,ISForVertices;
169   PetscInt       i,nfc,nec,nvc,*idx;
170   PetscErrorCode ierr;
171 
172   PetscFunctionBegin;
173   /* loop on ccs to evalute number of faces, edges and vertices */
174   nfc = 0;
175   nec = 0;
176   nvc = 0;
177   for (i=0;i<graph->ncc;i++) {
178     PetscInt repdof = graph->queue[graph->cptr[i]];
179     if (graph->cptr[i+1]-graph->cptr[i] > graph->custom_minimal_size) {
180       if (graph->count[repdof] == 1 && graph->special_dof[repdof] != PCBDDCGRAPH_NEUMANN_MARK) {
181         nfc++;
182       } else { /* note that nec will be zero in 2d */
183         nec++;
184       }
185     } else {
186       nvc += graph->cptr[i+1]-graph->cptr[i];
187     }
188   }
189 
190   /* check if we are in 2D or 3D */
191   if (graph->twodim) { /* we are in a 2D case -> edges are shared by 2 subregions and faces don't exist */
192     nec = nfc;
193     nfc = 0;
194   }
195 
196   /* allocate IS arrays for faces, edges. Vertices need a single index set. */
197   if (FacesIS) {
198     ierr = PetscMalloc1(nfc,&ISForFaces);CHKERRQ(ierr);
199   }
200   if (EdgesIS) {
201     ierr = PetscMalloc1(nec,&ISForEdges);CHKERRQ(ierr);
202   }
203   if (VerticesIS) {
204     ierr = PetscMalloc1(nvc,&idx);CHKERRQ(ierr);
205   }
206 
207   /* loop on ccs to compute index sets for faces and edges */
208   if (!graph->queue_sorted) {
209     PetscInt *queue_global;
210 
211     ierr = PetscMalloc1(graph->cptr[graph->ncc],&queue_global);CHKERRQ(ierr);
212     ierr = ISLocalToGlobalMappingApply(graph->l2gmap,graph->cptr[graph->ncc],graph->queue,queue_global);CHKERRQ(ierr);
213     for (i=0;i<graph->ncc;i++) {
214       ierr = PetscSortIntWithArray(graph->cptr[i+1]-graph->cptr[i],&queue_global[graph->cptr[i]],&graph->queue[graph->cptr[i]]);CHKERRQ(ierr);
215     }
216     ierr = PetscFree(queue_global);CHKERRQ(ierr);
217     graph->queue_sorted = PETSC_TRUE;
218   }
219   nfc = 0;
220   nec = 0;
221   for (i=0;i<graph->ncc;i++) {
222     PetscInt repdof = graph->queue[graph->cptr[i]];
223     if (graph->cptr[i+1]-graph->cptr[i] > graph->custom_minimal_size) {
224       if (graph->count[repdof] == 1 && graph->special_dof[repdof] != PCBDDCGRAPH_NEUMANN_MARK) {
225         if (graph->twodim) {
226           if (EdgesIS) {
227             ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],&graph->queue[graph->cptr[i]],PETSC_COPY_VALUES,&ISForEdges[nec]);CHKERRQ(ierr);
228           }
229           nec++;
230         } else {
231           if (FacesIS) {
232             ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],&graph->queue[graph->cptr[i]],PETSC_COPY_VALUES,&ISForFaces[nfc]);CHKERRQ(ierr);
233           }
234           nfc++;
235         }
236       } else {
237         if (EdgesIS) {
238           ierr = ISCreateGeneral(PETSC_COMM_SELF,graph->cptr[i+1]-graph->cptr[i],&graph->queue[graph->cptr[i]],PETSC_COPY_VALUES,&ISForEdges[nec]);CHKERRQ(ierr);
239         }
240         nec++;
241       }
242     }
243   }
244   /* index set for vertices */
245   if (VerticesIS) {
246     nvc = 0;
247     for (i=0;i<graph->ncc;i++) {
248       if (graph->cptr[i+1]-graph->cptr[i] <= graph->custom_minimal_size) {
249         PetscInt j;
250 
251         for (j=graph->cptr[i];j<graph->cptr[i+1];j++) {
252           idx[nvc]=graph->queue[j];
253           nvc++;
254         }
255       }
256     }
257     /* sort vertex set (by local ordering) */
258     ierr = PetscSortInt(nvc,idx);CHKERRQ(ierr);
259     ierr = ISCreateGeneral(PETSC_COMM_SELF,nvc,idx,PETSC_OWN_POINTER,&ISForVertices);CHKERRQ(ierr);
260   }
261   /* get back info */
262   if (n_faces) *n_faces = nfc;
263   if (FacesIS) {
264     *FacesIS = ISForFaces;
265   }
266   if (n_edges) *n_edges = nec;
267   if (EdgesIS) {
268     *EdgesIS = ISForEdges;
269   }
270   if (VerticesIS) {
271     *VerticesIS = ISForVertices;
272   }
273   PetscFunctionReturn(0);
274 }
275 
276 #undef __FUNCT__
277 #define __FUNCT__ "PCBDDCGraphComputeConnectedComponents"
278 PetscErrorCode PCBDDCGraphComputeConnectedComponents(PCBDDCGraph graph)
279 {
280   PetscBool      adapt_interface_reduced;
281   MPI_Comm       interface_comm;
282   PetscMPIInt    size;
283   PetscInt       i;
284   PetscBool      twodim;
285   PetscErrorCode ierr;
286 
287   PetscFunctionBegin;
288   /* compute connected components locally */
289   ierr = PetscObjectGetComm((PetscObject)(graph->l2gmap),&interface_comm);CHKERRQ(ierr);
290   ierr = PCBDDCGraphComputeConnectedComponentsLocal(graph);CHKERRQ(ierr);
291   /* check consistency of connected components among neighbouring subdomains -> it adapt them in case it is needed */
292   ierr = MPI_Comm_size(interface_comm,&size);CHKERRQ(ierr);
293   adapt_interface_reduced = PETSC_FALSE;
294   if (size > 1) {
295     PetscInt i;
296     PetscBool adapt_interface = PETSC_FALSE;
297     for (i=0;i<graph->n_subsets;i++) {
298       /* We are not sure that on a given subset of the local interface,
299          with two connected components, the latters be the same among sharing subdomains */
300       if (graph->subset_ncc[i] > 1) {
301         adapt_interface = PETSC_TRUE;
302         break;
303       }
304     }
305     ierr = MPI_Allreduce(&adapt_interface,&adapt_interface_reduced,1,MPIU_BOOL,MPI_LOR,interface_comm);CHKERRQ(ierr);
306   }
307 
308   if (graph->n_subsets && adapt_interface_reduced) {
309     /* old csr stuff */
310     PetscInt    *aux_new_xadj,*new_xadj,*new_adjncy;
311     PetscInt    *old_xadj,*old_adjncy;
312     PetscBT     subset_cc_adapt;
313     /* MPI */
314     MPI_Request *send_requests,*recv_requests;
315     PetscInt    *send_buffer,*recv_buffer;
316     PetscInt    sum_requests,start_of_recv,start_of_send;
317     PetscInt    *cum_recv_counts;
318     /* others */
319     PetscInt    *labels;
320     PetscInt    global_subset_counter;
321     PetscInt    j,k,s;
322 
323     /* Retrict adjacency graph using information from previously computed connected components */
324     ierr = PetscMalloc1(graph->nvtxs,&aux_new_xadj);CHKERRQ(ierr);
325     for (i=0;i<graph->nvtxs;i++) {
326       aux_new_xadj[i]=1;
327     }
328     for (i=0;i<graph->ncc;i++) {
329       k = graph->cptr[i+1]-graph->cptr[i];
330       for (j=0;j<k;j++) {
331         aux_new_xadj[graph->queue[graph->cptr[i]+j]]=k;
332       }
333     }
334     j = 0;
335     for (i=0;i<graph->nvtxs;i++) {
336       j += aux_new_xadj[i];
337     }
338     ierr = PetscMalloc1(graph->nvtxs+1,&new_xadj);CHKERRQ(ierr);
339     ierr = PetscMalloc1(j,&new_adjncy);CHKERRQ(ierr);
340     new_xadj[0]=0;
341     for (i=0;i<graph->nvtxs;i++) {
342       new_xadj[i+1]=new_xadj[i]+aux_new_xadj[i];
343       if (aux_new_xadj[i]==1) {
344         new_adjncy[new_xadj[i]]=i;
345       }
346     }
347     ierr = PetscFree(aux_new_xadj);CHKERRQ(ierr);
348     ierr = PetscMalloc1(graph->nvtxs,&labels);CHKERRQ(ierr);
349     ierr = PetscMemzero(labels,graph->nvtxs*sizeof(*labels));CHKERRQ(ierr);
350     for (i=0;i<graph->ncc;i++) {
351       k = graph->cptr[i+1]-graph->cptr[i];
352       for (j=0;j<k;j++) {
353         ierr = PetscMemcpy(&new_adjncy[new_xadj[graph->queue[graph->cptr[i]+j]]],&graph->queue[graph->cptr[i]],k*sizeof(PetscInt));CHKERRQ(ierr);
354         labels[graph->queue[graph->cptr[i]+j]] = i;
355       }
356     }
357     /* set temporarly new CSR into graph */
358     old_xadj = graph->xadj;
359     old_adjncy = graph->adjncy;
360     graph->xadj = new_xadj;
361     graph->adjncy = new_adjncy;
362     /* allocate some space */
363     ierr = PetscMalloc1(graph->n_subsets+1,&cum_recv_counts);CHKERRQ(ierr);
364     ierr = PetscMemzero(cum_recv_counts,(graph->n_subsets+1)*sizeof(*cum_recv_counts));CHKERRQ(ierr);
365     /* first count how many neighbours per connected component I will receive from */
366     cum_recv_counts[0]=0;
367     for (i=0;i<graph->n_subsets;i++) {
368       cum_recv_counts[i+1]=cum_recv_counts[i]+graph->count[graph->subsets[i][0]];
369     }
370     ierr = PetscMalloc1(cum_recv_counts[graph->n_subsets],&recv_buffer);CHKERRQ(ierr);
371     ierr = PetscMalloc2(cum_recv_counts[graph->n_subsets],&send_requests,cum_recv_counts[graph->n_subsets],&recv_requests);CHKERRQ(ierr);
372     for (i=0;i<cum_recv_counts[graph->n_subsets];i++) {
373       send_requests[i]=MPI_REQUEST_NULL;
374       recv_requests[i]=MPI_REQUEST_NULL;
375     }
376     /* exchange with my neighbours the number of my connected components on the subset of interface */
377     sum_requests = 0;
378     for (i=0;i<graph->n_subsets;i++) {
379       PetscMPIInt neigh,tag;
380 
381       j = graph->subsets[i][0];
382       ierr = PetscMPIIntCast(2*graph->subset_ref_node[i],&tag);CHKERRQ(ierr);
383       for (k=0;k<graph->count[j];k++) {
384         ierr = PetscMPIIntCast(graph->neighbours_set[j][k],&neigh);CHKERRQ(ierr);
385         ierr = MPI_Isend(&graph->subset_ncc[i],1,MPIU_INT,neigh,tag,interface_comm,&send_requests[sum_requests]);CHKERRQ(ierr);
386         ierr = MPI_Irecv(&recv_buffer[sum_requests],1,MPIU_INT,neigh,tag,interface_comm,&recv_requests[sum_requests]);CHKERRQ(ierr);
387         sum_requests++;
388       }
389     }
390     ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
391     ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
392     /* determine the subsets I have to adapt */
393     ierr = PetscBTCreate(graph->n_subsets,&subset_cc_adapt);CHKERRQ(ierr);
394     ierr = PetscBTMemzero(graph->n_subsets,subset_cc_adapt);CHKERRQ(ierr);
395     for (i=0;i<graph->n_subsets;i++) {
396       for (j=cum_recv_counts[i];j<cum_recv_counts[i+1];j++){
397         /* adapt if more than one cc is present */
398          if (graph->subset_ncc[i] > 1 || recv_buffer[j] > 1) {
399           ierr = PetscBTSet(subset_cc_adapt,i);
400           break;
401         }
402       }
403     }
404     ierr = PetscFree(recv_buffer);CHKERRQ(ierr);
405     /* determine send/recv buffers sizes */
406     j = 0;
407     for (i=0;i<graph->n_subsets;i++) {
408       if (PetscBTLookup(subset_cc_adapt,i)) {
409         j += graph->subsets_size[i];
410       }
411     }
412     k = 0;
413     for (i=0;i<graph->n_subsets;i++) {
414       if (PetscBTLookup(subset_cc_adapt,i)) {
415         k += (cum_recv_counts[i+1]-cum_recv_counts[i])*graph->subsets_size[i];
416       }
417     }
418     ierr = PetscMalloc2(j,&send_buffer,k,&recv_buffer);CHKERRQ(ierr);
419 
420     /* fill send buffer */
421     j = 0;
422     for (i=0;i<graph->n_subsets;i++) {
423       if (PetscBTLookup(subset_cc_adapt,i)) {
424         for (k=0;k<graph->subsets_size[i];k++) {
425           send_buffer[j++] = labels[graph->subsets[i][k]];
426         }
427       }
428     }
429     ierr = PetscFree(labels);CHKERRQ(ierr);
430 
431     /* now exchange the data */
432     start_of_recv = 0;
433     start_of_send = 0;
434     sum_requests = 0;
435     for (i=0;i<graph->n_subsets;i++) {
436       if (PetscBTLookup(subset_cc_adapt,i)) {
437         PetscMPIInt neigh,tag;
438         PetscInt    size_of_send = graph->subsets_size[i];
439 
440         j = graph->subsets[i][0];
441         ierr = PetscMPIIntCast(2*graph->subset_ref_node[i]+1,&tag);CHKERRQ(ierr);
442         for (k=0;k<graph->count[j];k++) {
443           ierr = PetscMPIIntCast(graph->neighbours_set[j][k],&neigh);CHKERRQ(ierr);
444           ierr = MPI_Isend(&send_buffer[start_of_send],size_of_send,MPIU_INT,neigh,tag,interface_comm,&send_requests[sum_requests]);CHKERRQ(ierr);
445           ierr = MPI_Irecv(&recv_buffer[start_of_recv],size_of_send,MPIU_INT,neigh,tag,interface_comm,&recv_requests[sum_requests]);CHKERRQ(ierr);
446           start_of_recv += size_of_send;
447           sum_requests++;
448         }
449         start_of_send += size_of_send;
450       }
451     }
452     ierr = MPI_Waitall(sum_requests,recv_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
453     ierr = MPI_Waitall(sum_requests,send_requests,MPI_STATUSES_IGNORE);CHKERRQ(ierr);
454     ierr = PetscFree2(send_requests,recv_requests);CHKERRQ(ierr);
455 
456     start_of_recv = 0;
457     global_subset_counter = 0;
458     for (i=0;i<graph->n_subsets;i++) {
459       if (PetscBTLookup(subset_cc_adapt,i)) {
460         PetscInt **temp_buffer,temp_buffer_size,*private_label;
461 
462         /* allocate some temporary space */
463         temp_buffer_size = graph->subsets_size[i];
464         ierr = PetscMalloc1(temp_buffer_size,&temp_buffer);CHKERRQ(ierr);
465         ierr = PetscMalloc1(temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i]),&temp_buffer[0]);CHKERRQ(ierr);
466         ierr = PetscMemzero(temp_buffer[0],temp_buffer_size*(cum_recv_counts[i+1]-cum_recv_counts[i])*sizeof(PetscInt));CHKERRQ(ierr);
467         for (j=1;j<temp_buffer_size;j++) {
468           temp_buffer[j] = temp_buffer[j-1]+cum_recv_counts[i+1]-cum_recv_counts[i];
469         }
470         /* analyze contributions from neighbouring subdomains for i-th subset
471            temp buffer structure:
472            supposing part of the interface has dimension 5
473            e.g with global dofs 0,1,2,3,4, locally ordered on the current process as 0,4,3,1,2
474            3 neighs procs having connected components:
475              neigh 0: [0 1 4], [2 3], labels [4,7]  (2 connected components)
476              neigh 1: [0 1], [2 3 4], labels [3 2]  (2 connected components)
477              neigh 2: [0 4], [1], [2 3], labels [1 5 6] (3 connected components)
478            tempbuffer (row-oriented) will be filled as:
479              [ 4, 3, 1;
480                4, 2, 1;
481                7, 2, 6;
482                4, 3, 5;
483                7, 2, 6; ];
484            This way we can simply find intersections of ccs among neighs.
485            The graph->subset array will need to be modified. The output for the example is [0], [1], [2 3], [4];
486                                                                                                                                    */
487         for (j=0;j<cum_recv_counts[i+1]-cum_recv_counts[i];j++) {
488           for (k=0;k<temp_buffer_size;k++) {
489             temp_buffer[k][j] = recv_buffer[start_of_recv+k];
490           }
491           start_of_recv += temp_buffer_size;
492         }
493         ierr = PetscMalloc1(temp_buffer_size,&private_label);CHKERRQ(ierr);
494         ierr = PetscMemzero(private_label,temp_buffer_size*sizeof(*private_label));CHKERRQ(ierr);
495         for (j=0;j<temp_buffer_size;j++) {
496           if (!private_label[j]) { /* found a new cc  */
497             PetscBool same_set;
498 
499             global_subset_counter++;
500             private_label[j] = global_subset_counter;
501             for (k=j+1;k<temp_buffer_size;k++) { /* check for other nodes in new cc */
502               same_set = PETSC_TRUE;
503               for (s=0;s<cum_recv_counts[i+1]-cum_recv_counts[i];s++) {
504                 if (temp_buffer[j][s] != temp_buffer[k][s]) {
505                   same_set = PETSC_FALSE;
506                   break;
507                 }
508               }
509               if (same_set) {
510                 private_label[k] = global_subset_counter;
511               }
512             }
513           }
514         }
515         /* insert private labels in graph structure */
516         for (j=0;j<graph->subsets_size[i];j++) {
517           graph->subset[graph->subsets[i][j]] = graph->n_subsets+private_label[j];
518         }
519         ierr = PetscFree(private_label);CHKERRQ(ierr);
520         ierr = PetscFree(temp_buffer[0]);CHKERRQ(ierr);
521         ierr = PetscFree(temp_buffer);CHKERRQ(ierr);
522       }
523     }
524     ierr = PetscFree2(send_buffer,recv_buffer);CHKERRQ(ierr);
525     ierr = PetscFree(cum_recv_counts);CHKERRQ(ierr);
526     ierr = PetscBTDestroy(&subset_cc_adapt);CHKERRQ(ierr);
527     /* We are ready to find for connected components which are consistent among neighbouring subdomains */
528     if (global_subset_counter) {
529       PetscInt o_nsubs;
530 
531       ierr = PetscBTMemzero(graph->nvtxs,graph->touched);CHKERRQ(ierr);
532       global_subset_counter = 0;
533       for (i=0;i<graph->nvtxs;i++) {
534         if (graph->subset[i] && !PetscBTLookup(graph->touched,i)) {
535           global_subset_counter++;
536           for (j=i+1;j<graph->nvtxs;j++) {
537             if (!PetscBTLookup(graph->touched,j) && graph->subset[j]==graph->subset[i]) {
538               graph->subset[j] = global_subset_counter;
539               ierr = PetscBTSet(graph->touched,j);CHKERRQ(ierr);
540             }
541           }
542           graph->subset[i] = global_subset_counter;
543           ierr = PetscBTSet(graph->touched,i);CHKERRQ(ierr);
544         }
545       }
546       /* disable subdomains info since it is local (info contained in CSR) */
547       o_nsubs = graph->n_local_subs;
548       graph->n_local_subs = 0;
549       /* refine connected components locally */
550       ierr = PCBDDCGraphComputeConnectedComponentsLocal(graph);CHKERRQ(ierr);
551       /* restore subdomains info */
552       graph->n_local_subs = o_nsubs;
553     }
554     /* restore original CSR graph of dofs */
555     ierr = PetscFree(new_xadj);CHKERRQ(ierr);
556     ierr = PetscFree(new_adjncy);CHKERRQ(ierr);
557     graph->xadj = old_xadj;
558     graph->adjncy = old_adjncy;
559   }
560 
561   /* Determine if we are in 2D or 3D */
562   twodim  = PETSC_TRUE;
563   for (i=0;i<graph->ncc;i++) {
564     PetscInt repdof = graph->queue[graph->cptr[i]];
565     if (graph->cptr[i+1]-graph->cptr[i] > graph->custom_minimal_size) {
566       if (graph->count[repdof] > 1 || graph->special_dof[repdof] == PCBDDCGRAPH_NEUMANN_MARK) {
567         twodim = PETSC_FALSE;
568         break;
569       }
570     }
571   }
572   ierr = MPI_Allreduce(&twodim,&graph->twodim,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)graph->l2gmap));CHKERRQ(ierr);
573   PetscFunctionReturn(0);
574 }
575 
576 /* The following code has been adapted from function IsConnectedSubdomain contained
577    in source file contig.c of METIS library (version 5.0.1)
578    It finds connected components for each subset  */
579 #undef __FUNCT__
580 #define __FUNCT__ "PCBDDCGraphComputeConnectedComponentsLocal"
581 PetscErrorCode PCBDDCGraphComputeConnectedComponentsLocal(PCBDDCGraph graph)
582 {
583   PetscInt       i,j,k,first,last,nleft,ncc,pid,cum_queue,n,ncc_pid;
584   PetscMPIInt    size;
585   PetscErrorCode ierr;
586 
587   PetscFunctionBegin;
588   /* quiet return if no csr info is available */
589   if ((!graph->xadj || !graph->adjncy) && !graph->n_local_subs) {
590     PetscFunctionReturn(0);
591   }
592 
593   /* reset any previous search of connected components */
594   ierr = PetscBTMemzero(graph->nvtxs,graph->touched);CHKERRQ(ierr);
595   graph->n_subsets = 0;
596   ierr = MPI_Comm_size(PetscObjectComm((PetscObject)graph->l2gmap),&size);CHKERRQ(ierr);
597   if (size == 1) {
598     if (graph->nvtxs) {
599       graph->n_subsets = 1;
600       for (i=0;i<graph->nvtxs;i++) {
601         graph->subset[i] = 1;
602       }
603     }
604   } else {
605     for (i=0;i<graph->nvtxs;i++) {
606       if (graph->special_dof[i] == PCBDDCGRAPH_DIRICHLET_MARK || !graph->count[i]) {
607         ierr = PetscBTSet(graph->touched,i);CHKERRQ(ierr);
608         graph->subset[i] = 0;
609       }
610       graph->n_subsets = PetscMax(graph->n_subsets,graph->subset[i]);
611     }
612   }
613   ierr = PetscFree(graph->subset_ncc);CHKERRQ(ierr);
614   ierr = PetscMalloc1(graph->n_subsets,&graph->subset_ncc);CHKERRQ(ierr);
615 
616   /* begin search for connected components */
617   cum_queue = 0;
618   ncc = 0;
619   for (n=0;n<graph->n_subsets;n++) {
620     pid = n+1;  /* partition labeled by 0 is discarded */
621     nleft = 0;
622     for (i=0;i<graph->nvtxs;i++) {
623       if (graph->subset[i] == pid) {
624         nleft++;
625       }
626     }
627     for (i=0; i<graph->nvtxs; i++) {
628       if (graph->subset[i] == pid) {
629         break;
630       }
631     }
632     ierr = PetscBTSet(graph->touched,i);CHKERRQ(ierr);
633     graph->queue[cum_queue] = i;
634     first = 0;
635     last = 1;
636     graph->cptr[ncc] = cum_queue;
637     ncc_pid = 0;
638     while (first != nleft) {
639       if (first == last) {
640         graph->cptr[++ncc] = first+cum_queue;
641         ncc_pid++;
642         for (i=0; i<graph->nvtxs; i++) {
643           if (graph->subset[i] == pid && !PetscBTLookup(graph->touched,i)) {
644             break;
645           }
646         }
647         graph->queue[cum_queue+last] = i;
648         last++;
649         ierr = PetscBTSet(graph->touched,i);CHKERRQ(ierr);
650       }
651       i = graph->queue[cum_queue+first];
652       first++;
653       if (!graph->xadj || !graph->adjncy) { /* sub info only, loop over all remaining vertices */
654         for (k=i+1;k<graph->nvtxs;k++) {
655           if (!PetscBTLookup(graph->touched,k) && graph->subset[k] == pid && graph->local_subs[i] == graph->local_subs[k]) {
656             graph->queue[cum_queue+last] = k;
657             last++;
658             ierr = PetscBTSet(graph->touched,k);CHKERRQ(ierr);
659           }
660         }
661       } else {
662         for (j=graph->xadj[i];j<graph->xadj[i+1];j++) {
663           PetscBool same_sub;
664 
665           k = graph->adjncy[j];
666           /* get local subdomain id if needed */
667           if (graph->n_local_subs) {
668             same_sub = (PetscBool)(graph->local_subs[i] == graph->local_subs[k]);
669           } else {
670             same_sub = PETSC_TRUE;
671           }
672           if (!PetscBTLookup(graph->touched,k) && graph->subset[k] == pid && same_sub) {
673             graph->queue[cum_queue+last] = k;
674             last++;
675             ierr = PetscBTSet(graph->touched,k);CHKERRQ(ierr);
676           }
677         }
678       }
679     }
680     graph->cptr[++ncc] = first+cum_queue;
681     ncc_pid++;
682     cum_queue = graph->cptr[ncc];
683     graph->subset_ncc[n] = ncc_pid;
684   }
685   graph->ncc = ncc;
686   graph->queue_sorted = PETSC_FALSE;
687   PetscFunctionReturn(0);
688 }
689 
690 #undef __FUNCT__
691 #define __FUNCT__ "PCBDDCGraphSetUp"
692 PetscErrorCode PCBDDCGraphSetUp(PCBDDCGraph graph, PetscInt custom_minimal_size, IS neumann_is, IS dirichlet_is, PetscInt n_ISForDofs, IS ISForDofs[], IS custom_primal_vertices)
693 {
694   VecScatter     scatter_ctx;
695   Vec            local_vec,local_vec2,global_vec;
696   IS             to,from,subset,subset_n;
697   MPI_Comm       comm;
698   PetscScalar    *array,*array2;
699   const PetscInt *is_indices;
700   PetscInt       n_neigh,*neigh,*n_shared,**shared,*queue_global;
701   PetscInt       i,j,k,s,total_counts,nodes_touched,is_size;
702   PetscMPIInt    size;
703   PetscBool      same_set,mirrors_found;
704   PetscErrorCode ierr;
705 
706   PetscFunctionBegin;
707   graph->has_dirichlet = PETSC_FALSE;
708   if (dirichlet_is) {
709     PetscCheckSameComm(graph->l2gmap,1,dirichlet_is,4);
710     graph->has_dirichlet = PETSC_TRUE;
711   }
712   ierr = PetscObjectGetComm((PetscObject)(graph->l2gmap),&comm);CHKERRQ(ierr);
713   /* custom_minimal_size */
714   graph->custom_minimal_size = custom_minimal_size;
715   /* get info l2gmap and allocate work vectors  */
716   ierr = ISLocalToGlobalMappingGetInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
717   /* check if we have any local periodic nodes (periodic BCs) */
718   mirrors_found = PETSC_FALSE;
719   if (graph->nvtxs && n_neigh) {
720     for (i=0; i<n_shared[0]; i++) graph->count[shared[0][i]] += 1;
721     for (i=0; i<n_shared[0]; i++) {
722       if (graph->count[shared[0][i]] > 1) {
723         mirrors_found = PETSC_TRUE;
724         break;
725       }
726     }
727   }
728   /* create some workspace objects */
729   local_vec = NULL;
730   local_vec2 = NULL;
731   global_vec = NULL;
732   to = NULL;
733   from = NULL;
734   scatter_ctx = NULL;
735   if (n_ISForDofs || dirichlet_is || neumann_is || custom_primal_vertices) {
736     ierr = VecCreate(PETSC_COMM_SELF,&local_vec);CHKERRQ(ierr);
737     ierr = VecSetSizes(local_vec,PETSC_DECIDE,graph->nvtxs);CHKERRQ(ierr);
738     ierr = VecSetType(local_vec,VECSTANDARD);CHKERRQ(ierr);
739     ierr = VecDuplicate(local_vec,&local_vec2);CHKERRQ(ierr);
740     ierr = VecCreate(comm,&global_vec);CHKERRQ(ierr);
741     ierr = VecSetSizes(global_vec,PETSC_DECIDE,graph->nvtxs_global);CHKERRQ(ierr);
742     ierr = VecSetType(global_vec,VECSTANDARD);CHKERRQ(ierr);
743     ierr = ISCreateStride(PETSC_COMM_SELF,graph->nvtxs,0,1,&to);CHKERRQ(ierr);
744     ierr = ISLocalToGlobalMappingApplyIS(graph->l2gmap,to,&from);CHKERRQ(ierr);
745     ierr = VecScatterCreate(global_vec,from,local_vec,to,&scatter_ctx);CHKERRQ(ierr);
746   } else if (mirrors_found) {
747     ierr = ISCreateStride(PETSC_COMM_SELF,graph->nvtxs,0,1,&to);CHKERRQ(ierr);
748     ierr = ISLocalToGlobalMappingApplyIS(graph->l2gmap,to,&from);CHKERRQ(ierr);
749   }
750   /* compute local mirrors (if any) */
751   if (mirrors_found) {
752     PetscInt *local_indices,*global_indices;
753     /* get arrays of local and global indices */
754     ierr = PetscMalloc1(graph->nvtxs,&local_indices);CHKERRQ(ierr);
755     ierr = ISGetIndices(to,(const PetscInt**)&is_indices);CHKERRQ(ierr);
756     ierr = PetscMemcpy(local_indices,is_indices,graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
757     ierr = ISRestoreIndices(to,(const PetscInt**)&is_indices);CHKERRQ(ierr);
758     ierr = PetscMalloc1(graph->nvtxs,&global_indices);CHKERRQ(ierr);
759     ierr = ISGetIndices(from,(const PetscInt**)&is_indices);CHKERRQ(ierr);
760     ierr = PetscMemcpy(global_indices,is_indices,graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
761     ierr = ISRestoreIndices(from,(const PetscInt**)&is_indices);CHKERRQ(ierr);
762     /* allocate space for mirrors */
763     ierr = PetscMalloc2(graph->nvtxs,&graph->mirrors,graph->nvtxs,&graph->mirrors_set);CHKERRQ(ierr);
764     ierr = PetscMemzero(graph->mirrors,graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
765     graph->mirrors_set[0] = 0;
766 
767     k=0;
768     for (i=0;i<n_shared[0];i++) {
769       j=shared[0][i];
770       if (graph->count[j] > 1) {
771         graph->mirrors[j]++;
772         k++;
773       }
774     }
775     /* allocate space for set of mirrors */
776     ierr = PetscMalloc1(k,&graph->mirrors_set[0]);CHKERRQ(ierr);
777     for (i=1;i<graph->nvtxs;i++)
778       graph->mirrors_set[i]=graph->mirrors_set[i-1]+graph->mirrors[i-1];
779 
780     /* fill arrays */
781     ierr = PetscMemzero(graph->mirrors,graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
782     for (j=0;j<n_shared[0];j++) {
783       i=shared[0][j];
784       if (graph->count[i] > 1)
785         graph->mirrors_set[i][graph->mirrors[i]++]=global_indices[i];
786     }
787     ierr = PetscSortIntWithArray(graph->nvtxs,global_indices,local_indices);CHKERRQ(ierr);
788     for (i=0;i<graph->nvtxs;i++) {
789       if (graph->mirrors[i] > 0) {
790         ierr = PetscFindInt(graph->mirrors_set[i][0],graph->nvtxs,global_indices,&k);CHKERRQ(ierr);
791         j = global_indices[k];
792         while ( k > 0 && global_indices[k-1] == j) k--;
793         for (j=0;j<graph->mirrors[i];j++) {
794           graph->mirrors_set[i][j]=local_indices[k+j];
795         }
796         ierr = PetscSortInt(graph->mirrors[i],graph->mirrors_set[i]);CHKERRQ(ierr);
797       }
798     }
799     ierr = PetscFree(local_indices);CHKERRQ(ierr);
800     ierr = PetscFree(global_indices);CHKERRQ(ierr);
801   }
802   ierr = PetscMemzero(graph->count,graph->nvtxs*sizeof(*graph->count));CHKERRQ(ierr);
803   ierr = ISDestroy(&to);CHKERRQ(ierr);
804   ierr = ISDestroy(&from);CHKERRQ(ierr);
805 
806   /* Count total number of neigh per node */
807   k=0;
808   for (i=1;i<n_neigh;i++) {
809     k += n_shared[i];
810     for (j=0;j<n_shared[i];j++) {
811       graph->count[shared[i][j]] += 1;
812     }
813   }
814   /* Allocate space for storing the set of neighbours for each node */
815   if (graph->nvtxs) {
816     ierr = PetscMalloc1(k,&graph->neighbours_set[0]);CHKERRQ(ierr);
817   }
818   for (i=1;i<graph->nvtxs;i++) { /* dont count myself */
819     graph->neighbours_set[i]=graph->neighbours_set[i-1]+graph->count[i-1];
820   }
821   /* Get information for sharing subdomains */
822   ierr = PetscMemzero(graph->count,graph->nvtxs*sizeof(*graph->count));CHKERRQ(ierr);
823   for (i=1;i<n_neigh;i++) { /* dont count myself */
824     s = n_shared[i];
825     for (j=0;j<s;j++) {
826       k = shared[i][j];
827       graph->neighbours_set[k][graph->count[k]] = neigh[i];
828       graph->count[k] += 1;
829     }
830   }
831   /* sort set of sharing subdomains */
832   for (i=0;i<graph->nvtxs;i++) {
833     ierr = PetscSortRemoveDupsInt(&graph->count[i],graph->neighbours_set[i]);CHKERRQ(ierr);
834   }
835   /* free memory allocated by ISLocalToGlobalMappingGetInfo */
836   ierr = ISLocalToGlobalMappingRestoreInfo(graph->l2gmap,&n_neigh,&neigh,&n_shared,&shared);CHKERRQ(ierr);
837 
838   /*
839      Get info for dofs splitting
840      User can specify just a subset; an additional field is considered as a complementary field
841   */
842   for (i=0;i<graph->nvtxs;i++) {
843     graph->which_dof[i] = n_ISForDofs; /* by default a dof belongs to the complement set */
844   }
845   if (n_ISForDofs) {
846     ierr = VecSet(local_vec,-1.0);CHKERRQ(ierr);
847   }
848   for (i=0;i<n_ISForDofs;i++) {
849     ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
850     ierr = ISGetLocalSize(ISForDofs[i],&is_size);CHKERRQ(ierr);
851     ierr = ISGetIndices(ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr);
852     for (j=0;j<is_size;j++) {
853       if (is_indices[j] > -1 && is_indices[j] < graph->nvtxs) { /* out of bounds indices (if any) are skipped */
854         graph->which_dof[is_indices[j]] = i;
855         array[is_indices[j]] = 1.*i;
856       }
857     }
858     ierr = ISRestoreIndices(ISForDofs[i],(const PetscInt**)&is_indices);CHKERRQ(ierr);
859     ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
860   }
861   /* Check consistency among neighbours */
862   if (n_ISForDofs) {
863     ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
864     ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,INSERT_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
865     ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec2,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
866     ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec2,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
867     ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
868     ierr = VecGetArray(local_vec2,&array2);CHKERRQ(ierr);
869     for (i=0;i<graph->nvtxs;i++){
870       PetscInt field1,field2;
871 
872       field1 = (PetscInt)PetscRealPart(array[i]);
873       field2 = (PetscInt)PetscRealPart(array2[i]);
874       if (field1 != field2) {
875         SETERRQ3(comm,PETSC_ERR_USER,"Local node %d have been assigned two different field ids %d and %d at the same time\n",i,field1,field2);
876       }
877     }
878     ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
879     ierr = VecRestoreArray(local_vec2,&array2);CHKERRQ(ierr);
880   }
881   if (neumann_is || dirichlet_is) {
882     /* Take into account Neumann nodes */
883     ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
884     ierr = VecSet(local_vec2,0.0);CHKERRQ(ierr);
885     if (neumann_is) {
886       ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
887       ierr = ISGetLocalSize(neumann_is,&is_size);CHKERRQ(ierr);
888       ierr = ISGetIndices(neumann_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
889       for (i=0;i<is_size;i++) {
890         if (is_indices[i] > -1 && is_indices[i] < graph->nvtxs) { /* out of bounds indices (if any) are skipped */
891           array[is_indices[i]] = 1.0;
892         }
893       }
894       ierr = ISRestoreIndices(neumann_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
895       ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
896     }
897     /* Neumann nodes: impose consistency among neighbours */
898     ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
899     ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
900     ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
901     ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
902     ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
903     ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
904     for (i=0;i<graph->nvtxs;i++) {
905       if (PetscRealPart(array[i]) > 0.1) {
906         graph->special_dof[i] = PCBDDCGRAPH_NEUMANN_MARK;
907       }
908     }
909     ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
910     /* Take into account Dirichlet nodes */
911     ierr = VecSet(local_vec2,0.0);CHKERRQ(ierr);
912     if (dirichlet_is) {
913       ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
914       ierr = VecGetArray(local_vec2,&array2);CHKERRQ(ierr);
915       ierr = ISGetLocalSize(dirichlet_is,&is_size);CHKERRQ(ierr);
916       ierr = ISGetIndices(dirichlet_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
917       for (i=0;i<is_size;i++){
918         if (is_indices[i] > -1 && is_indices[i] < graph->nvtxs) { /* out of bounds indices (if any) are skipped */
919           k = is_indices[i];
920           if (!PetscBTLookup(graph->touched,k)) {
921             if (PetscRealPart(array[k]) > 0.1) {
922               SETERRQ1(comm,PETSC_ERR_USER,"BDDC cannot have boundary nodes which are marked Neumann and Dirichlet at the same time! Local node %d is wrong\n",k);
923             }
924             array2[k] = 1.0;
925           }
926         }
927       }
928       ierr = ISRestoreIndices(dirichlet_is,(const PetscInt**)&is_indices);CHKERRQ(ierr);
929       ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
930       ierr = VecRestoreArray(local_vec2,&array2);CHKERRQ(ierr);
931     }
932     /* Dirichlet nodes: impose consistency among neighbours */
933     ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
934     ierr = VecScatterBegin(scatter_ctx,local_vec2,global_vec,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
935     ierr = VecScatterEnd(scatter_ctx,local_vec2,global_vec,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
936     ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
937     ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
938     ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
939     for (i=0;i<graph->nvtxs;i++) {
940       if (PetscRealPart(array[i]) > 0.1) {
941         ierr = PetscBTSet(graph->touched,i);CHKERRQ(ierr);
942         graph->subset[i] = 0; /* dirichlet nodes treated as internal -> is it ok? */
943         graph->special_dof[i] = PCBDDCGRAPH_DIRICHLET_MARK;
944       }
945     }
946     ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
947   }
948   /* mark local periodic nodes (if any) and adapt CSR graph (if any) */
949   if (graph->mirrors) {
950     for (i=0;i<graph->nvtxs;i++)
951       if (graph->mirrors[i])
952         graph->special_dof[i] = PCBDDCGRAPH_LOCAL_PERIODIC_MARK;
953 
954     if (graph->xadj && graph->adjncy) {
955       PetscInt *new_xadj,*new_adjncy;
956       /* sort CSR graph */
957       for (i=0;i<graph->nvtxs;i++)
958         ierr = PetscSortInt(graph->xadj[i+1]-graph->xadj[i],&graph->adjncy[graph->xadj[i]]);CHKERRQ(ierr);
959 
960       /* adapt local CSR graph in case of local periodicity */
961       k=0;
962       for (i=0;i<graph->nvtxs;i++)
963         for (j=graph->xadj[i];j<graph->xadj[i+1];j++)
964           k += graph->mirrors[graph->adjncy[j]];
965 
966       ierr = PetscMalloc1(graph->nvtxs+1,&new_xadj);CHKERRQ(ierr);
967       ierr = PetscMalloc1(k+graph->xadj[graph->nvtxs],&new_adjncy);CHKERRQ(ierr);
968       new_xadj[0]=0;
969       for (i=0;i<graph->nvtxs;i++) {
970         k = graph->xadj[i+1]-graph->xadj[i];
971         ierr = PetscMemcpy(&new_adjncy[new_xadj[i]],&graph->adjncy[graph->xadj[i]],k*sizeof(PetscInt));CHKERRQ(ierr);
972         new_xadj[i+1]=new_xadj[i]+k;
973         for (j=graph->xadj[i];j<graph->xadj[i+1];j++) {
974           k = graph->mirrors[graph->adjncy[j]];
975           ierr = PetscMemcpy(&new_adjncy[new_xadj[i+1]],graph->mirrors_set[graph->adjncy[j]],k*sizeof(PetscInt));CHKERRQ(ierr);
976           new_xadj[i+1]+=k;
977         }
978         k = new_xadj[i+1]-new_xadj[i];
979         ierr = PetscSortRemoveDupsInt(&k,&new_adjncy[new_xadj[i]]);CHKERRQ(ierr);
980         new_xadj[i+1]=new_xadj[i]+k;
981       }
982       /* set new CSR into graph */
983       ierr = PetscFree(graph->xadj);CHKERRQ(ierr);
984       ierr = PetscFree(graph->adjncy);CHKERRQ(ierr);
985       graph->xadj = new_xadj;
986       graph->adjncy = new_adjncy;
987     }
988   }
989 
990   /* mark special nodes (if any) -> each will become a single node equivalence class */
991   if (custom_primal_vertices) {
992     ierr = VecSet(local_vec,0.0);CHKERRQ(ierr);
993     ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
994     ierr = ISGetLocalSize(custom_primal_vertices,&is_size);CHKERRQ(ierr);
995     ierr = ISGetIndices(custom_primal_vertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
996     for (i=0;i<is_size;i++){
997       if (is_indices[i] > -1 && is_indices[i] < graph->nvtxs) { /* out of bounds indices (if any) are skipped */
998         array[is_indices[i]] = 1.0;
999       }
1000     }
1001     ierr = ISRestoreIndices(custom_primal_vertices,(const PetscInt**)&is_indices);CHKERRQ(ierr);
1002     ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
1003     /* special nodes: impose consistency among neighbours */
1004     ierr = VecSet(global_vec,0.0);CHKERRQ(ierr);
1005     ierr = VecScatterBegin(scatter_ctx,local_vec,global_vec,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1006     ierr = VecScatterEnd(scatter_ctx,local_vec,global_vec,ADD_VALUES,SCATTER_REVERSE);CHKERRQ(ierr);
1007     ierr = VecScatterBegin(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1008     ierr = VecScatterEnd(scatter_ctx,global_vec,local_vec,INSERT_VALUES,SCATTER_FORWARD);CHKERRQ(ierr);
1009     ierr = VecGetArray(local_vec,&array);CHKERRQ(ierr);
1010     j = 0;
1011     for (i=0;i<graph->nvtxs;i++) {
1012       if (PetscRealPart(array[i]) > 0.1 && graph->special_dof[i] != PCBDDCGRAPH_DIRICHLET_MARK) {
1013         graph->special_dof[i] = PCBDDCGRAPH_SPECIAL_MARK-j;
1014         j++;
1015       }
1016     }
1017     ierr = VecRestoreArray(local_vec,&array);CHKERRQ(ierr);
1018   }
1019 
1020   /* mark interior nodes as touched and belonging to partition number 0 */
1021   for (i=0;i<graph->nvtxs;i++) {
1022     if (!graph->count[i]) {
1023       ierr = PetscBTSet(graph->touched,i);CHKERRQ(ierr);
1024       graph->subset[i] = 0;
1025     }
1026   }
1027   /* init graph structure and compute default subsets */
1028   nodes_touched=0;
1029   for (i=0;i<graph->nvtxs;i++) {
1030     if (PetscBTLookup(graph->touched,i)) {
1031       nodes_touched++;
1032     }
1033   }
1034   i = 0;
1035   graph->ncc = 0;
1036   total_counts = 0;
1037 
1038   /* allocated space for queues */
1039   ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
1040   if (size == 1) {
1041     ierr = PetscMalloc2(graph->nvtxs+1,&graph->cptr,graph->nvtxs,&graph->queue);CHKERRQ(ierr);
1042   } else {
1043     PetscInt nused = graph->nvtxs - nodes_touched;
1044     ierr = PetscMalloc2(nused+1,&graph->cptr,nused,&graph->queue);CHKERRQ(ierr);
1045   }
1046 
1047   while (nodes_touched<graph->nvtxs) {
1048     /*  find first untouched node in local ordering */
1049     while (PetscBTLookup(graph->touched,i)) {
1050       i++;
1051     }
1052     ierr = PetscBTSet(graph->touched,i);CHKERRQ(ierr);
1053     graph->subset[i] = graph->ncc+1;
1054     graph->cptr[graph->ncc] = total_counts;
1055     graph->queue[total_counts] = i;
1056     total_counts++;
1057     nodes_touched++;
1058     /* now find all other nodes having the same set of sharing subdomains */
1059     for (j=i+1;j<graph->nvtxs;j++) {
1060       /* check for same number of sharing subdomains, dof number and same special mark */
1061       if (!PetscBTLookup(graph->touched,j) && graph->count[i] == graph->count[j] && graph->which_dof[i] == graph->which_dof[j] && graph->special_dof[i] == graph->special_dof[j]) {
1062         /* check for same set of sharing subdomains */
1063         same_set=PETSC_TRUE;
1064         for (k=0;k<graph->count[j];k++){
1065           if (graph->neighbours_set[i][k]!=graph->neighbours_set[j][k]) {
1066             same_set=PETSC_FALSE;
1067           }
1068         }
1069         /* I found a friend of mine */
1070         if (same_set) {
1071           graph->subset[j]=graph->ncc+1;
1072           ierr = PetscBTSet(graph->touched,j);CHKERRQ(ierr);
1073           nodes_touched++;
1074           graph->queue[total_counts] = j;
1075           total_counts++;
1076         }
1077       }
1078     }
1079     graph->ncc++;
1080   }
1081   /* set default number of subsets (at this point no info on csr graph has been taken into account, so n_subsets = ncc */
1082   graph->n_subsets = graph->ncc;
1083   ierr = PetscMalloc1(graph->n_subsets,&graph->subset_ncc);CHKERRQ(ierr);
1084   for (i=0;i<graph->n_subsets;i++) {
1085     graph->subset_ncc[i] = 1;
1086   }
1087   /* final pointer */
1088   graph->cptr[graph->ncc] = total_counts;
1089 
1090   /* save information on subsets (needed if we have to adapt the connected components later) */
1091   /* For consistency reasons (among neighbours), I need to sort (by global ordering) each subset */
1092   /* Get a reference node (min index in global ordering) for each subset for tagging messages */
1093   ierr = PetscMalloc1(graph->ncc,&graph->subset_ref_node);CHKERRQ(ierr);
1094   ierr = PetscMalloc1(graph->cptr[graph->ncc],&queue_global);CHKERRQ(ierr);
1095   ierr = ISLocalToGlobalMappingApply(graph->l2gmap,graph->cptr[graph->ncc],graph->queue,queue_global);CHKERRQ(ierr);
1096   for (j=0;j<graph->ncc;j++) {
1097     ierr = PetscSortIntWithArray(graph->cptr[j+1]-graph->cptr[j],&queue_global[graph->cptr[j]],&graph->queue[graph->cptr[j]]);CHKERRQ(ierr);
1098     graph->subset_ref_node[j] = graph->queue[graph->cptr[j]];
1099   }
1100   ierr = PetscFree(queue_global);CHKERRQ(ierr);
1101   graph->queue_sorted = PETSC_TRUE;
1102   if (graph->ncc) {
1103     ierr = PetscMalloc2(graph->ncc,&graph->subsets_size,graph->ncc,&graph->subsets);CHKERRQ(ierr);
1104     ierr = PetscMalloc1(graph->cptr[graph->ncc],&graph->subsets[0]);CHKERRQ(ierr);
1105     ierr = PetscMemzero(graph->subsets[0],graph->cptr[graph->ncc]*sizeof(PetscInt));CHKERRQ(ierr);
1106     for (j=1;j<graph->ncc;j++) {
1107       graph->subsets_size[j-1] = graph->cptr[j] - graph->cptr[j-1];
1108       graph->subsets[j] = graph->subsets[j-1] + graph->subsets_size[j-1];
1109     }
1110     graph->subsets_size[graph->ncc-1] = graph->cptr[graph->ncc] - graph->cptr[graph->ncc-1];
1111     for (j=0;j<graph->ncc;j++) {
1112       ierr = PetscMemcpy(graph->subsets[j],&graph->queue[graph->cptr[j]],graph->subsets_size[j]*sizeof(PetscInt));CHKERRQ(ierr);
1113     }
1114   }
1115   /* renumber reference nodes */
1116   ierr = ISCreateGeneral(PetscObjectComm((PetscObject)(graph->l2gmap)),graph->ncc,graph->subset_ref_node,PETSC_COPY_VALUES,&subset_n);CHKERRQ(ierr);
1117   ierr = ISLocalToGlobalMappingApplyIS(graph->l2gmap,subset_n,&subset);CHKERRQ(ierr);
1118   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
1119   ierr = PCBDDCSubsetNumbering(subset,NULL,NULL,&subset_n);CHKERRQ(ierr);
1120   ierr = ISDestroy(&subset);CHKERRQ(ierr);
1121   ierr = ISGetLocalSize(subset_n,&k);CHKERRQ(ierr);
1122   if (k != graph->ncc) {
1123     SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Invalid size of new subset! %d != %d",k,graph->ncc);
1124   }
1125   ierr = ISGetIndices(subset_n,&is_indices);CHKERRQ(ierr);
1126   ierr = PetscMemcpy(graph->subset_ref_node,is_indices,graph->ncc*sizeof(PetscInt));CHKERRQ(ierr);
1127   ierr = ISRestoreIndices(subset_n,&is_indices);CHKERRQ(ierr);
1128   ierr = ISDestroy(&subset_n);CHKERRQ(ierr);
1129 
1130   /* free workspace */
1131   ierr = VecDestroy(&local_vec);CHKERRQ(ierr);
1132   ierr = VecDestroy(&local_vec2);CHKERRQ(ierr);
1133   ierr = VecDestroy(&global_vec);CHKERRQ(ierr);
1134   ierr = VecScatterDestroy(&scatter_ctx);CHKERRQ(ierr);
1135   PetscFunctionReturn(0);
1136 }
1137 
1138 #undef __FUNCT__
1139 #define __FUNCT__ "PCBDDCGraphResetCSR"
1140 PetscErrorCode PCBDDCGraphResetCSR(PCBDDCGraph graph)
1141 {
1142   PetscErrorCode ierr;
1143 
1144   PetscFunctionBegin;
1145   ierr = PetscFree(graph->xadj);CHKERRQ(ierr);
1146   ierr = PetscFree(graph->adjncy);CHKERRQ(ierr);
1147   graph->nvtxs_csr = 0;
1148   PetscFunctionReturn(0);
1149 }
1150 
1151 #undef __FUNCT__
1152 #define __FUNCT__ "PCBDDCGraphReset"
1153 PetscErrorCode PCBDDCGraphReset(PCBDDCGraph graph)
1154 {
1155   PetscErrorCode ierr;
1156 
1157   PetscFunctionBegin;
1158   ierr = ISLocalToGlobalMappingDestroy(&graph->l2gmap);CHKERRQ(ierr);
1159   ierr = PetscFree(graph->subset_ncc);CHKERRQ(ierr);
1160   ierr = PetscFree(graph->subset_ref_node);CHKERRQ(ierr);
1161   if (graph->nvtxs) {
1162     ierr = PetscFree(graph->neighbours_set[0]);CHKERRQ(ierr);
1163   }
1164   ierr = PetscBTDestroy(&graph->touched);CHKERRQ(ierr);
1165   ierr = PetscFree5(graph->count,
1166                     graph->neighbours_set,
1167                     graph->subset,
1168                     graph->which_dof,
1169                     graph->special_dof);CHKERRQ(ierr);
1170   ierr = PetscFree2(graph->cptr,graph->queue);CHKERRQ(ierr);
1171   if (graph->mirrors) {
1172     ierr = PetscFree(graph->mirrors_set[0]);CHKERRQ(ierr);
1173   }
1174   ierr = PetscFree2(graph->mirrors,graph->mirrors_set);CHKERRQ(ierr);
1175   if (graph->subsets) {
1176     ierr = PetscFree(graph->subsets[0]);CHKERRQ(ierr);
1177   }
1178   ierr = PetscFree2(graph->subsets_size,graph->subsets);CHKERRQ(ierr);
1179   ierr = ISDestroy(&graph->dirdofs);CHKERRQ(ierr);
1180   ierr = ISDestroy(&graph->dirdofsB);CHKERRQ(ierr);
1181   if (graph->n_local_subs) {
1182     ierr = PetscFree(graph->local_subs);CHKERRQ(ierr);
1183   }
1184   graph->has_dirichlet = PETSC_FALSE;
1185   graph->nvtxs = 0;
1186   graph->nvtxs_global = 0;
1187   graph->n_subsets = 0;
1188   graph->custom_minimal_size = 1;
1189   graph->n_local_subs = 0;
1190   PetscFunctionReturn(0);
1191 }
1192 
1193 #undef __FUNCT__
1194 #define __FUNCT__ "PCBDDCGraphInit"
1195 PetscErrorCode PCBDDCGraphInit(PCBDDCGraph graph, ISLocalToGlobalMapping l2gmap, PetscInt N)
1196 {
1197   PetscInt       n;
1198   PetscErrorCode ierr;
1199 
1200   PetscFunctionBegin;
1201   PetscValidPointer(graph,1);
1202   PetscValidHeaderSpecific(l2gmap,IS_LTOGM_CLASSID,2);
1203   PetscValidLogicalCollectiveInt(l2gmap,N,3);
1204   /* raise an error if already allocated */
1205   if (graph->nvtxs_global) {
1206     SETERRQ(PetscObjectComm((PetscObject)l2gmap),PETSC_ERR_PLIB,"BDDCGraph already initialized");
1207   }
1208   /* set number of vertices */
1209   ierr = PetscObjectReference((PetscObject)l2gmap);CHKERRQ(ierr);
1210   graph->l2gmap = l2gmap;
1211   ierr = ISLocalToGlobalMappingGetSize(l2gmap,&n);CHKERRQ(ierr);
1212   graph->nvtxs = n;
1213   graph->nvtxs_global = N;
1214   /* allocate used space */
1215   ierr = PetscBTCreate(graph->nvtxs,&graph->touched);CHKERRQ(ierr);
1216   ierr = PetscMalloc5(graph->nvtxs,&graph->count,
1217                       graph->nvtxs,&graph->neighbours_set,
1218                       graph->nvtxs,&graph->subset,
1219                       graph->nvtxs,&graph->which_dof,
1220                       graph->nvtxs,&graph->special_dof);CHKERRQ(ierr);
1221   /* zeroes memory */
1222   ierr = PetscMemzero(graph->count,graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
1223   ierr = PetscMemzero(graph->subset,graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
1224   /* use -1 as a default value for which_dof array */
1225   for (n=0;n<graph->nvtxs;n++) graph->which_dof[n] = -1;
1226   ierr = PetscMemzero(graph->special_dof,graph->nvtxs*sizeof(PetscInt));CHKERRQ(ierr);
1227   /* zeroes first pointer to neighbour set */
1228   if (graph->nvtxs) {
1229     graph->neighbours_set[0] = 0;
1230   }
1231   /* zeroes workspace for values of ncc */
1232   graph->subset_ncc = 0;
1233   graph->subset_ref_node = 0;
1234   PetscFunctionReturn(0);
1235 }
1236 
1237 #undef __FUNCT__
1238 #define __FUNCT__ "PCBDDCGraphDestroy"
1239 PetscErrorCode PCBDDCGraphDestroy(PCBDDCGraph* graph)
1240 {
1241   PetscErrorCode ierr;
1242 
1243   PetscFunctionBegin;
1244   ierr = PCBDDCGraphReset(*graph);CHKERRQ(ierr);
1245   ierr = PetscFree(*graph);CHKERRQ(ierr);
1246   PetscFunctionReturn(0);
1247 }
1248 
1249 #undef __FUNCT__
1250 #define __FUNCT__ "PCBDDCGraphCreate"
1251 PetscErrorCode PCBDDCGraphCreate(PCBDDCGraph *graph)
1252 {
1253   PCBDDCGraph    new_graph;
1254   PetscErrorCode ierr;
1255 
1256   PetscFunctionBegin;
1257   ierr = PetscNew(&new_graph);CHKERRQ(ierr);
1258   new_graph->custom_minimal_size = 1;
1259   *graph = new_graph;
1260   PetscFunctionReturn(0);
1261 }
1262