xref: /petsc/src/vec/is/utils/isltog.c (revision 262ff7bbb8d19d69e3928431622c455081fa134e)
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 int IS_LTOGM_COOKIE = -1;
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 
115 #undef __FUNCT__
116 #define __FUNCT__ "ISLocalToGlobalMappingCreate"
117 /*@C
118     ISLocalToGlobalMappingCreate - Creates a mapping between a local (0 to n)
119     ordering and a global parallel ordering.
120 
121     Not Collective, but communicator may have more than one process
122 
123     Input Parameters:
124 +   comm - MPI communicator
125 .   n - the number of local elements
126 -   indices - the global index for each local element
127 
128     Output Parameter:
129 .   mapping - new mapping data structure
130 
131     Level: advanced
132 
133     Concepts: mapping^local to global
134 
135 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreateNC()
136 @*/
137 int ISLocalToGlobalMappingCreate(MPI_Comm cm,int n,const int indices[],ISLocalToGlobalMapping *mapping)
138 {
139   int *in,ierr;
140 
141   PetscFunctionBegin;
142   PetscValidIntPointer(indices);
143   PetscValidPointer(mapping);
144   ierr = PetscMalloc((n+1)*sizeof(int),&in);CHKERRQ(ierr);
145   ierr = PetscMemcpy(in,indices,n*sizeof(int));CHKERRQ(ierr);
146   ierr = ISLocalToGlobalMappingCreateNC(cm,n,in,mapping);CHKERRQ(ierr);
147   PetscFunctionReturn(0);
148 }
149 
150 #undef __FUNCT__
151 #define __FUNCT__ "ISLocalToGlobalMappingCreateNC"
152 /*@C
153     ISLocalToGlobalMappingCreateNC - Creates a mapping between a local (0 to n)
154     ordering and a global parallel ordering.
155 
156     Not Collective, but communicator may have more than one process
157 
158     Input Parameters:
159 +   comm - MPI communicator
160 .   n - the number of local elements
161 -   indices - the global index for each local element
162 
163     Output Parameter:
164 .   mapping - new mapping data structure
165 
166     Level: developer
167 
168     Notes: Does not copy the indices, just keeps the pointer to the indices. The ISLocalToGlobalMappingDestroy()
169     will free the space so it must be obtained with PetscMalloc() and it must not be freed elsewhere.
170 
171     Concepts: mapping^local to global
172 
173 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate()
174 @*/
175 int ISLocalToGlobalMappingCreateNC(MPI_Comm cm,int n,const int indices[],ISLocalToGlobalMapping *mapping)
176 {
177   int ierr;
178 
179   PetscFunctionBegin;
180   PetscValidIntPointer(indices);
181   PetscValidPointer(mapping);
182   *mapping = PETSC_NULL;
183 #ifndef PETSC_USE_DYNAMIC_LIBRARIES
184   ierr = VecInitializePackage(PETSC_NULL);                                                                CHKERRQ(ierr);
185 #endif
186   if (IS_LTOGM_COOKIE == -1) {
187     ierr = PetscLogClassRegister(&IS_LTOGM_COOKIE,"IS Local to global mapping");CHKERRQ(ierr);
188   }
189 
190   PetscHeaderCreate(*mapping,_p_ISLocalToGlobalMapping,int,IS_LTOGM_COOKIE,0,"ISLocalToGlobalMapping",
191                     cm,ISLocalToGlobalMappingDestroy,ISLocalToGlobalMappingView);
192   PetscLogObjectCreate(*mapping);
193   PetscLogObjectMemory(*mapping,sizeof(struct _p_ISLocalToGlobalMapping)+n*sizeof(int));
194 
195   (*mapping)->n       = n;
196   (*mapping)->indices = (int*)indices;
197 
198   /*
199       Do not create the global to local mapping. This is only created if
200      ISGlobalToLocalMapping() is called
201   */
202   (*mapping)->globals = 0;
203   PetscFunctionReturn(0);
204 }
205 
206 #undef __FUNCT__
207 #define __FUNCT__ "ISLocalToGlobalMappingBlock"
208 /*@C
209     ISLocalToGlobalMappingBlock - Creates a blocked index version of an
210        ISLocalToGlobalMapping that is appropriate for MatSetLocalToGlobalMappingBlock()
211        and VecSetLocalToGlobalMappingBlock().
212 
213     Not Collective, but communicator may have more than one process
214 
215     Input Parameters:
216 +    inmap - original point-wise mapping
217 -    bs - block size
218 
219     Output Parameter:
220 .   outmap - block based mapping
221 
222     Level: advanced
223 
224     Concepts: mapping^local to global
225 
226 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreate(), ISLocalToGlobalMappingCreateIS()
227 @*/
228 int ISLocalToGlobalMappingBlock(ISLocalToGlobalMapping inmap,int bs,ISLocalToGlobalMapping *outmap)
229 {
230   int ierr,*ii,i,n;
231 
232   PetscFunctionBegin;
233 
234   if (bs > 1) {
235     n    = inmap->n/bs;
236     ierr = PetscMalloc(n*sizeof(int),&ii);CHKERRQ(ierr);
237     for (i=0; i<n; i++) {
238       ii[i] = inmap->indices[bs*i]/bs;
239     }
240     ierr = ISLocalToGlobalMappingCreate(inmap->comm,n,ii,outmap);CHKERRQ(ierr);
241     ierr = PetscFree(ii);CHKERRQ(ierr);
242   } else {
243     *outmap = inmap;
244     ierr    = PetscObjectReference((PetscObject)inmap);CHKERRQ(ierr);
245   }
246   PetscFunctionReturn(0);
247 }
248 
249 #undef __FUNCT__
250 #define __FUNCT__ "ISLocalToGlobalMappingDestroy"
251 /*@
252    ISLocalToGlobalMappingDestroy - Destroys a mapping between a local (0 to n)
253    ordering and a global parallel ordering.
254 
255    Note Collective
256 
257    Input Parameters:
258 .  mapping - mapping data structure
259 
260    Level: advanced
261 
262 .seealso: ISLocalToGlobalMappingCreate()
263 @*/
264 int ISLocalToGlobalMappingDestroy(ISLocalToGlobalMapping mapping)
265 {
266   int ierr;
267   PetscFunctionBegin;
268   PetscValidPointer(mapping);
269   if (--mapping->refct > 0) PetscFunctionReturn(0);
270   if (mapping->refct < 0) {
271     SETERRQ(1,"Mapping already destroyed");
272   }
273 
274   ierr = PetscFree(mapping->indices);CHKERRQ(ierr);
275   if (mapping->globals) {ierr = PetscFree(mapping->globals);CHKERRQ(ierr);}
276   PetscLogObjectDestroy(mapping);
277   PetscHeaderDestroy(mapping);
278   PetscFunctionReturn(0);
279 }
280 
281 #undef __FUNCT__
282 #define __FUNCT__ "ISLocalToGlobalMappingApplyIS"
283 /*@
284     ISLocalToGlobalMappingApplyIS - Creates from an IS in the local numbering
285     a new index set using the global numbering defined in an ISLocalToGlobalMapping
286     context.
287 
288     Not collective
289 
290     Input Parameters:
291 +   mapping - mapping between local and global numbering
292 -   is - index set in local numbering
293 
294     Output Parameters:
295 .   newis - index set in global numbering
296 
297     Level: advanced
298 
299     Concepts: mapping^local to global
300 
301 .seealso: ISLocalToGlobalMappingApply(), ISLocalToGlobalMappingCreate(),
302           ISLocalToGlobalMappingDestroy(), ISGlobalToLocalMappingApply()
303 @*/
304 int ISLocalToGlobalMappingApplyIS(ISLocalToGlobalMapping mapping,IS is,IS *newis)
305 {
306   int ierr,n,i,*idxin,*idxmap,*idxout,Nmax = mapping->n;
307 
308   PetscFunctionBegin;
309   PetscValidPointer(mapping);
310   PetscValidHeaderSpecific(is,IS_COOKIE);
311   PetscValidPointer(newis);
312 
313   ierr   = ISGetLocalSize(is,&n);CHKERRQ(ierr);
314   ierr   = ISGetIndices(is,&idxin);CHKERRQ(ierr);
315   idxmap = mapping->indices;
316 
317   ierr = PetscMalloc((n+1)*sizeof(int),&idxout);CHKERRQ(ierr);
318   for (i=0; i<n; i++) {
319     if (idxin[i] >= Nmax) SETERRQ3(PETSC_ERR_ARG_OUTOFRANGE,"Local index %d too large %d (max) at %d",idxin[i],Nmax-1,i);
320     idxout[i] = idxmap[idxin[i]];
321   }
322   ierr = ISRestoreIndices(is,&idxin);CHKERRQ(ierr);
323   ierr = ISCreateGeneral(PETSC_COMM_SELF,n,idxout,newis);CHKERRQ(ierr);
324   ierr = PetscFree(idxout);CHKERRQ(ierr);
325   PetscFunctionReturn(0);
326 }
327 
328 /*MC
329    ISLocalToGlobalMappingApply - Takes a list of integers in a local numbering
330    and converts them to the global numbering.
331 
332    Not collective
333 
334    Input Parameters:
335 +  mapping - the local to global mapping context
336 .  N - number of integers
337 -  in - input indices in local numbering
338 
339    Output Parameter:
340 .  out - indices in global numbering
341 
342    Synopsis:
343    int ISLocalToGlobalMappingApply(ISLocalToGlobalMapping mapping,int N,int in[],int out[])
344 
345    Notes:
346    The in and out array parameters may be identical.
347 
348    Level: advanced
349 
350 .seealso: ISLocalToGlobalMappingCreate(),ISLocalToGlobalMappingDestroy(),
351           ISLocalToGlobalMappingApplyIS(),AOCreateBasic(),AOApplicationToPetsc(),
352           AOPetscToApplication(), ISGlobalToLocalMappingApply()
353 
354     Concepts: mapping^local to global
355 
356 M*/
357 
358 /* -----------------------------------------------------------------------------------------*/
359 
360 #undef __FUNCT__
361 #define __FUNCT__ "ISGlobalToLocalMappingSetUp_Private"
362 /*
363     Creates the global fields in the ISLocalToGlobalMapping structure
364 */
365 static int ISGlobalToLocalMappingSetUp_Private(ISLocalToGlobalMapping mapping)
366 {
367   int ierr,i,*idx = mapping->indices,n = mapping->n,end,start,*globals;
368 
369   PetscFunctionBegin;
370   end   = 0;
371   start = 100000000;
372 
373   for (i=0; i<n; i++) {
374     if (idx[i] < 0) continue;
375     if (idx[i] < start) start = idx[i];
376     if (idx[i] > end)   end   = idx[i];
377   }
378   if (start > end) {start = 0; end = -1;}
379   mapping->globalstart = start;
380   mapping->globalend   = end;
381 
382   ierr             = PetscMalloc((end-start+2)*sizeof(int),&globals);CHKERRQ(ierr);
383   mapping->globals = globals;
384   for (i=0; i<end-start+1; i++) {
385     globals[i] = -1;
386   }
387   for (i=0; i<n; i++) {
388     if (idx[i] < 0) continue;
389     globals[idx[i] - start] = i;
390   }
391 
392   PetscLogObjectMemory(mapping,(end-start+1)*sizeof(int));
393   PetscFunctionReturn(0);
394 }
395 
396 #undef __FUNCT__
397 #define __FUNCT__ "ISGlobalToLocalMappingApply"
398 /*@
399     ISGlobalToLocalMappingApply - Provides the local numbering for a list of integers
400     specified with a global numbering.
401 
402     Not collective
403 
404     Input Parameters:
405 +   mapping - mapping between local and global numbering
406 .   type - IS_GTOLM_MASK - replaces global indices with no local value with -1
407            IS_GTOLM_DROP - drops the indices with no local value from the output list
408 .   n - number of global indices to map
409 -   idx - global indices to map
410 
411     Output Parameters:
412 +   nout - number of indices in output array (if type == IS_GTOLM_MASK then nout = n)
413 -   idxout - local index of each global index, one must pass in an array long enough
414              to hold all the indices. You can call ISGlobalToLocalMappingApply() with
415              idxout == PETSC_NULL to determine the required length (returned in nout)
416              and then allocate the required space and call ISGlobalToLocalMappingApply()
417              a second time to set the values.
418 
419     Notes:
420     Either nout or idxout may be PETSC_NULL. idx and idxout may be identical.
421 
422     This is not scalable in memory usage. Each processor requires O(Nglobal) size
423     array to compute these.
424 
425     Level: advanced
426 
427     Concepts: mapping^global to local
428 
429 .seealso: ISLocalToGlobalMappingApply(), ISLocalToGlobalMappingCreate(),
430           ISLocalToGlobalMappingDestroy()
431 @*/
432 int ISGlobalToLocalMappingApply(ISLocalToGlobalMapping mapping,ISGlobalToLocalMappingType type,
433                                   int n,const int idx[],int *nout,int idxout[])
434 {
435   int i,ierr,*globals,nf = 0,tmp,start,end;
436 
437   PetscFunctionBegin;
438   if (!mapping->globals) {
439     ierr = ISGlobalToLocalMappingSetUp_Private(mapping);CHKERRQ(ierr);
440   }
441   globals = mapping->globals;
442   start   = mapping->globalstart;
443   end     = mapping->globalend;
444 
445   if (type == IS_GTOLM_MASK) {
446     if (idxout) {
447       for (i=0; i<n; i++) {
448         if (idx[i] < 0) idxout[i] = idx[i];
449         else if (idx[i] < start) idxout[i] = -1;
450         else if (idx[i] > end)   idxout[i] = -1;
451         else                     idxout[i] = globals[idx[i] - start];
452       }
453     }
454     if (nout) *nout = n;
455   } else {
456     if (idxout) {
457       for (i=0; i<n; i++) {
458         if (idx[i] < 0) continue;
459         if (idx[i] < start) continue;
460         if (idx[i] > end) continue;
461         tmp = globals[idx[i] - start];
462         if (tmp < 0) continue;
463         idxout[nf++] = tmp;
464       }
465     } else {
466       for (i=0; i<n; i++) {
467         if (idx[i] < 0) continue;
468         if (idx[i] < start) continue;
469         if (idx[i] > end) continue;
470         tmp = globals[idx[i] - start];
471         if (tmp < 0) continue;
472         nf++;
473       }
474     }
475     if (nout) *nout = nf;
476   }
477 
478   PetscFunctionReturn(0);
479 }
480 
481 #undef __FUNCT__
482 #define __FUNCT__ "ISLocalToGlobalMappingGetInfo"
483 /*@C
484     ISLocalToGlobalMappingGetInfo - Gets the neighbor information for each processor and
485      each index shared by more than one processor
486 
487     Collective on ISLocalToGlobalMapping
488 
489     Input Parameters:
490 .   mapping - the mapping from local to global indexing
491 
492     Output Parameter:
493 +   nproc - number of processors that are connected to this one
494 .   proc - neighboring processors
495 .   numproc - number of indices for each subdomain (processor)
496 -   indices - indices of local nodes shared with neighbor (sorted by global numbering)
497 
498     Level: advanced
499 
500     Concepts: mapping^local to global
501 
502 .seealso: ISLocalToGlobalMappingDestroy(), ISLocalToGlobalMappingCreateIS(), ISLocalToGlobalMappingCreate(),
503           ISLocalToGlobalMappingRestoreInfo()
504 @*/
505 int ISLocalToGlobalMappingGetInfo(ISLocalToGlobalMapping mapping,int *nproc,int *procs[],int *numprocs[],int **indices[])
506 {
507   int         i,n = mapping->n,ierr,Ng,ng,max = 0,*lindices = mapping->indices;
508   int         size,rank,*nprocs,*owner,nsends,*sends,j,*starts,nmax,nrecvs,*recvs,proc;
509   int         tag1,tag2,tag3,cnt,*len,*source,imdex,scale,*ownedsenders,*nownedsenders,rstart,nowned;
510   int         node,nownedm,nt,*sends2,nsends2,*starts2,*lens2,*dest,nrecvs2,*starts3,*recvs2,k,*bprocs,*tmp;
511   int         first_procs,first_numprocs,*first_indices;
512   MPI_Request *recv_waits,*send_waits;
513   MPI_Status  recv_status,*send_status,*recv_statuses;
514   MPI_Comm    comm = mapping->comm;
515   PetscTruth  debug = PETSC_FALSE;
516 
517   PetscFunctionBegin;
518   ierr   = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
519   ierr   = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
520   if (size == 1) {
521     *nproc         = 0;
522     *procs         = PETSC_NULL;
523     ierr           = PetscMalloc(sizeof(int),numprocs);CHKERRQ(ierr);
524     (*numprocs)[0] = 0;
525     ierr           = PetscMalloc(sizeof(int*),indices);CHKERRQ(ierr);
526     (*indices)[0]  = PETSC_NULL;
527     PetscFunctionReturn(0);
528   }
529 
530   ierr = PetscOptionsHasName(PETSC_NULL,"-islocaltoglobalmappinggetinfo_debug",&debug);CHKERRQ(ierr);
531 
532   /*
533     Notes on ISLocalToGlobalMappingGetInfo
534 
535     globally owned node - the nodes that have been assigned to this processor in global
536            numbering, just for this routine.
537 
538     nontrivial globally owned node - node assigned to this processor that is on a subdomain
539            boundary (i.e. is has more than one local owner)
540 
541     locally owned node - node that exists on this processors subdomain
542 
543     nontrivial locally owned node - node that is not in the interior (i.e. has more than one
544            local subdomain
545   */
546   ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag1);CHKERRQ(ierr);
547   ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag2);CHKERRQ(ierr);
548   ierr = PetscObjectGetNewTag((PetscObject)mapping,&tag3);CHKERRQ(ierr);
549 
550   for (i=0; i<n; i++) {
551     if (lindices[i] > max) max = lindices[i];
552   }
553   ierr   = MPI_Allreduce(&max,&Ng,1,MPI_INT,MPI_MAX,comm);CHKERRQ(ierr);
554   Ng++;
555   ierr   = MPI_Comm_size(comm,&size);CHKERRQ(ierr);
556   ierr   = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr);
557   scale  = Ng/size + 1;
558   ng     = scale; if (rank == size-1) ng = Ng - scale*(size-1); ng = PetscMax(1,ng);
559   rstart = scale*rank;
560 
561   /* determine ownership ranges of global indices */
562   ierr = PetscMalloc((2*size+1)*sizeof(int),&nprocs);CHKERRQ(ierr);
563   ierr = PetscMemzero(nprocs,2*size*sizeof(int));CHKERRQ(ierr);
564 
565   /* determine owners of each local node  */
566   ierr = PetscMalloc((n+1)*sizeof(int),&owner);CHKERRQ(ierr);
567   for (i=0; i<n; i++) {
568     proc             = lindices[i]/scale; /* processor that globally owns this index */
569     nprocs[2*proc+1] = 1;                 /* processor globally owns at least one of ours */
570     owner[i]         = proc;
571     nprocs[2*proc]++;                     /* count of how many that processor globally owns of ours */
572   }
573   nsends = 0; for (i=0; i<size; i++) nsends += nprocs[2*i+1];
574   PetscLogInfo(0,"ISLocalToGlobalMappingGetInfo: Number of global owners for my local data %d\n",nsends);
575 
576   /* inform other processors of number of messages and max length*/
577   ierr = PetscMaxSum(comm,nprocs,&nmax,&nrecvs);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[2*i-2];}
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[2*i-2];}
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[2*i]) {
606       ierr      = MPI_Isend(sends+starts[i],2*nprocs[2*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