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