xref: /petsc/src/vec/is/utils/isltog.c (revision b0a32e0c6855ee6a6cd3495fa7da12ea9885bc5d)
1 /*$Id: isltog.c,v 1.59 2000/10/24 20:24:56 bsmith Exp bsmith $*/
2 
3 #include "petscsys.h"   /*I "petscsys.h" I*/
4 #include "src/vec/is/isimpl.h"    /*I "petscis.h"  I*/
5 
6 #undef __FUNC__
7 #define __FUNC__ "ISLocalToGlobalMappingGetSize"
8 /*@C
9     ISLocalToGlobalMappingGetSize - Gets the local size of a local to global mapping.
10 
11     Not Collective
12 
13     Input Parameter:
14 .   ltog - local to global mapping
15 
16     Output Parameter:
17 .   n - the number of entries in the local mapping
18 
19     Level: advanced
20 
21     Concepts: mapping^local to global
22 
23 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreate()
24 @*/
25 int ISLocalToGlobalMappingGetSize(ISLocalToGlobalMapping mapping,int *n)
26 {
27   PetscFunctionBegin;
28   PetscValidHeaderSpecific(mapping,IS_LTOGM_COOKIE);
29   *n = mapping->n;
30   PetscFunctionReturn(0);
31 }
32 
33 #undef __FUNC__
34 #define __FUNC__ "ISLocalToGlobalMappingView"
35 /*@C
36     ISLocalToGlobalMappingView - View a local to global mapping
37 
38     Not Collective
39 
40     Input Parameters:
41 +   ltog - local to global mapping
42 -   viewer - viewer
43 
44     Level: advanced
45 
46     Concepts: mapping^local to global
47 
48 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreate()
49 @*/
50 int ISLocalToGlobalMappingView(ISLocalToGlobalMapping mapping,PetscViewer viewer)
51 {
52   int        i,ierr,rank;
53   PetscTruth isascii;
54 
55   PetscFunctionBegin;
56   PetscValidHeaderSpecific(mapping,IS_LTOGM_COOKIE);
57   if (!viewer) viewer = PETSC_VIEWER_STDOUT_(mapping->comm);
58   PetscValidHeaderSpecific(viewer,PETSC_VIEWER_COOKIE);
59   PetscCheckSameComm(mapping,viewer);
60 
61   ierr = MPI_Comm_rank(mapping->comm,&rank);CHKERRQ(ierr);
62   ierr = PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&isascii);CHKERRQ(ierr);
63   if (isascii) {
64     for (i=0; i<mapping->n; i++) {
65       ierr = PetscViewerASCIISynchronizedPrintf(viewer,"[%d] %d %d\n",rank,i,mapping->indices[i]);CHKERRQ(ierr);
66     }
67     ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
68   } else {
69     SETERRQ1(1,"Viewer type %s not supported for ISLocalToGlobalMapping",((PetscObject)viewer)->type_name);
70   }
71 
72   PetscFunctionReturn(0);
73 }
74 
75 #undef __FUNC__
76 #define __FUNC__ "ISLocalToGlobalMappingCreateIS"
77 /*@C
78     ISLocalToGlobalMappingCreateIS - Creates a mapping between a local (0 to n)
79     ordering and a global parallel ordering.
80 
81     Not collective
82 
83     Input Parameter:
84 .   is - index set containing the global numbers for each local
85 
86     Output Parameter:
87 .   mapping - new mapping data structure
88 
89     Level: advanced
90 
91     Concepts: mapping^local to global
92 
93 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreate()
94 @*/
95 int ISLocalToGlobalMappingCreateIS(IS is,ISLocalToGlobalMapping *mapping)
96 {
97   int      n,*indices,ierr;
98   MPI_Comm comm;
99 
100   PetscFunctionBegin;
101   PetscValidHeaderSpecific(is,IS_COOKIE);
102 
103   ierr = PetscObjectGetComm((PetscObject)is,&comm);CHKERRQ(ierr);
104   ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
105   ierr = ISGetIndices(is,&indices);CHKERRQ(ierr);
106   ierr = ISLocalToGlobalMappingCreate(comm,n,indices,mapping);CHKERRQ(ierr);
107   ierr = ISRestoreIndices(is,&indices);CHKERRQ(ierr);
108 
109   PetscFunctionReturn(0);
110 }
111 
112 #undef __FUNC__
113 #define __FUNC__ "ISLocalToGlobalMappingCreate"
114 /*@C
115     ISLocalToGlobalMappingCreate - Creates a mapping between a local (0 to n)
116     ordering and a global parallel ordering.
117 
118     Not Collective, but communicator may have more than one process
119 
120     Input Parameters:
121 +   comm - MPI communicator
122 .   n - the number of local elements
123 -   indices - the global index for each local element
124 
125     Output Parameter:
126 .   mapping - new mapping data structure
127 
128     Level: advanced
129 
130     Concepts: mapping^local to global
131 
132 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS()
133 @*/
134 int ISLocalToGlobalMappingCreate(MPI_Comm cm,int n,const int indices[],ISLocalToGlobalMapping *mapping)
135 {
136   int ierr;
137 
138   PetscFunctionBegin;
139   PetscValidIntPointer(indices);
140   PetscValidPointer(mapping);
141 
142   PetscHeaderCreate(*mapping,_p_ISLocalToGlobalMapping,int,IS_LTOGM_COOKIE,0,"ISLocalToGlobalMapping",
143                     cm,ISLocalToGlobalMappingDestroy,ISLocalToGlobalMappingView);
144   PetscLogObjectCreate(*mapping);
145   PetscLogObjectMemory(*mapping,sizeof(struct _p_ISLocalToGlobalMapping)+n*sizeof(int));
146 
147   (*mapping)->n       = n;
148   ierr = PetscMalloc((n+1)*sizeof(int),&(*mapping)->indices);CHKERRQ(ierr);
149   ierr = PetscMemcpy((*mapping)->indices,indices,n*sizeof(int));CHKERRQ(ierr);
150 
151   /*
152       Do not create the global to local mapping. This is only created if
153      ISGlobalToLocalMapping() is called
154   */
155   (*mapping)->globals = 0;
156   PetscFunctionReturn(0);
157 }
158 
159 #undef __FUNC__
160 #define __FUNC__ "ISLocalToGlobalMappingDestroy"
161 /*@
162    ISLocalToGlobalMappingDestroy - Destroys a mapping between a local (0 to n)
163    ordering and a global parallel ordering.
164 
165    Note Collective
166 
167    Input Parameters:
168 .  mapping - mapping data structure
169 
170    Level: advanced
171 
172 .seealso: ISLocalToGlobalMappingCreate()
173 @*/
174 int ISLocalToGlobalMappingDestroy(ISLocalToGlobalMapping mapping)
175 {
176   int ierr;
177   PetscFunctionBegin;
178   PetscValidPointer(mapping);
179   if (--mapping->refct > 0) PetscFunctionReturn(0);
180   if (mapping->refct < 0) {
181     SETERRQ(1,"Mapping already destroyed");
182   }
183 
184   ierr = PetscFree(mapping->indices);CHKERRQ(ierr);
185   if (mapping->globals) {ierr = PetscFree(mapping->globals);CHKERRQ(ierr);}
186   PetscLogObjectDestroy(mapping);
187   PetscHeaderDestroy(mapping);
188   PetscFunctionReturn(0);
189 }
190 
191 #undef __FUNC__
192 #define __FUNC__ "ISLocalToGlobalMappingApplyIS"
193 /*@
194     ISLocalToGlobalMappingApplyIS - Creates from an IS in the local numbering
195     a new index set using the global numbering defined in an ISLocalToGlobalMapping
196     context.
197 
198     Not collective
199 
200     Input Parameters:
201 +   mapping - mapping between local and global numbering
202 -   is - index set in local numbering
203 
204     Output Parameters:
205 .   newis - index set in global numbering
206 
207     Level: advanced
208 
209     Concepts: mapping^local to global
210 
211 .seealso: ISLocalToGlobalMappingApply(), ISLocalToGlobalMappingCreate(),
212           ISLocalToGlobalMappingDestroy(), ISGlobalToLocalMappingApply()
213 @*/
214 int ISLocalToGlobalMappingApplyIS(ISLocalToGlobalMapping mapping,IS is,IS *newis)
215 {
216   int ierr,n,i,*idxin,*idxmap,*idxout,Nmax = mapping->n;
217 
218   PetscFunctionBegin;
219   PetscValidPointer(mapping);
220   PetscValidHeaderSpecific(is,IS_COOKIE);
221   PetscValidPointer(newis);
222 
223   ierr   = ISGetLocalSize(is,&n);CHKERRQ(ierr);
224   ierr   = ISGetIndices(is,&idxin);CHKERRQ(ierr);
225   idxmap = mapping->indices;
226 
227   ierr = PetscMalloc((n+1)*sizeof(int),&idxout);CHKERRQ(ierr);
228   for (i=0; i<n; i++) {
229     if (idxin[i] >= Nmax) SETERRQ3(PETSC_ERR_ARG_OUTOFRANGE,"Local index %d too large %d (max) at %d",idxin[i],Nmax,i);
230     idxout[i] = idxmap[idxin[i]];
231   }
232   ierr = ISRestoreIndices(is,&idxin);CHKERRQ(ierr);
233   ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxout,newis);CHKERRQ(ierr);
234   ierr = PetscFree(idxout);CHKERRQ(ierr);
235   PetscFunctionReturn(0);
236 }
237 
238 /*MC
239    ISLocalToGlobalMappingApply - Takes a list of integers in a local numbering
240    and converts them to the global numbering.
241 
242    Not collective
243 
244    Input Parameters:
245 +  mapping - the local to global mapping context
246 .  N - number of integers
247 -  in - input indices in local numbering
248 
249    Output Parameter:
250 .  out - indices in global numbering
251 
252    Synopsis:
253    ISLocalToGlobalMappingApply(ISLocalToGlobalMapping mapping,int N,int in[],int out[])
254 
255    Notes:
256    The in and out array parameters may be identical.
257 
258    Level: advanced
259 
260 .seealso: ISLocalToGlobalMappingCreate(),ISLocalToGlobalMappingDestroy(),
261           ISLocalToGlobalMappingApplyIS(),AOCreateBasic(),AOApplicationToPetsc(),
262           AOPetscToApplication(), ISGlobalToLocalMappingApply()
263 
264     Concepts: mapping^local to global
265 
266 M*/
267 
268 /* -----------------------------------------------------------------------------------------*/
269 
270 #undef __FUNC__
271 #define __FUNC__ "ISGlobalToLocalMappingSetUp_Private"
272 /*
273     Creates the global fields in the ISLocalToGlobalMapping structure
274 */
275 static int ISGlobalToLocalMappingSetUp_Private(ISLocalToGlobalMapping mapping)
276 {
277   int ierr,i,*idx = mapping->indices,n = mapping->n,end,start,*globals;
278 
279   PetscFunctionBegin;
280   end   = 0;
281   start = 100000000;
282 
283   for (i=0; i<n; i++) {
284     if (idx[i] < 0) continue;
285     if (idx[i] < start) start = idx[i];
286     if (idx[i] > end)   end   = idx[i];
287   }
288   if (start > end) {start = 0; end = -1;}
289   mapping->globalstart = start;
290   mapping->globalend   = end;
291 
292   ierr             = PetscMalloc((end-start+2)*sizeof(int),&globals);CHKERRQ(ierr);
293   mapping->globals = globals;
294   for (i=0; i<end-start+1; i++) {
295     globals[i] = -1;
296   }
297   for (i=0; i<n; i++) {
298     if (idx[i] < 0) continue;
299     globals[idx[i] - start] = i;
300   }
301 
302   PetscLogObjectMemory(mapping,(end-start+1)*sizeof(int));
303   PetscFunctionReturn(0);
304 }
305 
306 #undef __FUNC__
307 #define __FUNC__ "ISGlobalToLocalMappingApply"
308 /*@
309     ISGlobalToLocalMappingApply - Provides the local numbering for a list of integers
310     specified with a global numbering.
311 
312     Not collective
313 
314     Input Parameters:
315 +   mapping - mapping between local and global numbering
316 .   type - IS_GTOLM_MASK - replaces global indices with no local value with -1
317            IS_GTOLM_DROP - drops the indices with no local value from the output list
318 .   n - number of global indices to map
319 -   idx - global indices to map
320 
321     Output Parameters:
322 +   nout - number of indices in output array (if type == IS_GTOLM_MASK then nout = n)
323 -   idxout - local index of each global index, one must pass in an array long enough
324              to hold all the indices. You can call ISGlobalToLocalMappingApply() with
325              idxout == PETSC_NULL to determine the required length (returned in nout)
326              and then allocate the required space and call ISGlobalToLocalMappingApply()
327              a second time to set the values.
328 
329     Notes:
330     Either nout or idxout may be PETSC_NULL. idx and idxout may be identical.
331 
332     This is not scalable in memory usage. Each processor requires O(Nglobal) size
333     array to compute these.
334 
335     Level: advanced
336 
337     Concepts: mapping^global to local
338 
339 .seealso: ISLocalToGlobalMappingApply(), ISLocalToGlobalMappingCreate(),
340           ISLocalToGlobalMappingDestroy()
341 @*/
342 int ISGlobalToLocalMappingApply(ISLocalToGlobalMapping mapping,ISGlobalToLocalMappingType type,
343                                   int n,const int idx[],int *nout,int idxout[])
344 {
345   int i,ierr,*globals,nf = 0,tmp,start,end;
346 
347   PetscFunctionBegin;
348   if (!mapping->globals) {
349     ierr = ISGlobalToLocalMappingSetUp_Private(mapping);CHKERRQ(ierr);
350   }
351   globals = mapping->globals;
352   start   = mapping->globalstart;
353   end     = mapping->globalend;
354 
355   if (type == IS_GTOLM_MASK) {
356     if (idxout) {
357       for (i=0; i<n; i++) {
358         if (idx[i] < 0) idxout[i] = idx[i];
359         else if (idx[i] < start) idxout[i] = -1;
360         else if (idx[i] > end)   idxout[i] = -1;
361         else                     idxout[i] = globals[idx[i] - start];
362       }
363     }
364     if (nout) *nout = n;
365   } else {
366     if (idxout) {
367       for (i=0; i<n; i++) {
368         if (idx[i] < 0) continue;
369         if (idx[i] < start) continue;
370         if (idx[i] > end) continue;
371         tmp = globals[idx[i] - start];
372         if (tmp < 0) continue;
373         idxout[nf++] = tmp;
374       }
375     } else {
376       for (i=0; i<n; i++) {
377         if (idx[i] < 0) continue;
378         if (idx[i] < start) continue;
379         if (idx[i] > end) continue;
380         tmp = globals[idx[i] - start];
381         if (tmp < 0) continue;
382         nf++;
383       }
384     }
385     if (nout) *nout = nf;
386   }
387 
388   PetscFunctionReturn(0);
389 }
390 
391 #undef __FUNC__
392 #define __FUNC__ "ISLocalToGlobalMappingGetInfo"
393 /*@C
394     ISLocalToGlobalMappingGetInfo - Gets the neighbor information for each processor and
395      each index shared by more than one processor
396 
397     Collective on ISLocalToGlobalMapping
398 
399     Input Parameters:
400 .   mapping - the mapping from local to global indexing
401 
402     Output Parameter:
403 +   nproc - number of processors that are connected to this one
404 .   proc - neighboring processors
405 .   numproc - number of indices for each subdomain (processor)
406 -   indices - indices of local nodes shared with neighbor (sorted by global numbering)
407 
408     Level: advanced
409 
410     Concepts: mapping^local to global
411 
412 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate(),
413           ISLocalToGlobalMappingRestoreInfo()
414 @*/
415 int ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping mapping,int *nproc,int **procs,int **numprocs,int ***indices)
416 {
417   int         i,n = mapping->n,ierr,Ng,ng = PETSC_DECIDE,max = 0,*lindices = mapping->indices;
418   int         size,rank,*nprocs,*owner,nsends,*sends,j,*starts,*work,nmax,nrecvs,*recvs,proc;
419   int         tag1,tag2,tag3,cnt,*len,*source,imdex,scale,*ownedsenders,*nownedsenders,rstart,nowned;
420   int         node,nownedm,nt,*sends2,nsends2,*starts2,*lens2,*dest,nrecvs2,*starts3,*recvs2,k,*bprocs,*tmp;
421   int         first_procs,first_numprocs,*first_indices;
422   MPI_Request *recv_waits,*send_waits;
423   MPI_Status  recv_status,*send_status,*recv_statuses;
424   MPI_Comm    comm = mapping->comm;
425   PetscTruth  debug = PETSC_FALSE;
426 
427   PetscFunctionBegin;
428   ierr   = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
429   ierr   = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
430   if (size == 1) {
431     *nproc         = 0;
432     *procs         = PETSC_NULL;
433     ierr           = PetscMalloc(sizeof(int),numprocs);CHKERRQ(ierr);
434     (*numprocs)[0] = 0;
435     ierr           = PetscMalloc(sizeof(int*),indices);CHKERRQ(ierr);
436     (*indices)[0]  = PETSC_NULL;
437     PetscFunctionReturn(0);
438   }
439 
440   ierr = PetscOptionsHasName(PETSC_NULL,"-islocaltoglobalmappinggetinfo_debug",&debug);CHKERRQ(ierr);
441 
442   /*
443     Notes on ISLocalToGlobalMappingGetInfo
444 
445     globally owned node - the nodes that have been assigned to this processor in global
446            numbering, just for this routine.
447 
448     nontrivial globally owned node - node assigned to this processor that is on a subdomain
449            boundary (i.e. is has more than one local owner)
450 
451     locally owned node - node that exists on this processors subdomain
452 
453     nontrivial locally owned node - node that is not in the interior (i.e. has more than one
454            local subdomain
455   */
456   ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag1);CHKERRQ(ierr);
457   ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag2);CHKERRQ(ierr);
458   ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag3);CHKERRQ(ierr);
459 
460   for (i=0; i<n; i++) {
461     if (lindices[i] > max) max = lindices[i];
462   }
463   ierr   = MPI_Allreduce(&max,&Ng,1,MPI_INT,MPI_MAX,comm);CHKERRQ(ierr);
464   Ng++;
465   ierr   = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
466   ierr   = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
467   scale  = Ng/size + 1;
468   ng     = scale; if (rank == size-1) ng = Ng - scale*(size-1); ng = PetscMax(1,ng);
469   rstart = scale*rank;
470 
471   /* determine ownership ranges of global indices */
472   ierr = PetscMalloc((2*size+1)*sizeof(int),&nprocs);CHKERRQ(ierr);
473   ierr = PetscMemzero(nprocs,2*size*sizeof(int));CHKERRQ(ierr);
474 
475   /* determine owners of each local node  */
476   ierr = PetscMalloc((n+1)*sizeof(int),&owner);CHKERRQ(ierr);
477   for (i=0; i<n; i++) {
478     proc              = lindices[i]/scale; /* processor that globally owns this index */
479     nprocs[size+proc] = 1;                 /* processor globally owns at least one of ours */
480     owner[i]          = proc;
481     nprocs[proc]++;                        /* count of how many that processor globally owns of ours */
482   }
483   nsends = 0; for (i=0; i<size; i++) nsends += nprocs[size + i];
484   PetscLogInfo(0,"ISLocalToGlobalMappingGetInfo: Number of global owners for my local data %d\n",nsends);
485 
486   /* inform other processors of number of messages and max length*/
487   ierr = PetscMalloc(2*size*sizeof(int),&work);CHKERRQ(ierr);
488   ierr   = MPI_Allreduce(nprocs,work,2*size,MPI_INT,PetscMaxSum_Op,comm);CHKERRQ(ierr);
489   nmax   = work[rank];
490   nrecvs = work[size+rank];
491   ierr   = PetscFree(work);CHKERRQ(ierr);
492   PetscLogInfo(0,"ISLocalToGlobalMappingGetInfo: Number of local owners for my global data %d\n",nrecvs);
493 
494   /* post receives for owned rows */
495   ierr = PetscMalloc((2*nrecvs+1)*(nmax+1)*sizeof(int),&recvs);CHKERRQ(ierr);
496   ierr = PetscMalloc((nrecvs+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr);
497   for (i=0; i<nrecvs; i++) {
498     ierr = MPI_Irecv(recvs+2*nmax*i,2*nmax,MPI_INT,MPI_ANY_SOURCE,tag1,comm,recv_waits+i);CHKERRQ(ierr);
499   }
500 
501   /* pack messages containing lists of local nodes to owners */
502   ierr       = PetscMalloc((2*n+1)*sizeof(int),&sends);CHKERRQ(ierr);
503   ierr       = PetscMalloc((size+1)*sizeof(int),&starts);CHKERRQ(ierr);
504   starts[0]  = 0;
505   for (i=1; i<size; i++) { starts[i] = starts[i-1] + 2*nprocs[i-1];}
506   for (i=0; i<n; i++) {
507     sends[starts[owner[i]]++] = lindices[i];
508     sends[starts[owner[i]]++] = i;
509   }
510   ierr = PetscFree(owner);CHKERRQ(ierr);
511   starts[0]  = 0;
512   for (i=1; i<size; i++) { starts[i] = starts[i-1] + 2*nprocs[i-1];}
513 
514   /* send the messages */
515   ierr = PetscMalloc((nsends+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr);
516   ierr = PetscMalloc((nsends+1)*sizeof(int),&dest);CHKERRQ(ierr);
517   cnt = 0;
518   for (i=0; i<size; i++) {
519     if (nprocs[i]) {
520       ierr      = MPI_Isend(sends+starts[i],2*nprocs[i],MPI_INT,i,tag1,comm,send_waits+cnt);CHKERRQ(ierr);
521       dest[cnt] = i;
522       cnt++;
523     }
524   }
525   ierr = PetscFree(starts);CHKERRQ(ierr);
526 
527   /* wait on receives */
528   ierr = PetscMalloc((2*nrecvs+1)*sizeof(int),&source);CHKERRQ(ierr);
529   len  = source + nrecvs;
530   cnt  = nrecvs;
531   ierr = PetscMalloc((ng+1)*sizeof(int),&nownedsenders);CHKERRQ(ierr);
532   ierr = PetscMemzero(nownedsenders,ng*sizeof(int));CHKERRQ(ierr);
533   while (cnt) {
534     ierr = MPI_Waitany(nrecvs,recv_waits,&imdex,&recv_status);CHKERRQ(ierr);
535     /* unpack receives into our local space */
536     ierr           = MPI_Get_count(&recv_status,MPI_INT,&len[imdex]);CHKERRQ(ierr);
537     source[imdex]  = recv_status.MPI_SOURCE;
538     len[imdex]     = len[imdex]/2;
539     /* count how many local owners for each of my global owned indices */
540     for (i=0; i<len[imdex]; i++) nownedsenders[recvs[2*imdex*nmax+2*i]-rstart]++;
541     cnt--;
542   }
543   ierr = PetscFree(recv_waits);CHKERRQ(ierr);
544 
545   /* count how many globally owned indices are on an edge multiplied by how many processors own them. */
546   nowned  = 0;
547   nownedm = 0;
548   for (i=0; i<ng; i++) {
549     if (nownedsenders[i] > 1) {nownedm += nownedsenders[i]; nowned++;}
550   }
551 
552   /* create single array to contain rank of all local owners of each globally owned index */
553   ierr      = PetscMalloc((nownedm+1)*sizeof(int),&ownedsenders);CHKERRQ(ierr);
554   ierr      = PetscMalloc((ng+1)*sizeof(int),&starts);CHKERRQ(ierr);
555   starts[0] = 0;
556   for (i=1; i<ng; i++) {
557     if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1];
558     else starts[i] = starts[i-1];
559   }
560 
561   /* for each nontrival globally owned node list all arriving processors */
562   for (i=0; i<nrecvs; i++) {
563     for (j=0; j<len[i]; j++) {
564       node = recvs[2*i*nmax+2*j]-rstart;
565       if (nownedsenders[node] > 1) {
566         ownedsenders[starts[node]++] = source[i];
567       }
568     }
569   }
570 
571   if (debug) { /* -----------------------------------  */
572     starts[0]    = 0;
573     for (i=1; i<ng; i++) {
574       if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1];
575       else starts[i] = starts[i-1];
576     }
577     for (i=0; i<ng; i++) {
578       if (nownedsenders[i] > 1) {
579         ierr = PetscSynchronizedPrintf(comm,"[%d] global node %d local owner processors: ",rank,i+rstart);CHKERRQ(ierr);
580         for (j=0; j<nownedsenders[i]; j++) {
581           ierr = PetscSynchronizedPrintf(comm,"%d ",ownedsenders[starts[i]+j]);CHKERRQ(ierr);
582         }
583         ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr);
584       }
585     }
586     ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr);
587   }/* -----------------------------------  */
588 
589   /* wait on original sends */
590   if (nsends) {
591     ierr = PetscMalloc(nsends*sizeof(MPI_Status),&send_status);CHKERRQ(ierr);
592     ierr = MPI_Waitall(nsends,send_waits,send_status);CHKERRQ(ierr);
593     ierr = PetscFree(send_status);CHKERRQ(ierr);
594   }
595   ierr = PetscFree(send_waits);CHKERRQ(ierr);
596   ierr = PetscFree(sends);CHKERRQ(ierr);
597   ierr = PetscFree(nprocs);CHKERRQ(ierr);
598 
599   /* pack messages to send back to local owners */
600   starts[0]    = 0;
601   for (i=1; i<ng; i++) {
602     if (nownedsenders[i-1] > 1) starts[i] = starts[i-1] + nownedsenders[i-1];
603     else starts[i] = starts[i-1];
604   }
605   nsends2 = nrecvs;
606   ierr    = PetscMalloc((nsends2+1)*sizeof(int),&nprocs);CHKERRQ(ierr); /* length of each message */
607   cnt     = 0;
608   for (i=0; i<nrecvs; i++) {
609     nprocs[i] = 1;
610     for (j=0; j<len[i]; j++) {
611       node = recvs[2*i*nmax+2*j]-rstart;
612       if (nownedsenders[node] > 1) {
613         nprocs[i] += 2 + nownedsenders[node];
614       }
615     }
616   }
617   nt = 0; for (i=0; i<nsends2; i++) nt += nprocs[i];
618   ierr = PetscMalloc((nt+1)*sizeof(int),&sends2);CHKERRQ(ierr);
619   ierr = PetscMalloc((nsends2+1)*sizeof(int),&starts2);CHKERRQ(ierr);
620   starts2[0] = 0; for (i=1; i<nsends2; i++) starts2[i] = starts2[i-1] + nprocs[i-1];
621   /*
622      Each message is 1 + nprocs[i] long, and consists of
623        (0) the number of nodes being sent back
624        (1) the local node number,
625        (2) the number of processors sharing it,
626        (3) the processors sharing it
627   */
628   for (i=0; i<nsends2; i++) {
629     cnt = 1;
630     sends2[starts2[i]] = 0;
631     for (j=0; j<len[i]; j++) {
632       node = recvs[2*i*nmax+2*j]-rstart;
633       if (nownedsenders[node] > 1) {
634         sends2[starts2[i]]++;
635         sends2[starts2[i]+cnt++] = recvs[2*i*nmax+2*j+1];
636         sends2[starts2[i]+cnt++] = nownedsenders[node];
637         ierr = PetscMemcpy(&sends2[starts2[i]+cnt],&ownedsenders[starts[node]],nownedsenders[node]*sizeof(int));CHKERRQ(ierr);
638         cnt += nownedsenders[node];
639       }
640     }
641   }
642 
643   /* send the message lengths */
644   for (i=0; i<nsends2; i++) {
645     ierr = MPI_Send(&nprocs[i],1,MPI_INT,source[i],tag2,comm);CHKERRQ(ierr);
646   }
647 
648   /* receive the message lengths */
649   nrecvs2 = nsends;
650   ierr = PetscMalloc((nrecvs2+1)*sizeof(int),&lens2);CHKERRQ(ierr);
651   ierr = PetscMalloc((nrecvs2+1)*sizeof(int),&starts3);CHKERRQ(ierr);
652   nt      = 0;
653   for (i=0; i<nrecvs2; i++) {
654     ierr =  MPI_Recv(&lens2[i],1,MPI_INT,dest[i],tag2,comm,&recv_status);CHKERRQ(ierr);
655     nt   += lens2[i];
656   }
657   starts3[0] = 0;
658   for (i=0; i<nrecvs2-1; i++) {
659     starts3[i+1] = starts3[i] + lens2[i];
660   }
661   ierr = PetscMalloc((nt+1)*sizeof(int),&recvs2);CHKERRQ(ierr);
662   ierr = PetscMalloc((nrecvs2+1)*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr);
663   for (i=0; i<nrecvs2; i++) {
664     ierr = MPI_Irecv(recvs2+starts3[i],lens2[i],MPI_INT,dest[i],tag3,comm,recv_waits+i);CHKERRQ(ierr);
665   }
666 
667   /* send the messages */
668   ierr = PetscMalloc((nsends2+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr);
669   for (i=0; i<nsends2; i++) {
670     ierr = MPI_Isend(sends2+starts2[i],nprocs[i],MPI_INT,source[i],tag3,comm,send_waits+i);CHKERRQ(ierr);
671   }
672 
673   /* wait on receives */
674   ierr = PetscMalloc((nrecvs2+1)*sizeof(MPI_Status),&recv_statuses);CHKERRQ(ierr);
675   ierr = MPI_Waitall(nrecvs2,recv_waits,recv_statuses);CHKERRQ(ierr);
676   ierr = PetscFree(recv_statuses);CHKERRQ(ierr);
677   ierr = PetscFree(recv_waits);CHKERRQ(ierr);
678   ierr = PetscFree(nprocs);CHKERRQ(ierr);
679 
680   if (debug) { /* -----------------------------------  */
681     cnt = 0;
682     for (i=0; i<nrecvs2; i++) {
683       nt = recvs2[cnt++];
684       for (j=0; j<nt; j++) {
685         ierr = PetscSynchronizedPrintf(comm,"[%d] local node %d number of subdomains %d: ",rank,recvs2[cnt],recvs2[cnt+1]);CHKERRQ(ierr);
686         for (k=0; k<recvs2[cnt+1]; k++) {
687           ierr = PetscSynchronizedPrintf(comm,"%d ",recvs2[cnt+2+k]);CHKERRQ(ierr);
688         }
689         cnt += 2 + recvs2[cnt+1];
690         ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr);
691       }
692     }
693     ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr);
694   } /* -----------------------------------  */
695 
696   /* count number subdomains for each local node */
697   ierr = PetscMalloc(size*sizeof(int),&nprocs);CHKERRQ(ierr);
698   ierr = PetscMemzero(nprocs,size*sizeof(int));CHKERRQ(ierr);
699   cnt  = 0;
700   for (i=0; i<nrecvs2; i++) {
701     nt = recvs2[cnt++];
702     for (j=0; j<nt; j++) {
703       for (k=0; k<recvs2[cnt+1]; k++) {
704         nprocs[recvs2[cnt+2+k]]++;
705       }
706       cnt += 2 + recvs2[cnt+1];
707     }
708   }
709   nt = 0; for (i=0; i<size; i++) nt += (nprocs[i] > 0);
710   *nproc    = nt;
711   ierr = PetscMalloc((nt+1)*sizeof(int),procs);CHKERRQ(ierr);
712   ierr = PetscMalloc((nt+1)*sizeof(int),numprocs);CHKERRQ(ierr);
713   ierr = PetscMalloc((nt+1)*sizeof(int*),indices);CHKERRQ(ierr);
714   ierr = PetscMalloc(size*sizeof(int),&bprocs);CHKERRQ(ierr);
715   cnt       = 0;
716   for (i=0; i<size; i++) {
717     if (nprocs[i] > 0) {
718       bprocs[i]        = cnt;
719       (*procs)[cnt]    = i;
720       (*numprocs)[cnt] = nprocs[i];
721       ierr             = PetscMalloc(nprocs[i]*sizeof(int),&(*indices)[cnt]);CHKERRQ(ierr);
722       cnt++;
723     }
724   }
725 
726   /* make the list of subdomains for each nontrivial local node */
727   ierr = PetscMemzero(*numprocs,nt*sizeof(int));CHKERRQ(ierr);
728   cnt  = 0;
729   for (i=0; i<nrecvs2; i++) {
730     nt = recvs2[cnt++];
731     for (j=0; j<nt; j++) {
732       for (k=0; k<recvs2[cnt+1]; k++) {
733         (*indices)[bprocs[recvs2[cnt+2+k]]][(*numprocs)[bprocs[recvs2[cnt+2+k]]]++] = recvs2[cnt];
734       }
735       cnt += 2 + recvs2[cnt+1];
736     }
737   }
738   ierr = PetscFree(bprocs);CHKERRQ(ierr);
739   ierr = PetscFree(recvs2);CHKERRQ(ierr);
740 
741   /* sort the node indexing by their global numbers */
742   nt = *nproc;
743   for (i=0; i<nt; i++) {
744     ierr = PetscMalloc(((*numprocs)[i])*sizeof(int),&tmp);CHKERRQ(ierr);
745     for (j=0; j<(*numprocs)[i]; j++) {
746       tmp[j] = lindices[(*indices)[i][j]];
747     }
748     ierr = PetscSortIntWithArray((*numprocs)[i],tmp,(*indices)[i]);CHKERRQ(ierr);
749     ierr = PetscFree(tmp);CHKERRQ(ierr);
750   }
751 
752   if (debug) { /* -----------------------------------  */
753     nt = *nproc;
754     for (i=0; i<nt; i++) {
755       ierr = PetscSynchronizedPrintf(comm,"[%d] subdomain %d number of indices %d: ",rank,(*procs)[i],(*numprocs)[i]);CHKERRQ(ierr);
756       for (j=0; j<(*numprocs)[i]; j++) {
757         ierr = PetscSynchronizedPrintf(comm,"%d ",(*indices)[i][j]);CHKERRQ(ierr);
758       }
759       ierr = PetscSynchronizedPrintf(comm,"\n");CHKERRQ(ierr);
760     }
761     ierr = PetscSynchronizedFlush(comm);CHKERRQ(ierr);
762   } /* -----------------------------------  */
763 
764   /* wait on sends */
765   if (nsends2) {
766     ierr = PetscMalloc(nsends2*sizeof(MPI_Status),&send_status);CHKERRQ(ierr);
767     ierr = MPI_Waitall(nsends2,send_waits,send_status);CHKERRQ(ierr);
768     ierr = PetscFree(send_status);CHKERRQ(ierr);
769   }
770 
771   ierr = PetscFree(starts3);CHKERRQ(ierr);
772   ierr = PetscFree(dest);CHKERRQ(ierr);
773   ierr = PetscFree(send_waits);CHKERRQ(ierr);
774 
775   ierr = PetscFree(nownedsenders);CHKERRQ(ierr);
776   ierr = PetscFree(ownedsenders);CHKERRQ(ierr);
777   ierr = PetscFree(starts);CHKERRQ(ierr);
778   ierr = PetscFree(starts2);CHKERRQ(ierr);
779   ierr = PetscFree(lens2);CHKERRQ(ierr);
780 
781   ierr = PetscFree(source);CHKERRQ(ierr);
782   ierr = PetscFree(recvs);CHKERRQ(ierr);
783   ierr = PetscFree(nprocs);CHKERRQ(ierr);
784   ierr = PetscFree(sends2);CHKERRQ(ierr);
785 
786   /* put the information about myself as the first entry in the list */
787   first_procs    = (*procs)[0];
788   first_numprocs = (*numprocs)[0];
789   first_indices  = (*indices)[0];
790   for (i=0; i<*nproc; i++) {
791     if ((*procs)[i] == rank) {
792       (*procs)[0]    = (*procs)[i];
793       (*numprocs)[0] = (*numprocs)[i];
794       (*indices)[0]  = (*indices)[i];
795       (*procs)[i]    = first_procs;
796       (*numprocs)[i] = first_numprocs;
797       (*indices)[i]  = first_indices;
798       break;
799     }
800   }
801 
802   PetscFunctionReturn(0);
803 }
804 
805 #undef __FUNC__
806 #define __FUNC__ "ISLocalToGlobalMappingRestoreInfo"
807 /*@C
808     ISLocalToGlobalMappingRestoreInfo - Frees the memory allocated by ISLocalToGlobalMappingGetInfo()
809 
810     Collective on ISLocalToGlobalMapping
811 
812     Input Parameters:
813 .   mapping - the mapping from local to global indexing
814 
815     Output Parameter:
816 +   nproc - number of processors that are connected to this one
817 .   proc - neighboring processors
818 .   numproc - number of indices for each processor
819 -   indices - indices of local nodes shared with neighbor (sorted by global numbering)
820 
821     Level: advanced
822 
823 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate(),
824           ISLocalToGlobalMappingGetInfo()
825 @*/
826 int ISLocalToGlobalMappingRestoreInfo(ISLocalToGlobalMapping mapping,int *nproc,int **procs,int **numprocs,int ***indices)
827 {
828   int ierr,i;
829 
830   PetscFunctionBegin;
831   if (*procs) {ierr = PetscFree(*procs);CHKERRQ(ierr);}
832   if (*numprocs) {ierr = PetscFree(*numprocs);CHKERRQ(ierr);}
833   if (*indices) {
834     if ((*indices)[0]) {ierr = PetscFree((*indices)[0]);CHKERRQ(ierr);}
835     for (i=1; i<*nproc; i++) {
836       if ((*indices)[i]) {ierr = PetscFree((*indices)[i]);CHKERRQ(ierr);}
837     }
838     ierr = PetscFree(*indices);CHKERRQ(ierr);
839   }
840   PetscFunctionReturn(0);
841 }
842 
843 
844 
845 
846 
847 
848 
849 
850 
851 
852 
853 
854 
855 
856 
857 
858 
859 
860