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