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