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