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