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