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