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