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