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